|
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
|
|
16
|
25 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
27 ;; Boston, MA 02111-1307, USA.
|
|
0
|
28
|
|
|
29 ;;; Commentary:
|
|
|
30
|
|
|
31 ;; This collection of functions implements menu bar and popup menu support for
|
|
|
32 ;; calendar.el.
|
|
|
33
|
|
|
34 ;; Comments, corrections, and improvements should be sent to
|
|
|
35 ;; Edward M. Reingold Department of Computer Science
|
|
|
36 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
|
|
|
37 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
|
|
|
38 ;; Urbana, Illinois 61801
|
|
|
39
|
|
|
40 ;;; Code:
|
|
|
41
|
|
|
42 ;;(define-key calendar-mode-map 'button2 'calendar-mouse-2-date-menu)
|
|
|
43 ;;(define-key calendar-mode-map 'button2up 'ignore)
|
|
|
44
|
|
|
45 (defconst calendar-popup-menu-3
|
|
|
46 '("Calendar"
|
|
|
47 ["Scroll forward" scroll-calendar-left-three-months t]
|
|
|
48 ["Scroll backward" scroll-calendar-right-three-months t]
|
|
|
49 ["Mark diary entries" mark-diary-entries t]
|
|
|
50 ["List holidays" list-calendar-holidays t]
|
|
|
51 ["Mark holidays" mark-calendar-holidays t]
|
|
|
52 ["Unmark" calendar-unmark t]
|
|
|
53 ["Lunar phases" calendar-phases-of-moon t]
|
|
|
54 ["Show diary" show-all-diary-entries t]
|
|
|
55 ["Exit calendar" exit-calendar t]
|
|
|
56 ))
|
|
|
57
|
|
|
58 (defun calendar-popup-menu-3 (e)
|
|
|
59 (interactive "@e")
|
|
|
60 (popup-menu calendar-popup-menu-3))
|
|
|
61 (define-key calendar-mode-map 'button3 'calendar-popup-menu-3)
|
|
|
62
|
|
|
63 (defvar calendar-foobar nil)
|
|
|
64
|
|
|
65 (defun calendar-popup-menu-2 (e)
|
|
|
66 (interactive "@e")
|
|
|
67 (setq calendar-foobar (calendar-event-to-date e t))
|
|
|
68 (let ((menu (list (format "Menu - %s" (calendar-date-string calendar-foobar) t t)
|
|
|
69 "-----"
|
|
|
70 ["Holidays" calendar-mouse-holidays t]
|
|
|
71 ["Mark date" calendar-mouse-set-mark t]
|
|
|
72 ["Sunrise/sunset" calendar-mouse-sunrise/sunset t]
|
|
|
73 ["Other calendars" calendar-mouse-print-dates (calendar-event-to-date e)]
|
|
|
74 ["Diary entries" calendar-mouse-view-diary-entries t]
|
|
|
75 ["Insert diary entry" calendar-mouse-insert-diary-entry t]
|
|
|
76 ["Other Diary file entries"
|
|
|
77 calendar-mouse-view-other-diary-entries
|
|
|
78 (calendar-cursor-to-date)]
|
|
|
79 )))
|
|
|
80 (popup-menu menu)))
|
|
|
81 (define-key calendar-mode-map 'button2 'calendar-popup-menu-2)
|
|
|
82
|
|
|
83 (defconst calendar-scroll-menu
|
|
|
84 '("Scroll"
|
|
|
85 ["Forward 1 Month" scroll-calendar-left t]
|
|
|
86 ["Forward 3 Months" scroll-calendar-left-three-months t]
|
|
|
87 ["Forward 1 Year" (scroll-calendar-left-three-months 4) t]
|
|
|
88 ["Backward 1 Month" scroll-calendar-right t]
|
|
|
89 ["Backward 3 Months" scroll-calendar-right-three-months t]
|
|
|
90 ["Backward 1 Year" (scroll-calendar-right-three-months 4) t]))
|
|
|
91
|
|
|
92 (defconst calendar-goto-menu
|
|
|
93 '("Goto"
|
|
|
94 ["Today" calendar-current-month t]
|
|
|
95 ["Beginning of week" calendar-beginning-of-week (calendar-cursor-to-date)]
|
|
|
96 ["End of week" calendar-end-of-week (calendar-cursor-to-date)]
|
|
|
97 ["Beginning of month" calendar-beginning-of-month (calendar-cursor-to-date)]
|
|
|
98 ["End of month" calendar-end-of-month (calendar-cursor-to-date)]
|
|
|
99 ["Beginning of year" calendar-beginning-of-year (calendar-cursor-to-date)]
|
|
|
100 ["End of year" calendar-end-of-year (calendar-cursor-to-date)]
|
|
|
101 ["Other date" calendar-goto-date t]
|
|
|
102 ["ISO date" calendar-goto-iso-date t]
|
|
|
103 ["Astronomical date" calendar-goto-astro-day-number t]
|
|
|
104 ["Hebrew date" calendar-goto-hebrew-date t]
|
|
|
105 ["Islamic date" calendar-goto-islamic-date t]
|
|
|
106 ["Julian date" calendar-goto-julian-date t]
|
|
|
107 ("Mayan date"
|
|
|
108 ["Next Tzolkin" calendar-next-tzolkin-date t]
|
|
|
109 ["Previous Tzolkin" calendar-previous-tzolkin-date t]
|
|
|
110 ["Next Haab" calendar-next-haab-date t]
|
|
|
111 ["Previous Haab" calendar-previous-haab-date t]
|
|
|
112 ["Next Round" calendar-next-calendar-round-date t]
|
|
|
113 ["Previous Round" calendar-previous-calendar-round-date t])
|
|
|
114 ["French date" calendar-goto-french-date t]))
|
|
|
115
|
|
|
116 (defconst calendar-holidays-menu
|
|
|
117 '("Holidays"
|
|
|
118 ["One day" calendar-cursor-holidays (calendar-cursor-to-date)]
|
|
|
119 ["3 months" list-calendar-holidays t]
|
|
|
120 ["Mark" mark-calendar-holidays t]
|
|
|
121 ["Unmark" calendar-unmark t]))
|
|
|
122
|
|
|
123 (defconst calendar-diary-menu
|
|
|
124 '("Diary"
|
|
|
125 ["Other file" view-other-diary-entries (calendar-cursor-to-date)]
|
|
|
126 ["Cursor date" view-diary-entries (calendar-cursor-to-date)]
|
|
|
127 ["Mark all" mark-diary-entries t]
|
|
|
128 ["Show all" show-all-diary-entries t]
|
|
|
129 ["Insert daily"insert-diary-entry t]
|
|
|
130 ["Insert weekly" insert-weekly-diary-entry (calendar-cursor-to-date)]
|
|
|
131 ["Insert monthly" insert-monthly-diary-entry (calendar-cursor-to-date)]
|
|
|
132 ["Insert yearly" insert-yearly-diary-entry (calendar-cursor-to-date)]
|
|
|
133 ["Insert anniversary" insert-anniversary-diary-entry (calendar-cursor-to-date)]
|
|
|
134 ["Insert block" insert-block-diary-entry (calendar-cursor-to-date)]
|
|
|
135 ["Insert cyclic" insert-cyclic-diary-entry (calendar-cursor-to-date)]
|
|
|
136 ["Insert Islamic" calendar-mouse-insert-islamic-diary-entry (calendar-cursor-to-date)]
|
|
|
137 ["Insert Hebrew" calendar-mouse-insert-hebrew-diary-entry (calendar-cursor-to-date)]))
|
|
|
138
|
|
|
139 (defun calendar-add-menus ()
|
|
|
140 (set-buffer-menubar (copy-sequence current-menubar))
|
|
|
141 (if (assoc "Calendar" current-menubar)
|
|
|
142 nil
|
|
|
143 (add-submenu nil '("Calendar"))
|
|
|
144 (if (not (assoc "Scroll" current-menubar))
|
|
|
145 (add-submenu '("Calendar") calendar-scroll-menu))
|
|
|
146 (if (not (assoc "Goto" current-menubar))
|
|
|
147 (add-submenu '("Calendar") calendar-goto-menu))
|
|
|
148 (if (not (assoc "Holidays" current-menubar))
|
|
|
149 (add-submenu '("Calendar") calendar-holidays-menu))
|
|
|
150 (if (not (assoc "Diary" current-menubar))
|
|
|
151 (add-submenu '("Calendar") calendar-diary-menu))
|
|
|
152 (if (not (assoc "Moon" current-menubar))
|
|
|
153 (add-menu-button '("Calendar") ["Moon" calendar-phases-of-moon t]))))
|
|
|
154
|
|
|
155 (defun calendar-event-to-date (event &optional error)
|
|
|
156 "Date of last event.
|
|
|
157 If event is not on a specific date, signals an error if optional parameter
|
|
|
158 ERROR is t, otherwise just returns nil."
|
|
|
159 (save-excursion
|
|
|
160 (goto-char (event-point event))
|
|
|
161 (calendar-cursor-to-date error)))
|
|
|
162
|
|
|
163 (defun calendar-mouse-insert-hebrew-diary-entry (event)
|
|
|
164 "Pop up menu to insert a Hebrew-date diary entry."
|
|
|
165 (interactive "e")
|
|
|
166 (let ((menu (list (format "Hebrew insert menu - %s"
|
|
|
167 (calendar-hebrew-date-string
|
|
|
168 (calendar-cursor-to-date)))
|
|
|
169 "-----"
|
|
|
170 ["One time" insert-hebrew-diary-entry t]
|
|
|
171 ["Monthly" insert-monthly-hebrew-diary-entry t]
|
|
|
172 ["Yearly" insert-yearly-hebrew-diary-entry t])))
|
|
|
173 (popup-menu menu)))
|
|
|
174
|
|
|
175 (defun calendar-mouse-insert-islamic-diary-entry (event)
|
|
|
176 "Pop up menu to insert an Islamic-date diary entry."
|
|
|
177 (interactive "e")
|
|
|
178 (let ((menu (list (format "Islamic insert menu - %s"
|
|
|
179 (calendar-islamic-date-string
|
|
|
180 (calendar-cursor-to-date)))
|
|
|
181 "-----"
|
|
|
182 ["One time" insert-islamic-diary-entry t]
|
|
|
183 ["Monthly" insert-monthly-islamic-diary-entry t]
|
|
|
184 ["Yearly" insert-yearly-islamic-diary-entry t])))
|
|
|
185 (popup-menu menu)))
|
|
|
186
|
|
|
187 (defun calendar-mouse-sunrise/sunset ()
|
|
|
188 "Show sunrise/sunset times for mouse-selected date."
|
|
|
189 (interactive)
|
|
|
190 (save-excursion
|
|
|
191 (calendar-goto-date calendar-foobar)
|
|
|
192 (setq calendar-foobar nil)
|
|
|
193 (calendar-sunrise-sunset)))
|
|
|
194
|
|
|
195 (defun calendar-mouse-holidays ()
|
|
|
196 "Show holidays for mouse-selected date."
|
|
|
197 (interactive)
|
|
|
198 (save-excursion
|
|
|
199 (calendar-goto-date calendar-foobar)
|
|
|
200 (setq calendar-foobar nil)
|
|
|
201 (calendar-cursor-holidays)))
|
|
|
202
|
|
|
203 (defun calendar-mouse-view-diary-entries ()
|
|
|
204 "View diary entries on mouse-selected date."
|
|
|
205 (interactive)
|
|
|
206 (save-excursion
|
|
|
207 (calendar-goto-date calendar-foobar)
|
|
|
208 (setq calendar-foobar nil)
|
|
|
209 (view-diary-entries 1)))
|
|
|
210
|
|
|
211 (defun calendar-mouse-view-other-diary-entries (event)
|
|
|
212 "View diary entries from alternative file on mouse-selected date."
|
|
|
213 (interactive "e")
|
|
|
214 (save-excursion
|
|
|
215 (calendar-goto-date calendar-foobar)
|
|
|
216 (call-interactively 'view-other-diary-entries)))
|
|
|
217
|
|
|
218 (defun calendar-mouse-insert-diary-entry (event)
|
|
|
219 "Insert diary entry for mouse-selected date."
|
|
|
220 (interactive "e")
|
|
|
221 (save-excursion
|
|
|
222 (calendar-goto-date calendar-foobar)
|
|
|
223 (insert-diary-entry nil)))
|
|
|
224
|
|
|
225 (defun calendar-mouse-set-mark ()
|
|
|
226 "Mark the date under the cursor."
|
|
|
227 (interactive)
|
|
|
228 (save-excursion
|
|
|
229 (calendar-goto-date calendar-foobar)
|
|
|
230 (setq calendar-foobar nil)
|
|
|
231 (calendar-set-mark nil)))
|
|
|
232
|
|
|
233 (defun calendar-mouse-print-dates ()
|
|
|
234 "Pop up menu of equivalent dates to mouse selected date."
|
|
|
235 (interactive)
|
|
|
236 (let* ((menu (list (format "Date Menu - %s (Gregorian)"
|
|
|
237 (calendar-date-string calendar-foobar))
|
|
|
238 "-----"
|
|
|
239 (calendar-day-of-year-string calendar-foobar)
|
|
|
240 (format "ISO date: %s" (calendar-iso-date-string calendar-foobar))
|
|
|
241 (format "Julian date: %s"
|
|
|
242 (calendar-julian-date-string calendar-foobar))
|
|
|
243 (format "Astronomical (Julian) date (before noon): %s"
|
|
|
244 (calendar-astro-date-string calendar-foobar))
|
|
|
245 (format "Hebrew date (before sunset): %s"
|
|
|
246 (calendar-hebrew-date-string calendar-foobar))
|
|
|
247 (let ((i (calendar-islamic-date-string calendar-foobar)))
|
|
|
248 (if (not (string-equal i ""))
|
|
|
249 (format "Islamic date (before sunset): %s" i)))
|
|
|
250 (let ((f (calendar-french-date-string calendar-foobar)))
|
|
|
251 (if (not (string-equal f ""))
|
|
|
252 (format "French Revolutionary date: %s" f)))
|
|
|
253 (format "Mayan date: %s" (calendar-mayan-date-string calendar-foobar)))))
|
|
|
254 (popup-menu menu))
|
|
|
255 (setq calendar-foobar nil))
|
|
|
256
|
|
|
257 (run-hooks 'cal-xemacs-load-hook)
|
|
|
258
|
|
|
259 (provide 'cal-xemacs)
|
|
|
260
|
|
|
261 ;;; cal-menu.el ends here
|
