|
0
|
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
|
|
70
|
25 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
26 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
0
|
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
|
