Mercurial > emacs
changeset 101084:38710cc3b8b5
(calendar-lunar-phases): Add event handling, for when called from
menus with the calendar buffer not current.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sat, 10 Jan 2009 22:00:33 +0000 |
parents | 27e9141ce15b |
children | 8d9cf977e8f5 |
files | lisp/calendar/lunar.el |
diffstat | 1 files changed, 36 insertions(+), 30 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/calendar/lunar.el Sat Jan 10 22:00:14 2009 +0000 +++ b/lisp/calendar/lunar.el Sat Jan 10 22:00:33 2009 +0000 @@ -178,36 +178,42 @@ (defvar displayed-year) ;;;###cal-autoload -(defun calendar-lunar-phases () - "Create a buffer with the lunar phases for the current calendar window." - (interactive) - (message "Computing phases of the moon...") - (let ((m1 displayed-month) - (y1 displayed-year) - (m2 displayed-month) - (y2 displayed-year)) - (calendar-increment-month m1 y1 -1) - (calendar-increment-month m2 y2 1) - (calendar-in-read-only-buffer lunar-phases-buffer - (calendar-set-mode-line - (if (= y1 y2) - (format "Phases of the Moon from %s to %s, %d%%-" - (calendar-month-name m1) (calendar-month-name m2) y2) - (format "Phases of the Moon from %s, %d to %s, %d%%-" - (calendar-month-name m1) y1 (calendar-month-name m2) y2))) - (insert - (mapconcat - (lambda (x) - (let ((date (car x)) - (time (cadr x)) - (phase (nth 2 x))) - (concat (calendar-date-string date) - ": " - (lunar-phase-name phase) - " " - time))) - (lunar-phase-list m1 y1) "\n"))) - (message "Computing phases of the moon...done"))) +(defun calendar-lunar-phases (&optional event) + "Create a buffer with the lunar phases for the current calendar window. +If EVENT is non-nil, it's an event indicating the buffer position to +use instead of point." + (interactive (list last-nonmenu-event)) + ;; If called from a menu, with the calendar window not selected. + (with-current-buffer + (if event (window-buffer (posn-window (event-start event))) + (current-buffer)) + (message "Computing phases of the moon...") + (let ((m1 displayed-month) + (y1 displayed-year) + (m2 displayed-month) + (y2 displayed-year)) + (calendar-increment-month m1 y1 -1) + (calendar-increment-month m2 y2 1) + (calendar-in-read-only-buffer lunar-phases-buffer + (calendar-set-mode-line + (if (= y1 y2) + (format "Phases of the Moon from %s to %s, %d%%-" + (calendar-month-name m1) (calendar-month-name m2) y2) + (format "Phases of the Moon from %s, %d to %s, %d%%-" + (calendar-month-name m1) y1 (calendar-month-name m2) y2))) + (insert + (mapconcat + (lambda (x) + (let ((date (car x)) + (time (cadr x)) + (phase (nth 2 x))) + (concat (calendar-date-string date) + ": " + (lunar-phase-name phase) + " " + time))) + (lunar-phase-list m1 y1) "\n"))) + (message "Computing phases of the moon...done")))) ;;;###cal-autoload (define-obsolete-function-alias 'calendar-phases-of-moon