| 1 | ;;; cal-menu.el --- calendar functions for menu bar and popup menu support |
| 2 | |
| 3 | ;; Copyright (C) 1994, 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
| 4 | ;; 2008, 2009, 2010 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
| 7 | ;; Lara Rios <lrios@coewl.cen.uiuc.edu> |
| 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
| 9 | ;; Keywords: calendar |
| 10 | ;; Human-Keywords: calendar, popup menus, menu bar |
| 11 | |
| 12 | ;; This file is part of GNU Emacs. |
| 13 | |
| 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 15 | ;; it under the terms of the GNU General Public License as published by |
| 16 | ;; the Free Software Foundation, either version 3 of the License, or |
| 17 | ;; (at your option) any later version. |
| 18 | |
| 19 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 22 | ;; GNU General Public License for more details. |
| 23 | |
| 24 | ;; You should have received a copy of the GNU General Public License |
| 25 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 26 | |
| 27 | ;;; Commentary: |
| 28 | |
| 29 | ;; See calendar.el. |
| 30 | |
| 31 | ;;; Code: |
| 32 | |
| 33 | (require 'calendar) |
| 34 | |
| 35 | (defconst cal-menu-sunmoon-menu |
| 36 | '("Sun/Moon" |
| 37 | ["Lunar Phases" calendar-lunar-phases] |
| 38 | ["Sunrise/sunset for cursor date" calendar-sunrise-sunset] |
| 39 | ["Sunrise/sunset for cursor month" calendar-sunrise-sunset-month]) |
| 40 | "Key map for \"Sun/Moon\" menu in the calendar.") |
| 41 | |
| 42 | (defconst cal-menu-diary-menu |
| 43 | '("Diary" |
| 44 | ["Other File" diary-view-other-diary-entries] |
| 45 | ["Cursor Date" diary-view-entries] |
| 46 | ["Mark All" diary-mark-entries] |
| 47 | ["Show All" diary-show-all-entries] |
| 48 | ["Insert Diary Entry" diary-insert-entry] |
| 49 | ["Insert Weekly" diary-insert-weekly-entry] |
| 50 | ["Insert Monthly" diary-insert-monthly-entry] |
| 51 | ["Insert Yearly" diary-insert-yearly-entry] |
| 52 | ["Insert Anniversary" diary-insert-anniversary-entry] |
| 53 | ["Insert Block" diary-insert-block-entry] |
| 54 | ["Insert Cyclic" diary-insert-cyclic-entry] |
| 55 | ("Insert Baha'i" |
| 56 | ["One time" diary-bahai-insert-entry] |
| 57 | ["Monthly" diary-bahai-insert-monthly-entry] |
| 58 | ["Yearly" diary-bahai-insert-yearly-entry]) |
| 59 | ("Insert Islamic" |
| 60 | ["One time" diary-islamic-insert-entry] |
| 61 | ["Monthly" diary-islamic-insert-monthly-entry] |
| 62 | ["Yearly" diary-islamic-insert-yearly-entry]) |
| 63 | ("Insert Hebrew" |
| 64 | ["One time" diary-hebrew-insert-entry] |
| 65 | ["Monthly" diary-hebrew-insert-monthly-entry] |
| 66 | ["Yearly" diary-hebrew-insert-yearly-entry])) |
| 67 | "Key map for \"Diary\" menu in the calendar.") |
| 68 | |
| 69 | (defun cal-menu-holiday-window-suffix () |
| 70 | "Return a string suffix for the \"Window\" entry in `cal-menu-holidays-menu'." |
| 71 | (let ((my1 (calendar-increment-month-cons -1)) |
| 72 | (my2 (calendar-increment-month-cons 1))) |
| 73 | ;; Mon1-Mon2, Year or Mon1, Year1-Mon2, Year2. |
| 74 | (format "%s%s-%s, %d" |
| 75 | (calendar-month-name (car my1) 'abbrev) |
| 76 | (if (= (cdr my1) (cdr my2)) |
| 77 | "" |
| 78 | (format ", %d" (cdr my1))) |
| 79 | (calendar-month-name (car my2) 'abbrev) |
| 80 | (cdr my2)))) |
| 81 | |
| 82 | (defvar displayed-year) ; from calendar-generate |
| 83 | |
| 84 | (defconst cal-menu-holidays-menu |
| 85 | `("Holidays" |
| 86 | ["For Cursor Date -" calendar-cursor-holidays |
| 87 | :suffix (calendar-date-string (calendar-cursor-to-date) t t) |
| 88 | :visible (calendar-cursor-to-date)] |
| 89 | ["For Window -" calendar-list-holidays |
| 90 | :suffix (cal-menu-holiday-window-suffix)] |
| 91 | ["For Today -" (calendar-cursor-holidays (calendar-current-date)) |
| 92 | :suffix (calendar-date-string (calendar-current-date) t t)] |
| 93 | "--" |
| 94 | ,@(let ((l ())) |
| 95 | ;; Show 11 years--5 before, 5 after year of middle month. |
| 96 | ;; We used to use :suffix rather than :label and bumped into |
| 97 | ;; an easymenu bug: |
| 98 | ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html |
| 99 | ;; The bug has since been fixed. |
| 100 | (dotimes (i 11) |
| 101 | (push (vector (format "hol-year-%d" i) |
| 102 | `(lambda () |
| 103 | (interactive) |
| 104 | (holiday-list (+ displayed-year ,(- i 5)))) |
| 105 | :label `(format "For Year %d" |
| 106 | (+ displayed-year ,(- i 5)))) |
| 107 | l)) |
| 108 | (nreverse l)) |
| 109 | "--" |
| 110 | ["Unmark Calendar" calendar-unmark] |
| 111 | ["Mark Holidays" calendar-mark-holidays]) |
| 112 | "Key map for \"Holidays\" menu in the calendar.") |
| 113 | |
| 114 | (defconst cal-menu-goto-menu |
| 115 | '("Goto" |
| 116 | ["Today" calendar-goto-today] |
| 117 | ["Beginning of Week" calendar-beginning-of-week] |
| 118 | ["End of Week" calendar-end-of-week] |
| 119 | ["Beginning of Month" calendar-beginning-of-month] |
| 120 | ["End of Month" calendar-end-of-month] |
| 121 | ["Beginning of Year" calendar-beginning-of-year] |
| 122 | ["End of Year" calendar-end-of-year] |
| 123 | ["Other Date" calendar-goto-date] |
| 124 | ["Day of Year" calendar-goto-day-of-year] |
| 125 | ["ISO Week" calendar-iso-goto-week] |
| 126 | ["ISO Date" calendar-iso-goto-date] |
| 127 | ["Astronomical Date" calendar-astro-goto-day-number] |
| 128 | ["Hebrew Date" calendar-hebrew-goto-date] |
| 129 | ["Persian Date" calendar-persian-goto-date] |
| 130 | ["Baha'i Date" calendar-bahai-goto-date] |
| 131 | ["Islamic Date" calendar-islamic-goto-date] |
| 132 | ["Julian Date" calendar-julian-goto-date] |
| 133 | ["Chinese Date" calendar-chinese-goto-date] |
| 134 | ["Coptic Date" calendar-coptic-goto-date] |
| 135 | ["Ethiopic Date" calendar-ethiopic-goto-date] |
| 136 | ("Mayan Date" |
| 137 | ["Next Tzolkin" calendar-mayan-next-tzolkin-date] |
| 138 | ["Previous Tzolkin" calendar-mayan-previous-tzolkin-date] |
| 139 | ["Next Haab" calendar-mayan-next-haab-date] |
| 140 | ["Previous Haab" calendar-mayan-previous-haab-date] |
| 141 | ["Next Round" calendar-mayan-next-round-date] |
| 142 | ["Previous Round" calendar-mayan-previous-round-date]) |
| 143 | ["French Date" calendar-french-goto-date]) |
| 144 | "Key map for \"Goto\" menu in the calendar.") |
| 145 | |
| 146 | (defconst cal-menu-scroll-menu |
| 147 | '("Scroll" |
| 148 | ["Scroll Commands" nil :help "Commands that scroll the visible window"] |
| 149 | ["Forward 1 Month" calendar-scroll-left] |
| 150 | ["Forward 3 Months" calendar-scroll-left-three-months] |
| 151 | ["Forward 1 Year" (calendar-scroll-left 12) :keys "4 C-v"] |
| 152 | ["Backward 1 Month" calendar-scroll-right] |
| 153 | ["Backward 3 Months" calendar-scroll-right-three-months] |
| 154 | ["Backward 1 Year" (calendar-scroll-right 12) :keys "4 M-v"] |
| 155 | "--" |
| 156 | ["Motion Commands" nil :help "Commands that move point"] |
| 157 | ["Forward 1 Day" calendar-forward-day] |
| 158 | ["Forward 1 Week" calendar-forward-week] |
| 159 | ["Forward 1 Month" calendar-forward-month] |
| 160 | ["Forward 1 Year" calendar-forward-year] |
| 161 | ["Backward 1 Day" calendar-backward-day] |
| 162 | ["Backward 1 Week" calendar-backward-week] |
| 163 | ["Backward 1 Month" calendar-backward-month] |
| 164 | ["Backward 1 Year" calendar-backward-year]) |
| 165 | "Key map for \"Scroll\" menu in the calendar.") |
| 166 | |
| 167 | (declare-function x-popup-menu "menu.c" (position menu)) |
| 168 | |
| 169 | (defmacro cal-menu-x-popup-menu (event title &rest body) |
| 170 | "Call `x-popup-menu' at position EVENT, with TITLE and contents BODY. |
| 171 | Signals an error if popups are unavailable." |
| 172 | (declare (indent 2)) |
| 173 | `(if (display-popup-menus-p) |
| 174 | (x-popup-menu ,event (list ,title (append (list ,title) ,@body))) |
| 175 | (error "Popup menus are not available on this system"))) |
| 176 | |
| 177 | (autoload 'diary-list-entries "diary-lib") |
| 178 | ;; Autoloaded in diary-lib. |
| 179 | (declare-function calendar-check-holidays "holidays" (date)) |
| 180 | |
| 181 | (defun calendar-mouse-view-diary-entries (&optional date diary event) |
| 182 | "Pop up menu of diary entries for mouse-selected date. |
| 183 | Use optional DATE and alternative file DIARY. EVENT is the event |
| 184 | that invoked this command. Shows holidays if `diary-show-holidays-flag' |
| 185 | is non-nil." |
| 186 | (interactive "i\ni\ne") |
| 187 | (let* ((date (or date (calendar-cursor-to-date nil event))) |
| 188 | (diary-file (or diary diary-file)) |
| 189 | (diary-list-include-blanks nil) |
| 190 | (diary-entries (mapcar (lambda (x) (split-string (cadr x) "\n")) |
| 191 | (diary-list-entries date 1 'list-only))) |
| 192 | (holidays (if diary-show-holidays-flag |
| 193 | (calendar-check-holidays date))) |
| 194 | (title (format "Diary entries%s for %s" |
| 195 | (if diary (format " from %s" diary) "") |
| 196 | (calendar-date-string date))) |
| 197 | (selection (cal-menu-x-popup-menu event title |
| 198 | (mapcar (lambda (x) (list (concat " " x))) holidays) |
| 199 | (if holidays |
| 200 | (list "--shadow-etched-in" "--shadow-etched-in")) |
| 201 | (if diary-entries |
| 202 | (mapcar 'list (apply 'append diary-entries)) |
| 203 | '("None"))))) |
| 204 | (and selection (call-interactively selection)))) |
| 205 | |
| 206 | (defun calendar-mouse-view-other-diary-entries (&optional event) |
| 207 | "Pop up menu of diary entries from alternative file on mouse-selected date." |
| 208 | (interactive "e") |
| 209 | (calendar-mouse-view-diary-entries |
| 210 | (calendar-cursor-to-date nil event) |
| 211 | (read-file-name "Enter diary file name: " default-directory nil t) |
| 212 | event)) |
| 213 | |
| 214 | ;; In 22, the equivalent code gave an error when not called on a date, |
| 215 | ;; but easymenu does not seem to allow this (?). |
| 216 | ;; The ignore-errors is because `documentation' can end up calling |
| 217 | ;; this in a non-calendar buffer where displayed-month is unbound. (Bug#3862) |
| 218 | (defun cal-menu-set-date-title (menu) |
| 219 | "Convert date of last event to title suitable for MENU." |
| 220 | (let ((date (ignore-errors (calendar-cursor-to-date nil last-input-event)))) |
| 221 | (if date |
| 222 | (easy-menu-filter-return menu (calendar-date-string date t nil)) |
| 223 | (message "Not on a date!") |
| 224 | nil))) |
| 225 | |
| 226 | (easy-menu-define cal-menu-context-mouse-menu nil |
| 227 | "Pop up mouse menu for selected date in the calendar window." |
| 228 | '("cal-menu-context-mouse-menu" :filter cal-menu-set-date-title |
| 229 | "--" |
| 230 | ["Holidays" calendar-cursor-holidays] |
| 231 | ["Mark date" calendar-set-mark] |
| 232 | ["Sunrise/sunset" calendar-sunrise-sunset] |
| 233 | ["Other calendars" calendar-print-other-dates] |
| 234 | ;; There was a bug (#447; fixed) with last-nonmenu-event and submenus. |
| 235 | ;; These did not work if called without calendar window selected. |
| 236 | ("Prepare LaTeX buffer" |
| 237 | ["Daily (1 page)" cal-tex-cursor-day] |
| 238 | ["Weekly (1 page)" cal-tex-cursor-week] |
| 239 | ["Weekly (2 pages)" cal-tex-cursor-week2] |
| 240 | ["Weekly (other style; 1 page)" cal-tex-cursor-week-iso] |
| 241 | ["Weekly (yet another style; 1 page)" cal-tex-cursor-week-monday] |
| 242 | ["Monthly" cal-tex-cursor-month] |
| 243 | ["Monthly (landscape)" cal-tex-cursor-month-landscape] |
| 244 | ["Yearly" cal-tex-cursor-year] |
| 245 | ["Yearly (landscape)" cal-tex-cursor-year-landscape] |
| 246 | ("Filofax styles" |
| 247 | ["Filofax Daily (one-day-per-page)" cal-tex-cursor-filofax-daily] |
| 248 | ["Filofax Weekly (2-weeks-at-a-glance)" cal-tex-cursor-filofax-2week] |
| 249 | ["Filofax Weekly (week-at-a-glance)" cal-tex-cursor-filofax-week] |
| 250 | ["Filofax Yearly" cal-tex-cursor-filofax-year])) |
| 251 | ("Write HTML calendar" |
| 252 | ["For selected month" cal-html-cursor-month] |
| 253 | ["For selected year" cal-html-cursor-year]) |
| 254 | ["Diary entries" calendar-mouse-view-diary-entries :keys "d"] |
| 255 | ["Insert diary entry" diary-insert-entry] |
| 256 | ["Other diary file entries" calendar-mouse-view-other-diary-entries |
| 257 | :keys "D"])) |
| 258 | |
| 259 | (easy-menu-define cal-menu-global-mouse-menu nil |
| 260 | "Menu bound to a mouse event, not specific to the mouse-click location." |
| 261 | '("Calendar" |
| 262 | ["Scroll forward" calendar-scroll-left-three-months] |
| 263 | ["Scroll backward" calendar-scroll-right-three-months] |
| 264 | ["Mark diary entries" diary-mark-entries] |
| 265 | ["List holidays" calendar-list-holidays] |
| 266 | ["Mark holidays" calendar-mark-holidays] |
| 267 | ["Unmark" calendar-unmark] |
| 268 | ["Lunar phases" calendar-lunar-phases] |
| 269 | ["Sunrise times for month" calendar-sunrise-sunset-month] |
| 270 | ["Show diary" diary-show-all-entries] |
| 271 | ["Exit calendar" calendar-exit])) |
| 272 | |
| 273 | ;; Undocumented and probably useless. |
| 274 | (defvar cal-menu-load-hook nil |
| 275 | "Hook run on loading of the `cal-menu' package.") |
| 276 | (make-obsolete-variable 'cal-menu-load-hook |
| 277 | "it will be removed in future." "23.1") |
| 278 | |
| 279 | (run-hooks 'cal-menu-load-hook) |
| 280 | |
| 281 | (provide 'cal-menu) |
| 282 | |
| 283 | ;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9 |
| 284 | ;;; cal-menu.el ends here |