Mercurial > emacs

comparison lisp/calendar/cal-menu.el @ 7442:27fdaecd7cb1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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