Mercurial > hg > xemacs-beta

comparison lisp/calendar/cal-xemacs.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; cal-xemacs.el --- calendar functions for menu bar and popup menu support
2 ;;; Original file is cal-menu.el.
3
4 ;; Copyright (C) 1994 Free Software Foundation, Inc.
5
6 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
7 ;; Lara Rios <lrios@coewl.cen.uiuc.edu>
8 ;; Ported to XEmacs by Chuck Thompson <cthomp@cs.uiuc.edu>
9 ;; Keywords: calendar
10 ;; Human-Keywords: calendar, popup menus, menu bar
11
12 ;; This file is part of XEmacs.
13
14 ;; XEmacs is free software; you can redistribute it and/or modify it
15 ;; under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
18
19 ;; XEmacs is distributed in the hope that it will be useful, but
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 ;; General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with XEmacs; see the file COPYING. If not, write to the Free
26 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
27
28 ;;; Commentary:
29
30 ;; This collection of functions implements menu bar and popup menu support for
31 ;; calendar.el.
32
33 ;; Comments, corrections, and improvements should be sent to
34 ;; Edward M. Reingold Department of Computer Science
35 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
36 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
37 ;; Urbana, Illinois 61801
38
39 ;;; Code:
40
41 ;;(define-key calendar-mode-map 'button2 'calendar-mouse-2-date-menu)
42 ;;(define-key calendar-mode-map 'button2up 'ignore)
43
44 (defconst calendar-popup-menu-3
45 '("Calendar"
46 ["Scroll forward" scroll-calendar-left-three-months t]
47 ["Scroll backward" scroll-calendar-right-three-months t]
48 ["Mark diary entries" mark-diary-entries t]
49 ["List holidays" list-calendar-holidays t]
50 ["Mark holidays" mark-calendar-holidays t]
51 ["Unmark" calendar-unmark t]
52 ["Lunar phases" calendar-phases-of-moon t]
53 ["Show diary" show-all-diary-entries t]
54 ["Exit calendar" exit-calendar t]
55 ))
56
57 (defun calendar-popup-menu-3 (e)
58 (interactive "@e")
59 (popup-menu calendar-popup-menu-3))
60 (define-key calendar-mode-map 'button3 'calendar-popup-menu-3)
61
62 (defvar calendar-foobar nil)
63
64 (defun calendar-popup-menu-2 (e)
65 (interactive "@e")
66 (setq calendar-foobar (calendar-event-to-date e t))
67 (let ((menu (list (format "Menu - %s" (calendar-date-string calendar-foobar) t t)
68 "-----"
69 ["Holidays" calendar-mouse-holidays t]
70 ["Mark date" calendar-mouse-set-mark t]
71 ["Sunrise/sunset" calendar-mouse-sunrise/sunset t]
72 ["Other calendars" calendar-mouse-print-dates (calendar-event-to-date e)]
73 ["Diary entries" calendar-mouse-view-diary-entries t]
74 ["Insert diary entry" calendar-mouse-insert-diary-entry t]
75 ["Other Diary file entries"
76 calendar-mouse-view-other-diary-entries
77 (calendar-cursor-to-date)]
78 )))
79 (popup-menu menu)))
80 (define-key calendar-mode-map 'button2 'calendar-popup-menu-2)
81
82 (defconst calendar-scroll-menu
83 '("Scroll"
84 ["Forward 1 Month" scroll-calendar-left t]
85 ["Forward 3 Months" scroll-calendar-left-three-months t]
86 ["Forward 1 Year" (scroll-calendar-left-three-months 4) t]
87 ["Backward 1 Month" scroll-calendar-right t]
88 ["Backward 3 Months" scroll-calendar-right-three-months t]
89 ["Backward 1 Year" (scroll-calendar-right-three-months 4) t]))
90
91 (defconst calendar-goto-menu
92 '("Goto"
93 ["Today" calendar-current-month t]
94 ["Beginning of week" calendar-beginning-of-week (calendar-cursor-to-date)]
95 ["End of week" calendar-end-of-week (calendar-cursor-to-date)]
96 ["Beginning of month" calendar-beginning-of-month (calendar-cursor-to-date)]
97 ["End of month" calendar-end-of-month (calendar-cursor-to-date)]
98 ["Beginning of year" calendar-beginning-of-year (calendar-cursor-to-date)]
99 ["End of year" calendar-end-of-year (calendar-cursor-to-date)]
100 ["Other date" calendar-goto-date t]
101 ["ISO date" calendar-goto-iso-date t]
102 ["Astronomical date" calendar-goto-astro-day-number t]
103 ["Hebrew date" calendar-goto-hebrew-date t]
104 ["Islamic date" calendar-goto-islamic-date t]
105 ["Julian date" calendar-goto-julian-date t]
106 ("Mayan date"
107 ["Next Tzolkin" calendar-next-tzolkin-date t]
108 ["Previous Tzolkin" calendar-previous-tzolkin-date t]
109 ["Next Haab" calendar-next-haab-date t]
110 ["Previous Haab" calendar-previous-haab-date t]
111 ["Next Round" calendar-next-calendar-round-date t]
112 ["Previous Round" calendar-previous-calendar-round-date t])
113 ["French date" calendar-goto-french-date t]))
114
115 (defconst calendar-holidays-menu
116 '("Holidays"
117 ["One day" calendar-cursor-holidays (calendar-cursor-to-date)]
118 ["3 months" list-calendar-holidays t]
119 ["Mark" mark-calendar-holidays t]
120 ["Unmark" calendar-unmark t]))
121
122 (defconst calendar-diary-menu
123 '("Diary"
124 ["Other file" view-other-diary-entries (calendar-cursor-to-date)]
125 ["Cursor date" view-diary-entries (calendar-cursor-to-date)]
126 ["Mark all" mark-diary-entries t]
127 ["Show all" show-all-diary-entries t]
128 ["Insert daily"insert-diary-entry t]
129 ["Insert weekly" insert-weekly-diary-entry (calendar-cursor-to-date)]
130 ["Insert monthly" insert-monthly-diary-entry (calendar-cursor-to-date)]
131 ["Insert yearly" insert-yearly-diary-entry (calendar-cursor-to-date)]
132 ["Insert anniversary" insert-anniversary-diary-entry (calendar-cursor-to-date)]
133 ["Insert block" insert-block-diary-entry (calendar-cursor-to-date)]
134 ["Insert cyclic" insert-cyclic-diary-entry (calendar-cursor-to-date)]
135 ["Insert Islamic" calendar-mouse-insert-islamic-diary-entry (calendar-cursor-to-date)]
136 ["Insert Hebrew" calendar-mouse-insert-hebrew-diary-entry (calendar-cursor-to-date)]))
137
138 (defun calendar-add-menus ()
139 (set-buffer-menubar (copy-sequence current-menubar))
140 (if (assoc "Calendar" current-menubar)
141 nil
142 (add-submenu nil '("Calendar"))
143 (if (not (assoc "Scroll" current-menubar))
144 (add-submenu '("Calendar") calendar-scroll-menu))
145 (if (not (assoc "Goto" current-menubar))
146 (add-submenu '("Calendar") calendar-goto-menu))
147 (if (not (assoc "Holidays" current-menubar))
148 (add-submenu '("Calendar") calendar-holidays-menu))
149 (if (not (assoc "Diary" current-menubar))
150 (add-submenu '("Calendar") calendar-diary-menu))
151 (if (not (assoc "Moon" current-menubar))
152 (add-menu-button '("Calendar") ["Moon" calendar-phases-of-moon t]))))
153
154 (defun calendar-event-to-date (event &optional error)
155 "Date of last event.
156 If event is not on a specific date, signals an error if optional parameter
157 ERROR is t, otherwise just returns nil."
158 (save-excursion
159 (goto-char (event-point event))
160 (calendar-cursor-to-date error)))
161
162 (defun calendar-mouse-insert-hebrew-diary-entry (event)
163 "Pop up menu to insert a Hebrew-date diary entry."
164 (interactive "e")
165 (let ((menu (list (format "Hebrew insert menu - %s"
166 (calendar-hebrew-date-string
167 (calendar-cursor-to-date)))
168 "-----"
169 ["One time" insert-hebrew-diary-entry t]
170 ["Monthly" insert-monthly-hebrew-diary-entry t]
171 ["Yearly" insert-yearly-hebrew-diary-entry t])))
172 (popup-menu menu)))
173
174 (defun calendar-mouse-insert-islamic-diary-entry (event)
175 "Pop up menu to insert an Islamic-date diary entry."
176 (interactive "e")
177 (let ((menu (list (format "Islamic insert menu - %s"
178 (calendar-islamic-date-string
179 (calendar-cursor-to-date)))
180 "-----"
181 ["One time" insert-islamic-diary-entry t]
182 ["Monthly" insert-monthly-islamic-diary-entry t]
183 ["Yearly" insert-yearly-islamic-diary-entry t])))
184 (popup-menu menu)))
185
186 (defun calendar-mouse-sunrise/sunset ()
187 "Show sunrise/sunset times for mouse-selected date."
188 (interactive)
189 (save-excursion
190 (calendar-goto-date calendar-foobar)
191 (setq calendar-foobar nil)
192 (calendar-sunrise-sunset)))
193
194 (defun calendar-mouse-holidays ()
195 "Show holidays for mouse-selected date."
196 (interactive)
197 (save-excursion
198 (calendar-goto-date calendar-foobar)
199 (setq calendar-foobar nil)
200 (calendar-cursor-holidays)))
201
202 (defun calendar-mouse-view-diary-entries ()
203 "View diary entries on mouse-selected date."
204 (interactive)
205 (save-excursion
206 (calendar-goto-date calendar-foobar)
207 (setq calendar-foobar nil)
208 (view-diary-entries 1)))
209
210 (defun calendar-mouse-view-other-diary-entries (event)
211 "View diary entries from alternative file on mouse-selected date."
212 (interactive "e")
213 (save-excursion
214 (calendar-goto-date calendar-foobar)
215 (call-interactively 'view-other-diary-entries)))
216
217 (defun calendar-mouse-insert-diary-entry (event)
218 "Insert diary entry for mouse-selected date."
219 (interactive "e")
220 (save-excursion
221 (calendar-goto-date calendar-foobar)
222 (insert-diary-entry nil)))
223
224 (defun calendar-mouse-set-mark ()
225 "Mark the date under the cursor."
226 (interactive)
227 (save-excursion
228 (calendar-goto-date calendar-foobar)
229 (setq calendar-foobar nil)
230 (calendar-set-mark nil)))
231
232 (defun calendar-mouse-print-dates ()
233 "Pop up menu of equivalent dates to mouse selected date."
234 (interactive)
235 (let* ((menu (list (format "Date Menu - %s (Gregorian)"
236 (calendar-date-string calendar-foobar))
237 "-----"
238 (calendar-day-of-year-string calendar-foobar)
239 (format "ISO date: %s" (calendar-iso-date-string calendar-foobar))
240 (format "Julian date: %s"
241 (calendar-julian-date-string calendar-foobar))
242 (format "Astronomical (Julian) date (before noon): %s"
243 (calendar-astro-date-string calendar-foobar))
244 (format "Hebrew date (before sunset): %s"
245 (calendar-hebrew-date-string calendar-foobar))
246 (let ((i (calendar-islamic-date-string calendar-foobar)))
247 (if (not (string-equal i ""))
248 (format "Islamic date (before sunset): %s" i)))
249 (let ((f (calendar-french-date-string calendar-foobar)))
250 (if (not (string-equal f ""))
251 (format "French Revolutionary date: %s" f)))
252 (format "Mayan date: %s" (calendar-mayan-date-string calendar-foobar)))))
253 (popup-menu menu))
254 (setq calendar-foobar nil))
255
256 (run-hooks 'cal-xemacs-load-hook)
257
258 (provide 'cal-xemacs)
259
260 ;;; cal-menu.el ends here