X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/7b1019e2781472c793d0bf74e2b9ee17894270b8..4c14013dbec3a2f130a38e61e885f1e8cc6c325b:/lisp/calendar/cal-menu.el diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index 21dfbfb7db..877be9556f 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el @@ -1,13 +1,14 @@ ;;; cal-menu.el --- calendar functions for menu bar and popup menu support ;; Copyright (C) 1994, 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008 Free Software Foundation, Inc. +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Lara Rios ;; Maintainer: Glenn Morris ;; Keywords: calendar ;; Human-Keywords: calendar, popup menus, menu bar +;; Package: calendar ;; This file is part of GNU Emacs. @@ -32,9 +33,12 @@ (require 'calendar) -(defconst cal-menu-moon-menu - '("Moon" - ["Lunar Phases" calendar-phases-of-moon])) +(defconst cal-menu-sunmoon-menu + '("Sun/Moon" + ["Lunar Phases" calendar-lunar-phases] + ["Sunrise/sunset for cursor date" calendar-sunrise-sunset] + ["Sunrise/sunset for cursor month" calendar-sunrise-sunset-month]) + "Key map for \"Sun/Moon\" menu in the calendar.") (defconst cal-menu-diary-menu '("Diary" @@ -60,22 +64,21 @@ ("Insert Hebrew" ["One time" diary-hebrew-insert-entry] ["Monthly" diary-hebrew-insert-monthly-entry] - ["Yearly" diary-hebrew-insert-yearly-entry]))) + ["Yearly" diary-hebrew-insert-yearly-entry])) + "Key map for \"Diary\" menu in the calendar.") (defun cal-menu-holiday-window-suffix () "Return a string suffix for the \"Window\" entry in `cal-menu-holidays-menu'." (let ((my1 (calendar-increment-month-cons -1)) (my2 (calendar-increment-month-cons 1))) - (if (= (cdr my1) (cdr my2)) - (format "%s-%s, %d" - (calendar-month-name (car my1) 'abbrev) - (calendar-month-name (car my2) 'abbrev) - (cdr my2)) - (format "%s, %d-%s, %d" - (calendar-month-name (car my1) 'abbrev) - (cdr my1) - (calendar-month-name (car my2) 'abbrev) - (cdr my2))))) + ;; Mon1-Mon2, Year or Mon1, Year1-Mon2, Year2. + (format "%s%s-%s, %d" + (calendar-month-name (car my1) 'abbrev) + (if (= (cdr my1) (cdr my2)) + "" + (format ", %d" (cdr my1))) + (calendar-month-name (car my2) 'abbrev) + (cdr my2)))) (defvar displayed-year) ; from calendar-generate @@ -86,7 +89,7 @@ :visible (calendar-cursor-to-date)] ["For Window -" calendar-list-holidays :suffix (cal-menu-holiday-window-suffix)] - ["For Today -" cal-menu-today-holidays + ["For Today -" (calendar-cursor-holidays (calendar-current-date)) :suffix (calendar-date-string (calendar-current-date) t t)] "--" ,@(let ((l ())) @@ -106,10 +109,11 @@ (nreverse l)) "--" ["Unmark Calendar" calendar-unmark] - ["Mark Holidays" calendar-mark-holidays])) + ["Mark Holidays" calendar-mark-holidays]) + "Key map for \"Holidays\" menu in the calendar.") (defconst cal-menu-goto-menu - '("Go To" + '("Goto" ["Today" calendar-goto-today] ["Beginning of Week" calendar-beginning-of-week] ["End of Week" calendar-end-of-week] @@ -137,86 +141,43 @@ ["Previous Haab" calendar-mayan-previous-haab-date] ["Next Round" calendar-mayan-next-round-date] ["Previous Round" calendar-mayan-previous-round-date]) - ["French Date" calendar-french-goto-date])) + ["French Date" calendar-french-goto-date]) + "Key map for \"Goto\" menu in the calendar.") (defconst cal-menu-scroll-menu '("Scroll" + ["Scroll Commands" nil :help "Commands that scroll the visible window"] ["Forward 1 Month" calendar-scroll-left] ["Forward 3 Months" calendar-scroll-left-three-months] ["Forward 1 Year" (calendar-scroll-left 12) :keys "4 C-v"] ["Backward 1 Month" calendar-scroll-right] ["Backward 3 Months" calendar-scroll-right-three-months] - ["Backward 1 Year" (calendar-scroll-right 12) :keys "4 M-v"])) - -(defun cal-menu-x-popup-menu (position menu) - "Like `x-popup-menu', but print an error message if popups are unavailable. -POSITION and MENU are passed to `x-popup-menu'." - (if (display-popup-menus-p) - (x-popup-menu position menu) - (error "Popup menus are not available on this system"))) - -(defun cal-menu-list-holidays-year () - "Display a list of the holidays of the selected date's year." - (interactive) - (holiday-list (calendar-extract-year (calendar-cursor-to-date)))) - -(defun cal-menu-list-holidays-following-year () - "Display a list of the holidays of the following year." - (interactive) - (holiday-list (1+ (calendar-extract-year (calendar-cursor-to-date))))) - -(defun cal-menu-list-holidays-previous-year () - "Display a list of the holidays of the previous year." - (interactive) - (holiday-list (1- (calendar-extract-year (calendar-cursor-to-date))))) - -(defun cal-menu-event-to-date (&optional error) - "Date of last event. -If event is not on a specific date, signals an error if optional parameter -ERROR is non-nil, otherwise just returns nil." - (with-current-buffer - (window-buffer (posn-window (event-start last-input-event))) - (goto-char (posn-point (event-start last-input-event))) - (calendar-cursor-to-date error))) - -(defun calendar-mouse-goto-date (date) - "Go to DATE in the buffer specified by `last-input-event'." - (set-buffer (window-buffer (posn-window (event-start last-input-event)))) - (calendar-goto-date date)) - -(defun calendar-mouse-sunrise/sunset () - "Show sunrise/sunset times for mouse-selected date." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (calendar-sunrise-sunset))) - -(defun cal-menu-today-holidays () - "Show holidays for today's date." - (interactive) - (save-excursion - (calendar-cursor-to-date (calendar-current-date)) - (calendar-cursor-holidays))) - -(autoload 'calendar-check-holidays "holidays") - -(defun calendar-mouse-holidays (&optional event) - "Pop up menu of holidays for mouse selected date. -EVENT is the event that invoked this command." - (interactive "e") - (let* ((date (cal-menu-event-to-date)) - (title (format "Holidays for %s" (calendar-date-string date))) - (selection - (cal-menu-x-popup-menu - event - (list title - (append (list title) - (or (mapcar 'list (calendar-check-holidays date)) - '("None"))))))) - (and selection (call-interactively selection)))) + ["Backward 1 Year" (calendar-scroll-right 12) :keys "4 M-v"] + "--" + ["Motion Commands" nil :help "Commands that move point"] + ["Forward 1 Day" calendar-forward-day] + ["Forward 1 Week" calendar-forward-week] + ["Forward 1 Month" calendar-forward-month] + ["Forward 1 Year" calendar-forward-year] + ["Backward 1 Day" calendar-backward-day] + ["Backward 1 Week" calendar-backward-week] + ["Backward 1 Month" calendar-backward-month] + ["Backward 1 Year" calendar-backward-year]) + "Key map for \"Scroll\" menu in the calendar.") + +(declare-function x-popup-menu "menu.c" (position menu)) + +(defmacro cal-menu-x-popup-menu (event title &rest body) + "Call `x-popup-menu' at position EVENT, with TITLE and contents BODY. +Signals an error if popups are unavailable." + (declare (indent 2)) + `(if (display-popup-menus-p) + (x-popup-menu ,event (list ,title (append (list ,title) ,@body))) + (error "Popup menus are not available on this system"))) (autoload 'diary-list-entries "diary-lib") -(defvar diary-show-holidays-flag) ; only called from calendar.el +;; Autoloaded in diary-lib. +(declare-function calendar-check-holidays "holidays" (date)) (defun calendar-mouse-view-diary-entries (&optional date diary event) "Pop up menu of diary entries for mouse-selected date. @@ -224,195 +185,77 @@ Use optional DATE and alternative file DIARY. EVENT is the event that invoked this command. Shows holidays if `diary-show-holidays-flag' is non-nil." (interactive "i\ni\ne") - (let* ((date (or date (cal-menu-event-to-date))) + (let* ((date (or date (calendar-cursor-to-date nil event))) (diary-file (or diary diary-file)) (diary-list-include-blanks nil) - (diary-display-hook 'ignore) - (diary-entries - (mapcar (lambda (x) (split-string (cadr x) "\n")) - (diary-list-entries date 1 'list-only))) + (diary-entries (mapcar (lambda (x) (split-string (cadr x) "\n")) + (diary-list-entries date 1 'list-only))) (holidays (if diary-show-holidays-flag (calendar-check-holidays date))) - (title (concat "Diary entries " - (if diary (format "from %s " diary) "") - "for " + (title (format "Diary entries%s for %s" + (if diary (format " from %s" diary) "") (calendar-date-string date))) - (selection - (cal-menu-x-popup-menu - event - (list title - (append - (list title) - (mapcar (lambda (x) (list (concat " " x))) holidays) - (if holidays - (list "--shadow-etched-in" "--shadow-etched-in")) - (if diary-entries - (mapcar 'list (apply 'append diary-entries)) - '("None"))))))) + (selection (cal-menu-x-popup-menu event title + (mapcar (lambda (x) (list (concat " " x))) holidays) + (if holidays + (list "--shadow-etched-in" "--shadow-etched-in")) + (if diary-entries + (mapcar 'list (apply 'append diary-entries)) + '("None"))))) (and selection (call-interactively selection)))) -(defun calendar-mouse-view-other-diary-entries () +(defun calendar-mouse-view-other-diary-entries (&optional event) "Pop up menu of diary entries from alternative file on mouse-selected date." - (interactive) - (calendar-mouse-view-diary-entries - (cal-menu-event-to-date) - (read-file-name "Enter diary file name: " default-directory nil t))) - -(defun calendar-mouse-insert-diary-entry () - "Insert diary entry for mouse-selected date." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (diary-insert-entry nil))) - -(defun calendar-mouse-set-mark () - "Mark the date under the cursor." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (calendar-set-mark nil))) - -(defun calendar-mouse-tex-day () - "Make a buffer with LaTeX commands for the day mouse is on." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-day nil))) - -(defun calendar-mouse-tex-week () - "One page calendar for week indicated by cursor. -Holidays are included if `cal-tex-holidays' is non-nil." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-week nil))) - -(defun calendar-mouse-tex-week2 () - "Make a buffer with LaTeX commands for the week cursor is on. -The printed output will be on two pages." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-week2 nil))) - -(defun calendar-mouse-tex-week-iso () - "One page calendar for week indicated by cursor. -Holidays are included if `cal-tex-holidays' is non-nil." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-week-iso nil))) - -(defun calendar-mouse-tex-week-monday () - "One page calendar for week indicated by cursor." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-week-monday nil))) - -(defun calendar-mouse-tex-filofax-daily () - "Day-per-page Filofax calendar for week indicated by cursor." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-filofax-daily nil))) - -(defun calendar-mouse-tex-filofax-2week () - "One page Filofax calendar for week indicated by cursor." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-filofax-2week nil))) - -(defun calendar-mouse-tex-filofax-week () - "Two page Filofax calendar for week indicated by cursor." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-filofax-week nil))) - -(defun calendar-mouse-tex-month () - "Make a buffer with LaTeX commands for the month cursor is on. -Calendar is condensed onto one page." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-month nil))) - -(defun calendar-mouse-tex-month-landscape () - "Make a buffer with LaTeX commands for the month cursor is on. -The output is in landscape format, one month to a page." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-month-landscape nil))) - -(defun calendar-mouse-tex-year () - "Make a buffer with LaTeX commands for the year cursor is on." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-year nil))) - -(defun calendar-mouse-tex-filofax-year () - "Make a buffer with LaTeX commands for Filofax calendar of year cursor is on." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-filofax-year nil))) - -(defun calendar-mouse-tex-year-landscape () - "Make a buffer with LaTeX commands for the year cursor is on." - (interactive) - (save-excursion - (calendar-mouse-goto-date (cal-menu-event-to-date)) - (cal-tex-cursor-year-landscape nil))) - -(defun calendar-mouse-print-dates (&optional event) - "Pop up menu of equivalent dates to mouse selected date. -EVENT is the event that invoked this command." (interactive "e") - (let* ((date (cal-menu-event-to-date)) - (title (format "%s (Gregorian)" (calendar-date-string date))) - (selection - (cal-menu-x-popup-menu - event - (list title - (append (list title) - (mapcar 'list (calendar-other-dates date))))))) - (and selection (call-interactively selection)))) - + (calendar-mouse-view-diary-entries + (calendar-cursor-to-date nil event) + (read-file-name "Enter diary file name: " default-directory nil t) + event)) + +;; In 22, the equivalent code gave an error when not called on a date, +;; but easymenu does not seem to allow this (?). +;; The ignore-errors is because `documentation' can end up calling +;; this in a non-calendar buffer where displayed-month is unbound. (Bug#3862) (defun cal-menu-set-date-title (menu) "Convert date of last event to title suitable for MENU." - (easy-menu-filter-return - menu (calendar-date-string (cal-menu-event-to-date t) t nil))) + (let ((date (ignore-errors (calendar-cursor-to-date nil last-input-event)))) + (if date + (easy-menu-filter-return menu (calendar-date-string date t nil)) + (message "Not on a date!") + nil))) (easy-menu-define cal-menu-context-mouse-menu nil - "Pop up menu for Mouse-2 for selected date in the calendar window." - '("cal-menu-mouse2" :filter cal-menu-set-date-title + "Pop up mouse menu for selected date in the calendar window." + '("cal-menu-context-mouse-menu" :filter cal-menu-set-date-title "--" - ["Holidays" calendar-mouse-holidays] - ["Mark date" calendar-mouse-set-mark] - ["Sunrise/sunset" calendar-mouse-sunrise/sunset] - ["Other calendars" calendar-mouse-print-dates] + ["Holidays" calendar-cursor-holidays] + ["Mark date" calendar-set-mark] + ["Sunrise/sunset" calendar-sunrise-sunset] + ["Other calendars" calendar-print-other-dates] + ;; There was a bug (#447; fixed) with last-nonmenu-event and submenus. + ;; These did not work if called without calendar window selected. ("Prepare LaTeX buffer" - ["Daily (1 page)" calendar-mouse-tex-day] - ["Weekly (1 page)" calendar-mouse-tex-week] - ["Weekly (2 pages)" calendar-mouse-tex-week2] - ["Weekly (other style; 1 page)" calendar-mouse-tex-week-iso] - ["Weekly (yet another style; 1 page)" calendar-mouse-tex-week-monday] - ["Monthly" calendar-mouse-tex-month] - ["Monthly (landscape)" calendar-mouse-tex-month-landscape] - ["Yearly" calendar-mouse-tex-year] - ["Yearly (landscape)" calendar-mouse-tex-year-landscape] + ["Daily (1 page)" cal-tex-cursor-day] + ["Weekly (1 page)" cal-tex-cursor-week] + ["Weekly (2 pages)" cal-tex-cursor-week2] + ["Weekly (other style; 1 page)" cal-tex-cursor-week-iso] + ["Weekly (yet another style; 1 page)" cal-tex-cursor-week-monday] + ["Monthly" cal-tex-cursor-month] + ["Monthly (landscape)" cal-tex-cursor-month-landscape] + ["Yearly" cal-tex-cursor-year] + ["Yearly (landscape)" cal-tex-cursor-year-landscape] ("Filofax styles" - ["Filofax Daily (one-day-per-page)" calendar-mouse-tex-filofax-daily] - ["Filofax Weekly (2-weeks-at-a-glance)" calendar-mouse-tex-filofax-2week] - ["Filofax Weekly (week-at-a-glance)" calendar-mouse-tex-filofax-week] - ["Filofax Yearly" calendar-mouse-tex-filofax-year])) - ["Diary entries" calendar-mouse-view-diary-entries] - ["Insert diary entry" calendar-mouse-insert-diary-entry] - ["Other diary file entries" calendar-mouse-view-other-diary-entries])) + ["Filofax Daily (one-day-per-page)" cal-tex-cursor-filofax-daily] + ["Filofax Weekly (2-weeks-at-a-glance)" cal-tex-cursor-filofax-2week] + ["Filofax Weekly (week-at-a-glance)" cal-tex-cursor-filofax-week] + ["Filofax Yearly" cal-tex-cursor-filofax-year])) + ("Write HTML calendar" + ["For selected month" cal-html-cursor-month] + ["For selected year" cal-html-cursor-year]) + ["Diary entries" calendar-mouse-view-diary-entries :keys "d"] + ["Insert diary entry" diary-insert-entry] + ["Other diary file entries" calendar-mouse-view-other-diary-entries + :keys "D"])) (easy-menu-define cal-menu-global-mouse-menu nil "Menu bound to a mouse event, not specific to the mouse-click location." @@ -423,7 +266,8 @@ EVENT is the event that invoked this command." ["List holidays" calendar-list-holidays] ["Mark holidays" calendar-mark-holidays] ["Unmark" calendar-unmark] - ["Lunar phases" calendar-phases-of-moon] + ["Lunar phases" calendar-lunar-phases] + ["Sunrise times for month" calendar-sunrise-sunset-month] ["Show diary" diary-show-all-entries] ["Exit calendar" calendar-exit]))