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;; 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 2, or (at your option) 17;; 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; see the file COPYING. If not, write to the 26;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 27;; Boston, MA 02110-1301, USA. 28 29;;; Commentary: 30 31;; This collection of functions implements menu bar and popup menu support for 32;; calendar.el. 33 34;;; Code: 35 36(defvar displayed-month) 37(defvar displayed-year) 38 39;; Don't require calendar because calendar requires us. 40;; (eval-when-compile (require 'calendar)) 41(defvar calendar-mode-map) 42 43(define-key calendar-mode-map [menu-bar edit] 'undefined) 44(define-key calendar-mode-map [menu-bar search] 'undefined) 45 46(define-key calendar-mode-map [down-mouse-2] 'calendar-mouse-2-date-menu) 47(define-key calendar-mode-map [mouse-2] 'ignore) 48 49(defvar calendar-mouse-3-map (make-sparse-keymap "Calendar")) 50(define-key calendar-mode-map [down-mouse-3] calendar-mouse-3-map) 51 52(define-key calendar-mode-map [menu-bar moon] 53 (cons "Moon" (make-sparse-keymap "Moon"))) 54 55(define-key calendar-mode-map [menu-bar moon moon] 56 '("Lunar Phases" . calendar-phases-of-moon)) 57 58(define-key calendar-mode-map [menu-bar diary] 59 (cons "Diary" (make-sparse-keymap "Diary"))) 60 61(define-key calendar-mode-map [menu-bar diary heb] 62 '("Insert Hebrew" . calendar-mouse-insert-hebrew-diary-entry)) 63(define-key calendar-mode-map [menu-bar diary isl] 64 '("Insert Islamic" . calendar-mouse-insert-islamic-diary-entry)) 65(define-key calendar-mode-map [menu-bar diary baha] 66 '("Insert Baha'i" . calendar-mouse-insert-bahai-diary-entry)) 67(define-key calendar-mode-map [menu-bar diary cyc] 68 '("Insert Cyclic" . insert-cyclic-diary-entry)) 69(define-key calendar-mode-map [menu-bar diary blk] 70 '("Insert Block" . insert-block-diary-entry)) 71(define-key calendar-mode-map [menu-bar diary ann] 72 '("Insert Anniversary" . insert-anniversary-diary-entry)) 73(define-key calendar-mode-map [menu-bar diary yr] 74 '("Insert Yearly" . insert-yearly-diary-entry)) 75(define-key calendar-mode-map [menu-bar diary mon] 76 '("Insert Monthly" . insert-monthly-diary-entry)) 77(define-key calendar-mode-map [menu-bar diary wk] 78 '("Insert Weekly" . insert-weekly-diary-entry)) 79(define-key calendar-mode-map [menu-bar diary ent] 80 '("Insert Diary Entry" . insert-diary-entry)) 81(define-key calendar-mode-map [menu-bar diary all] 82 '("Show All" . diary-show-all-entries)) 83(define-key calendar-mode-map [menu-bar diary mark] 84 '("Mark All" . mark-diary-entries)) 85(define-key calendar-mode-map [menu-bar diary view] 86 '("Cursor Date" . diary-view-entries)) 87(define-key calendar-mode-map [menu-bar diary view] 88 '("Other File" . view-other-diary-entries)) 89 90(define-key calendar-mode-map [menu-bar Holidays] 91 (cons "Holidays" (make-sparse-keymap "Holidays"))) 92 93(define-key calendar-mode-map [menu-bar goto] 94 (cons "Goto" (make-sparse-keymap "Goto"))) 95 96(define-key calendar-mode-map [menu-bar goto french] 97 '("French Date" . calendar-goto-french-date)) 98(define-key calendar-mode-map [menu-bar goto mayan] 99 (cons "Mayan Date" (make-sparse-keymap "Mayan"))) 100(define-key calendar-mode-map [menu-bar goto ethiopic] 101 '("Ethiopic Date" . calendar-goto-ethiopic-date)) 102(define-key calendar-mode-map [menu-bar goto coptic] 103 '("Coptic Date" . calendar-goto-coptic-date)) 104(define-key calendar-mode-map [menu-bar goto chinese] 105 '("Chinese Date" . calendar-goto-chinese-date)) 106(define-key calendar-mode-map [menu-bar goto julian] 107 '("Julian Date" . calendar-goto-julian-date)) 108(define-key calendar-mode-map [menu-bar goto islamic] 109 '("Islamic Date" . calendar-goto-islamic-date)) 110(define-key calendar-mode-map [menu-bar goto persian] 111 '("Baha'i Date" . calendar-goto-bahai-date)) 112(define-key calendar-mode-map [menu-bar goto persian] 113 '("Persian Date" . calendar-goto-persian-date)) 114(define-key calendar-mode-map [menu-bar goto hebrew] 115 '("Hebrew Date" . calendar-goto-hebrew-date)) 116(define-key calendar-mode-map [menu-bar goto astro] 117 '("Astronomical Date" . calendar-goto-astro-day-number)) 118(define-key calendar-mode-map [menu-bar goto iso] 119 '("ISO Date" . calendar-goto-iso-date)) 120(define-key calendar-mode-map [menu-bar goto iso-week] 121 '("ISO Week" . calendar-goto-iso-week)) 122(define-key calendar-mode-map [menu-bar goto day-of-year] 123 '("Day of Year" . calendar-goto-day-of-year)) 124(define-key calendar-mode-map [menu-bar goto gregorian] 125 '("Other Date" . calendar-goto-date)) 126(define-key calendar-mode-map [menu-bar goto end-of-year] 127 '("End of Year" . calendar-end-of-year)) 128(define-key calendar-mode-map [menu-bar goto beginning-of-year] 129 '("Beginning of Year" . calendar-beginning-of-year)) 130(define-key calendar-mode-map [menu-bar goto end-of-month] 131 '("End of Month" . calendar-end-of-month)) 132(define-key calendar-mode-map [menu-bar goto beginning-of-month] 133 '("Beginning of Month" . calendar-beginning-of-month)) 134(define-key calendar-mode-map [menu-bar goto end-of-week] 135 '("End of Week" . calendar-end-of-week)) 136(define-key calendar-mode-map [menu-bar goto beginning-of-week] 137 '("Beginning of Week" . calendar-beginning-of-week)) 138(define-key calendar-mode-map [menu-bar goto today] 139 '("Today" . calendar-goto-today)) 140 141 142(define-key calendar-mode-map [menu-bar goto mayan prev-rnd] 143 '("Previous Round" . calendar-previous-calendar-round-date)) 144(define-key calendar-mode-map [menu-bar goto mayan nxt-rnd] 145 '("Next Round" . calendar-next-calendar-round-date)) 146(define-key calendar-mode-map [menu-bar goto mayan prev-haab] 147 '("Previous Haab" . calendar-previous-haab-date)) 148(define-key calendar-mode-map [menu-bar goto mayan next-haab] 149 '("Next Haab" . calendar-next-haab-date)) 150(define-key calendar-mode-map [menu-bar goto mayan prev-tzol] 151 '("Previous Tzolkin" . calendar-previous-tzolkin-date)) 152(define-key calendar-mode-map [menu-bar goto mayan next-tzol] 153 '("Next Tzolkin" . calendar-next-tzolkin-date)) 154 155(define-key calendar-mode-map [menu-bar scroll] 156 (cons "Scroll" (make-sparse-keymap "Scroll"))) 157 158(define-key calendar-mode-map [menu-bar scroll bk-12] 159 '("Backward 1 Year" . "4\ev")) 160(define-key calendar-mode-map [menu-bar scroll bk-3] 161 '("Backward 3 Months" . scroll-calendar-right-three-months)) 162(define-key calendar-mode-map [menu-bar scroll bk-1] 163 '("Backward 1 Month" . scroll-calendar-right)) 164(define-key calendar-mode-map [menu-bar scroll fwd-12] 165 '("Forward 1 Year" . "4\C-v")) 166(define-key calendar-mode-map [menu-bar scroll fwd-3] 167 '("Forward 3 Months" . scroll-calendar-left-three-months)) 168(define-key calendar-mode-map [menu-bar scroll fwd-1] 169 '("Forward 1 Month" . scroll-calendar-left)) 170 171(defun calendar-flatten (list) 172 "Flatten LIST eliminating sublists structure; result is a list of atoms. 173This is the same as the preorder list of leaves in a rooted forest." 174 (if (atom list) 175 (list list) 176 (if (cdr list) 177 (append (calendar-flatten (car list)) (calendar-flatten (cdr list))) 178 (calendar-flatten (car list))))) 179 180(defun cal-menu-x-popup-menu (position menu) 181 "Like `x-popup-menu', but prints an error message if popup menus are 182not available." 183 (if (display-popup-menus-p) 184 (x-popup-menu position menu) 185 (error "Popup menus are not available on this system"))) 186 187(defun cal-menu-list-holidays-year () 188 "Display a list of the holidays of the selected date's year." 189 (interactive) 190 (let ((year (extract-calendar-year (calendar-cursor-to-date)))) 191 (list-holidays year year))) 192 193(defun cal-menu-list-holidays-following-year () 194 "Display a list of the holidays of the following year." 195 (interactive) 196 (let ((year (1+ (extract-calendar-year (calendar-cursor-to-date))))) 197 (list-holidays year year))) 198 199(defun cal-menu-list-holidays-previous-year () 200 "Display a list of the holidays of the previous year." 201 (interactive) 202 (let ((year (1- (extract-calendar-year (calendar-cursor-to-date))))) 203 (list-holidays year year))) 204 205(defun cal-menu-update () 206 ;; Update the holiday part of calendar menu bar for the current display. 207 (condition-case nil 208 (if (eq major-mode 'calendar-mode) 209 (let ((l)) 210 ;; Show 11 years--5 before, 5 after year of middle month 211 (dotimes (i 11) 212 (let ((y (+ displayed-year -5 i))) 213 (push (vector (format "For Year %s" y) 214 (list (list 'lambda 'nil '(interactive) 215 (list 'list-holidays y y))) 216 t) 217 l))) 218 (setq l (cons ["Mark Holidays" mark-calendar-holidays t] 219 (cons ["Unmark Calendar" calendar-unmark t] 220 (cons "--" l)))) 221 (define-key calendar-mode-map [menu-bar Holidays] 222 (cons "Holidays" (easy-menu-create-menu "Holidays" (nreverse l)))) 223 (define-key calendar-mode-map [menu-bar Holidays separator] 224 '("--")) 225 (define-key calendar-mode-map [menu-bar Holidays today] 226 `(,(format "For Today (%s)" 227 (calendar-date-string (calendar-current-date) t t)) 228 . cal-menu-today-holidays)) 229 (let ((title 230 (let ((my1 (calendar-increment-month -1)) 231 (my2 (calendar-increment-month 1))) 232 (if (= (cdr my1) (cdr my2)) 233 (format "%s-%s, %d" 234 (calendar-month-name (car my1) 'abbrev) 235 (calendar-month-name (car my2) 'abbrev) 236 (cdr my2)) 237 (format "%s, %d-%s, %d" 238 (calendar-month-name (car my1) 'abbrev) 239 (cdr my1) 240 (calendar-month-name (car my2) 'abbrev) 241 (cdr my2)))))) 242 (define-key calendar-mode-map [menu-bar Holidays 3-month] 243 `(,(format "For Window (%s)" title) 244 . list-calendar-holidays))) 245 (let ((date (calendar-cursor-to-date))) 246 (if date 247 (define-key calendar-mode-map [menu-bar Holidays 1-day] 248 `(,(format "For Cursor Date (%s)" 249 (calendar-date-string date t t)) 250 . calendar-cursor-holidays)))))) 251 ;; Try to avoid entering infinite beep mode in case of errors. 252 (error (ding)))) 253 254(defun calendar-event-to-date (&optional error) 255 "Date of last event. 256If event is not on a specific date, signals an error if optional parameter 257ERROR is t, otherwise just returns nil." 258 (save-excursion 259 (set-buffer (window-buffer (posn-window (event-start last-input-event)))) 260 (goto-char (posn-point (event-start last-input-event))) 261 (calendar-cursor-to-date error))) 262 263(defun calendar-mouse-insert-hebrew-diary-entry (event) 264 "Pop up menu to insert a Hebrew-date diary entry." 265 (interactive "e") 266 (let ((hebrew-selection 267 (cal-menu-x-popup-menu 268 event 269 (list "Hebrew insert menu" 270 (list (calendar-hebrew-date-string (calendar-cursor-to-date)) 271 '("One time" . insert-hebrew-diary-entry) 272 '("Monthly" . insert-monthly-hebrew-diary-entry) 273 '("Yearly" . insert-yearly-hebrew-diary-entry)))))) 274 (and hebrew-selection (call-interactively hebrew-selection)))) 275 276(defun calendar-mouse-insert-islamic-diary-entry (event) 277 "Pop up menu to insert an Islamic-date diary entry." 278 (interactive "e") 279 (let ((islamic-selection 280 (cal-menu-x-popup-menu 281 event 282 (list "Islamic insert menu" 283 (list (calendar-islamic-date-string (calendar-cursor-to-date)) 284 '("One time" . insert-islamic-diary-entry) 285 '("Monthly" . insert-monthly-islamic-diary-entry) 286 '("Yearly" . insert-yearly-islamic-diary-entry)))))) 287 (and islamic-selection (call-interactively islamic-selection)))) 288 289(defun calendar-mouse-insert-bahai-diary-entry (event) 290 "Pop up menu to insert an Baha'i-date diary entry." 291 (interactive "e") 292 (let ((bahai-selection 293 (x-popup-menu 294 event 295 (list "Baha'i insert menu" 296 (list (calendar-bahai-date-string (calendar-cursor-to-date)) 297 '("One time" . insert-bahai-diary-entry) 298 '("Monthly" . insert-monthly-bahai-diary-entry) 299 '("Yearly" . insert-yearly-bahai-diary-entry)))))) 300 (and bahai-selection (call-interactively bahai-selection)))) 301 302(defun calendar-mouse-sunrise/sunset () 303 "Show sunrise/sunset times for mouse-selected date." 304 (interactive) 305 (save-excursion 306 (calendar-mouse-goto-date (calendar-event-to-date)) 307 (calendar-sunrise-sunset))) 308 309(defun cal-menu-today-holidays () 310 "Show holidays for today's date." 311 (interactive) 312 (save-excursion 313 (calendar-cursor-to-date (calendar-current-date)) 314 (calendar-cursor-holidays))) 315 316(autoload 'check-calendar-holidays "holidays") 317(autoload 'diary-list-entries "diary-lib") 318 319(defun calendar-mouse-holidays (&optional event) 320 "Pop up menu of holidays for mouse selected date." 321 (interactive "e") 322 (let* ((date (calendar-event-to-date)) 323 (l (mapcar 'list (check-calendar-holidays date))) 324 (selection 325 (cal-menu-x-popup-menu 326 event 327 (list 328 (format "Holidays for %s" (calendar-date-string date)) 329 (append 330 (list (format "Holidays for %s" (calendar-date-string date))) 331 (if l l '("None"))))))) 332 (and selection (call-interactively selection)))) 333 334(defun calendar-mouse-view-diary-entries (&optional date diary event) 335 "Pop up menu of diary entries for mouse-selected date. 336Use optional DATE and alternative file DIARY. 337 338Any holidays are shown if `holidays-in-diary-buffer' is t." 339 (interactive "i\ni\ne") 340 (let* ((date (if date date (calendar-event-to-date))) 341 (diary-file (if diary diary diary-file)) 342 (diary-list-include-blanks nil) 343 (diary-display-hook 'ignore) 344 (diary-entries 345 (mapcar (lambda (x) (split-string (car (cdr x)) "\^M\\|\n")) 346 (diary-list-entries date 1 'list-only))) 347 (holidays (if holidays-in-diary-buffer 348 (check-calendar-holidays date))) 349 (title (concat "Diary entries " 350 (if diary (format "from %s " diary) "") 351 "for " 352 (calendar-date-string date))) 353 (selection 354 (cal-menu-x-popup-menu 355 event 356 (list title 357 (append 358 (list title) 359 (mapcar (lambda (x) (list (concat " " x))) holidays) 360 (if holidays 361 (list "--shadow-etched-in" "--shadow-etched-in")) 362 (if diary-entries 363 (mapcar 'list (calendar-flatten diary-entries)) 364 '("None"))))))) 365 (and selection (call-interactively selection)))) 366 367(defun calendar-mouse-view-other-diary-entries () 368 "Pop up menu of diary entries from alternative file on mouse-selected date." 369 (interactive) 370 (calendar-mouse-view-diary-entries 371 (calendar-event-to-date) 372 (read-file-name "Enter diary file name: " default-directory nil t))) 373 374(defun calendar-mouse-insert-diary-entry () 375 "Insert diary entry for mouse-selected date." 376 (interactive) 377 (save-excursion 378 (calendar-mouse-goto-date (calendar-event-to-date)) 379 (insert-diary-entry nil))) 380 381(defun calendar-mouse-set-mark () 382 "Mark the date under the cursor." 383 (interactive) 384 (save-excursion 385 (calendar-mouse-goto-date (calendar-event-to-date)) 386 (calendar-set-mark nil))) 387 388(defun cal-tex-mouse-day () 389 "Make a buffer with LaTeX commands for the day mouse is on." 390 (interactive) 391 (save-excursion 392 (calendar-mouse-goto-date (calendar-event-to-date)) 393 (cal-tex-cursor-day nil))) 394 395(defun cal-tex-mouse-week () 396 "One page calendar for week indicated by cursor. 397Holidays are included if `cal-tex-holidays' is t." 398 (interactive) 399 (save-excursion 400 (calendar-mouse-goto-date (calendar-event-to-date)) 401 (cal-tex-cursor-week nil))) 402 403(defun cal-tex-mouse-week2 () 404 "Make a buffer with LaTeX commands for the week cursor is on. 405The printed output will be on two pages." 406 (interactive) 407 (save-excursion 408 (calendar-mouse-goto-date (calendar-event-to-date)) 409 (cal-tex-cursor-week2 nil))) 410 411(defun cal-tex-mouse-week-iso () 412 "One page calendar for week indicated by cursor. 413Holidays are included if `cal-tex-holidays' is t." 414 (interactive) 415 (save-excursion 416 (calendar-mouse-goto-date (calendar-event-to-date)) 417 (cal-tex-cursor-week-iso nil))) 418 419(defun cal-tex-mouse-week-monday () 420 "One page calendar for week indicated by cursor." 421 (interactive) 422 (save-excursion 423 (calendar-mouse-goto-date (calendar-event-to-date)) 424 (cal-tex-cursor-week-monday nil))) 425 426(defun cal-tex-mouse-filofax-daily () 427 "Day-per-page Filofax calendar for week indicated by cursor." 428 (interactive) 429 (save-excursion 430 (calendar-mouse-goto-date (calendar-event-to-date)) 431 (cal-tex-cursor-filofax-daily nil))) 432 433(defun cal-tex-mouse-filofax-2week () 434 "One page Filofax calendar for week indicated by cursor." 435 (interactive) 436 (save-excursion 437 (calendar-mouse-goto-date (calendar-event-to-date)) 438 (cal-tex-cursor-filofax-2week nil))) 439 440(defun cal-tex-mouse-filofax-week () 441 "Two page Filofax calendar for week indicated by cursor." 442 (interactive) 443 (save-excursion 444 (calendar-mouse-goto-date (calendar-event-to-date)) 445 (cal-tex-cursor-filofax-week nil))) 446 447(defun cal-tex-mouse-month () 448 "Make a buffer with LaTeX commands for the month cursor is on. 449Calendar is condensed onto one page." 450 (interactive) 451 (save-excursion 452 (calendar-mouse-goto-date (calendar-event-to-date)) 453 (cal-tex-cursor-month nil))) 454 455(defun cal-tex-mouse-month-landscape () 456 "Make a buffer with LaTeX commands for the month cursor is on. 457The output is in landscape format, one month to a page." 458 (interactive) 459 (save-excursion 460 (calendar-mouse-goto-date (calendar-event-to-date)) 461 (cal-tex-cursor-month-landscape nil))) 462 463(defun cal-tex-mouse-year () 464 "Make a buffer with LaTeX commands for the year cursor is on." 465 (interactive) 466 (save-excursion 467 (calendar-mouse-goto-date (calendar-event-to-date)) 468 (cal-tex-cursor-year nil))) 469 470(defun cal-tex-mouse-filofax-year () 471 "Make a buffer with LaTeX commands for Filofax calendar of year cursor is on." 472 (interactive) 473 (save-excursion 474 (calendar-mouse-goto-date (calendar-event-to-date)) 475 (cal-tex-cursor-filofax-year nil))) 476 477(defun cal-tex-mouse-year-landscape () 478 "Make a buffer with LaTeX commands for the year cursor is on." 479 (interactive) 480 (save-excursion 481 (calendar-mouse-goto-date (calendar-event-to-date)) 482 (cal-tex-cursor-year-landscape nil))) 483 484(defun calendar-mouse-print-dates (&optional event) 485 "Pop up menu of equivalent dates to mouse selected date." 486 (interactive "e") 487 (let* ((date (calendar-event-to-date)) 488 (selection 489 (cal-menu-x-popup-menu 490 event 491 (list 492 (concat (calendar-date-string date) " (Gregorian)") 493 (append 494 (list 495 (concat (calendar-date-string date) " (Gregorian)") 496 (list (calendar-day-of-year-string date)) 497 (list (format "ISO date: %s" (calendar-iso-date-string date))) 498 (list (format "Julian date: %s" 499 (calendar-julian-date-string date))) 500 (list 501 (format "Astronomical (Julian) day number (at noon UTC): %s.0" 502 (calendar-astro-date-string date))) 503 (list 504 (format "Fixed (RD) date: %s" 505 (calendar-absolute-from-gregorian date))) 506 (list (format "Hebrew date (before sunset): %s" 507 (calendar-hebrew-date-string date))) 508 (list (format "Persian date: %s" 509 (calendar-persian-date-string date))) 510 (list (format "Baha'i date (before sunset): %s" 511 (calendar-bahai-date-string date)))) 512 (let ((i (calendar-islamic-date-string date))) 513 (if (not (string-equal i "")) 514 (list (list (format "Islamic date (before sunset): %s" i))))) 515 (list 516 (list (format "Chinese date: %s" 517 (calendar-chinese-date-string date)))) 518 ;; (list '("Chinese date (select to echo Chinese date)" 519 ;; . calendar-mouse-chinese-date)) 520 (let ((c (calendar-coptic-date-string date))) 521 (if (not (string-equal c "")) 522 (list (list (format "Coptic date: %s" c))))) 523 (let ((e (calendar-ethiopic-date-string date))) 524 (if (not (string-equal e "")) 525 (list (list (format "Ethiopic date: %s" e))))) 526 (let ((f (calendar-french-date-string date))) 527 (if (not (string-equal f "")) 528 (list (list (format "French Revolutionary date: %s" f))))) 529 (list 530 (list 531 (format "Mayan date: %s" 532 (calendar-mayan-date-string date))))))))) 533 (and selection (call-interactively selection)))) 534 535(defun calendar-mouse-chinese-date () 536 "Show Chinese equivalent for mouse-selected date." 537 (interactive) 538 (save-excursion 539 (calendar-mouse-goto-date (calendar-event-to-date)) 540 (calendar-print-chinese-date))) 541 542(defun calendar-mouse-goto-date (date) 543 (set-buffer (window-buffer (posn-window (event-start last-input-event)))) 544 (calendar-goto-date date)) 545 546(defun calendar-mouse-2-date-menu (event) 547 "Pop up menu for Mouse-2 for selected date in the calendar window." 548 (interactive "e") 549 (let* ((date (calendar-event-to-date t)) 550 (selection 551 (cal-menu-x-popup-menu 552 event 553 (list (calendar-date-string date t nil) 554 (list 555 "" 556 '("Holidays" . calendar-mouse-holidays) 557 '("Mark date" . calendar-mouse-set-mark) 558 '("Sunrise/sunset" . calendar-mouse-sunrise/sunset) 559 '("Other calendars" . calendar-mouse-print-dates) 560 '("Prepare LaTeX buffer" . calendar-mouse-cal-tex-menu) 561 '("Diary entries" . calendar-mouse-view-diary-entries) 562 '("Insert diary entry" . calendar-mouse-insert-diary-entry) 563 '("Other diary file entries" 564 . calendar-mouse-view-other-diary-entries) 565 ))))) 566 (and selection (call-interactively selection)))) 567 568(defun calendar-mouse-cal-tex-menu (event) 569 "Pop up submenu for Mouse-2 for cal-tex commands for selected date in the calendar window." 570 (interactive "e") 571 (let* ((selection 572 (cal-menu-x-popup-menu 573 event 574 (list (calendar-date-string (calendar-event-to-date t) t nil) 575 (list 576 "" 577 '("Daily (1 page)" . cal-tex-mouse-day) 578 '("Weekly (1 page)" . cal-tex-mouse-week) 579 '("Weekly (2 pages)" . cal-tex-mouse-week2) 580 '("Weekly (other style; 1 page)" . cal-tex-mouse-week-iso) 581 '("Weekly (yet another style; 1 page)" . 582 cal-tex-mouse-week-monday) 583 '("Monthly" . cal-tex-mouse-month) 584 '("Monthly (landscape)" . cal-tex-mouse-month-landscape) 585 '("Yearly" . cal-tex-mouse-year) 586 '("Yearly (landscape)" . cal-tex-mouse-year-landscape) 587 '("Filofax styles" . cal-tex-mouse-filofax) 588 ))))) 589 (and selection (call-interactively selection)))) 590 591(defun cal-tex-mouse-filofax (event) 592 "Pop up sub-submenu for Mouse-2 for Filofax cal-tex commands for selected date." 593 (interactive "e") 594 (let* ((selection 595 (cal-menu-x-popup-menu 596 event 597 (list (calendar-date-string (calendar-event-to-date t) t nil) 598 (list 599 "" 600 '("Filofax Daily (one-day-per-page)" . 601 cal-tex-mouse-filofax-daily) 602 '("Filofax Weekly (2-weeks-at-a-glance)" . 603 cal-tex-mouse-filofax-2week) 604 '("Filofax Weekly (week-at-a-glance)" . 605 cal-tex-mouse-filofax-week) 606 '("Filofax Yearly" . cal-tex-mouse-filofax-year) 607 ))))) 608 (and selection (call-interactively selection)))) 609 610(define-key calendar-mouse-3-map [exit-calendar] 611 '("Exit calendar" . exit-calendar)) 612(define-key calendar-mouse-3-map [show-diary] 613 '("Show diary" . diary-show-all-entries)) 614(define-key calendar-mouse-3-map [lunar-phases] 615 '("Lunar phases" . calendar-phases-of-moon)) 616(define-key calendar-mouse-3-map [unmark] 617 '("Unmark" . calendar-unmark)) 618(define-key calendar-mouse-3-map [mark-holidays] 619 '("Mark holidays" . mark-calendar-holidays)) 620(define-key calendar-mouse-3-map [list-holidays] 621 '("List holidays" . list-calendar-holidays)) 622(define-key calendar-mouse-3-map [mark-diary-entries] 623 '("Mark diary entries" . mark-diary-entries)) 624(define-key calendar-mouse-3-map [scroll-backward] 625 '("Scroll backward" . scroll-calendar-right-three-months)) 626(define-key calendar-mouse-3-map [scroll-forward] 627 '("Scroll forward" . scroll-calendar-left-three-months)) 628 629(run-hooks 'cal-menu-load-hook) 630 631(provide 'cal-menu) 632 633;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9 634;;; cal-menu.el ends here 635