Mercurial > emacs
comparison lisp/calendar/cal-menu.el @ 7442:27fdaecd7cb1
(calendar-mode-map): Change binding of Mouse-2. Bind Mouse-3.
(calendar-event-to-date): Add optional error parameter.
(calendar-mouse-print-dates): Fix first line to show day of year.
(calendar-mouse-date-menu): Deleted; split into two new functions.
(calendar-mouse-2-date-menu, calendar-mouse-3-date-menu): The two functions.
author | Edward M. Reingold <reingold@emr.cs.iit.edu> |
---|---|
date | Tue, 10 May 1994 22:10:16 +0000 |
parents | f067e1a5ceb4 |
children | 57cfbcfdf92a |
comparison
equal
deleted
inserted
replaced
7441:7f25bd8883e6 | 7442:27fdaecd7cb1 |
---|---|
34 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue | 34 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue |
35 ;; Urbana, Illinois 61801 | 35 ;; Urbana, Illinois 61801 |
36 | 36 |
37 ;;; Code: | 37 ;;; Code: |
38 | 38 |
39 (define-key calendar-mode-map [down-mouse-2] 'calendar-mouse-date-menu) | 39 (define-key calendar-mode-map [mouse-2] 'calendar-mouse-2-date-menu) |
40 (define-key calendar-mode-map [mouse-3] 'calendar-mouse-3-date-menu) | |
40 | 41 |
41 (define-key calendar-mode-map [menu-bar moon] | 42 (define-key calendar-mode-map [menu-bar moon] |
42 '("Moon" . calendar-phases-of-moon)) | 43 '("Moon" . calendar-phases-of-moon)) |
43 | 44 |
44 (define-key calendar-mode-map [menu-bar diary] | 45 (define-key calendar-mode-map [menu-bar diary] |
174 (put 'insert-anniversary-diary-entry 'menu-enable '(calendar-cursor-to-date)) | 175 (put 'insert-anniversary-diary-entry 'menu-enable '(calendar-cursor-to-date)) |
175 (put 'insert-yearly-diary-entry 'menu-enable '(calendar-cursor-to-date)) | 176 (put 'insert-yearly-diary-entry 'menu-enable '(calendar-cursor-to-date)) |
176 (put 'insert-monthly-diary-entry 'menu-enable '(calendar-cursor-to-date)) | 177 (put 'insert-monthly-diary-entry 'menu-enable '(calendar-cursor-to-date)) |
177 (put 'insert-weekly-diary-entry 'menu-enable '(calendar-cursor-to-date)) | 178 (put 'insert-weekly-diary-entry 'menu-enable '(calendar-cursor-to-date)) |
178 | 179 |
179 (defun calendar-event-to-date () | 180 (defun calendar-event-to-date (&optional error) |
180 "Date of last event. Value is nil if last event was not done on a date." | 181 "Date of last event. |
181 (save-excursion | 182 If event is not on a specific date, signals an error if optional parameter |
182 (set-buffer (window-buffer (posn-window (event-start last-input-event)))) | 183 ERROR is t, otherwise just returns nil." |
184 (save-excursion | |
183 (goto-char (posn-point (event-start last-input-event))) | 185 (goto-char (posn-point (event-start last-input-event))) |
184 (calendar-cursor-to-date))) | 186 (calendar-cursor-to-date error))) |
185 | 187 |
186 (defun calendar-mouse-insert-hebrew-diary-entry (event) | 188 (defun calendar-mouse-insert-hebrew-diary-entry (event) |
187 "Pop up menu to insert a Hebrew-date diary entry." | 189 "Pop up menu to insert a Hebrew-date diary entry." |
188 (interactive "e") | 190 (interactive "e") |
189 (let ((hebrew-selection | 191 (let ((hebrew-selection |
246 (list | 248 (list |
247 "Date Menu" | 249 "Date Menu" |
248 (append | 250 (append |
249 (list | 251 (list |
250 (concat (calendar-date-string date) " (Gregorian)") | 252 (concat (calendar-date-string date) " (Gregorian)") |
253 (list (calendar-day-of-year-string date)) | |
251 (list (format "ISO date: %s" (calendar-iso-date-string date))) | 254 (list (format "ISO date: %s" (calendar-iso-date-string date))) |
252 (list (format "Julian date: %s" (calendar-julian-date-string date))) | 255 (list (format "Julian date: %s" (calendar-julian-date-string date))) |
253 (list (format "Astronomical (Julian) date (before noon): %s" | 256 (list (format "Astronomical (Julian) date (before noon): %s" |
254 (calendar-astro-date-string date))) | 257 (calendar-astro-date-string date))) |
255 (list (format "Hebrew date (before sunset): %s" | 258 (list (format "Hebrew date (before sunset): %s" |
262 (list (list (format "French Revolutionary date: %s" f))))) | 265 (list (list (format "French Revolutionary date: %s" f))))) |
263 (list | 266 (list |
264 (list | 267 (list |
265 (format "Mayan date: %s" (calendar-mayan-date-string date))))))))) | 268 (format "Mayan date: %s" (calendar-mayan-date-string date))))))))) |
266 | 269 |
267 (defun calendar-mouse-date-menu (event) | 270 (defun calendar-mouse-2-date-menu (event) |
268 "Pop up menu for selected date." | 271 "Pop up menu for Mouse-2 for selected date in the calendar window." |
269 (interactive "e") | 272 (interactive "e") |
270 (let ((selection | 273 (let* ((date (calendar-event-to-date t)) |
271 (x-popup-menu | 274 (selection |
272 event | 275 (x-popup-menu |
273 (if (calendar-event-to-date) | 276 event |
274 (list "Menu" | 277 (list "Menu" |
275 (list | 278 (list |
276 (calendar-date-string | 279 (calendar-date-string date t t) |
277 (or (calendar-event-to-date) | 280 '("Diary entries" . calendar-mouse-view-diary-entries) |
278 (error "Mouse is not on a date!")) | 281 '("Holidays" . calendar-mouse-holidays) |
279 t t) | 282 '("Mark date" . calendar-mouse-set-mark) |
280 '("Diary entries" . calendar-mouse-view-diary-entries) | 283 '("Sunrise/sunset" . calendar-mouse-sunrise/sunset) |
281 '("Holidays" . calendar-mouse-holidays) | 284 '("Other calendars" . calendar-mouse-print-dates)))))) |
282 '("Mark date" . calendar-mouse-set-mark) | |
283 '("Sunrise/sunset" . calendar-mouse-sunrise/sunset) | |
284 '("Other calendars" . calendar-mouse-print-dates))) | |
285 (list "Menu" | |
286 (list | |
287 (let ((m1 displayed-month) | |
288 (y1 displayed-year) | |
289 (m2 displayed-month) | |
290 (y2 displayed-year)) | |
291 (increment-calendar-month m1 y1 -1) | |
292 (increment-calendar-month m2 y2 1) | |
293 (if (= y1 y2) | |
294 (format "%s--%s, %d" | |
295 (substring (calendar-month-name m1) 0 3) | |
296 (substring (calendar-month-name m2) 0 3) y2) | |
297 (format "%s, %d--%s, %d" | |
298 (substring (calendar-month-name m1) 0 3) y1 | |
299 (substring (calendar-month-name m2) 0 3) y2))) | |
300 '("Scroll forward" . scroll-calendar-left-three-months) | |
301 '("Scroll backward" . scroll-calendar-right-three-months) | |
302 '("Show diary" . show-all-diary-entries) | |
303 '("Mark diary entries" . mark-diary-entries) | |
304 '("List holidays" . list-calendar-holidays) | |
305 '("Mark holidays" . mark-calendar-holidays) | |
306 '("Unmark" . calendar-unmark) | |
307 '("Lunar phases" . calendar-phases-of-moon) | |
308 '("Exit calendar" . exit-calendar))))))) | |
309 (and selection (call-interactively selection)))) | 285 (and selection (call-interactively selection)))) |
310 | 286 |
287 (defun calendar-mouse-3-date-menu (event) | |
288 "Pop up menu for Mouse-3 in the calendar window." | |
289 (interactive "e") | |
290 (let* ((m1 displayed-month) | |
291 (y1 displayed-year) | |
292 (m2 displayed-month) | |
293 (y2 displayed-year) | |
294 (junk (increment-calendar-month m1 y1 -1)) | |
295 (junk (increment-calendar-month m2 y2 1)) | |
296 (selection | |
297 (x-popup-menu | |
298 event | |
299 (list "Menu" | |
300 (list | |
301 (if (= y1 y2) | |
302 (format "%s--%s, %d" | |
303 (substring (calendar-month-name m1) 0 3) | |
304 (substring (calendar-month-name m2) 0 3) y2) | |
305 (format "%s, %d--%s, %d" | |
306 (substring (calendar-month-name m1) 0 3) y1 | |
307 (substring (calendar-month-name m2) 0 3) y2)) | |
308 '("Scroll forward" . scroll-calendar-left-three-months) | |
309 '("Scroll backward" . scroll-calendar-right-three-months) | |
310 '("Show diary" . show-all-diary-entries) | |
311 '("Mark diary entries" . mark-diary-entries) | |
312 '("List holidays" . list-calendar-holidays) | |
313 '("Mark holidays" . mark-calendar-holidays) | |
314 '("Unmark" . calendar-unmark) | |
315 '("Lunar phases" . calendar-phases-of-moon) | |
316 '("Exit calendar" . exit-calendar)))))) | |
317 (and selection (call-interactively selection)))) | |
318 | |
311 (run-hooks 'cal-menu-load-hook) | 319 (run-hooks 'cal-menu-load-hook) |
312 | 320 |
313 (provide 'cal-menu) | 321 (provide 'cal-menu) |
314 | 322 |
315 ;;; cal-menu.el ends here | 323 ;;; cal-menu.el ends here |