Mercurial > emacs

comparison lisp/calendar/cal-menu.el @ 90261:7beb78bc1f8e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-97 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 616-696) - Add lisp/mh-e/.arch-inventory - Update from CVS - Merge from gnus--rel--5.10 - Update from CVS: lisp/smerge-mode.el: Add 'tools' to file keywords. - lisp/gnus/ChangeLog: Remove duplicate entry * gnus--rel--5.10 (patch 147-181) - Update from CVS - Merge from emacs--cvs-trunk--0 - Update from CVS: lisp/mml.el (mml-preview): Doc fix. - Update from CVS: texi/message.texi: Fix default values. - Update from CVS: texi/gnus.texi (RSS): Addition.
author Miles Bader <miles@gnu.org>
date Mon, 16 Jan 2006 08:37:27 +0000
parents 5e2d3828e89f 757a5ae466cd
children 5b7d410e31f9
comparison
equal deleted inserted replaced
90260:0ca0d9181b5e 90261:7beb78bc1f8e
1 ;;; cal-menu.el --- calendar functions for menu bar and popup menu support 1 ;;; cal-menu.el --- calendar functions for menu bar and popup menu support
2 2
3 ;; Copyright (C) 1994, 1995, 2001, 2003, 2004, 2005 Free Software Foundation, Inc. 3 ;; Copyright (C) 1994, 1995, 2001, 2002, 2003, 2004, 2005
4 ;; Free Software Foundation, Inc.
4 5
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> 6 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
6 ;; Lara Rios <lrios@coewl.cen.uiuc.edu> 7 ;; Lara Rios <lrios@coewl.cen.uiuc.edu>
7 ;; Maintainer: Glenn Morris <rgm@gnu.org> 8 ;; Maintainer: Glenn Morris <rgm@gnu.org>
8 ;; Keywords: calendar 9 ;; Keywords: calendar
36 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue 37 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
37 ;; Urbana, Illinois 61801 38 ;; Urbana, Illinois 61801
38 39
39 ;;; Code: 40 ;;; Code:
40 41
41 (defvar date)
42 (defvar displayed-month) 42 (defvar displayed-month)
43 (defvar displayed-year) 43 (defvar displayed-year)
44 (defvar event)
45 44
46 (eval-when-compile (require 'calendar)) 45 (eval-when-compile (require 'calendar))
47 46
48 (define-key calendar-mode-map [menu-bar edit] 'undefined) 47 (define-key calendar-mode-map [menu-bar edit] 'undefined)
49 (define-key calendar-mode-map [menu-bar search] 'undefined) 48 (define-key calendar-mode-map [menu-bar search] 'undefined)
323 (calendar-cursor-holidays))) 322 (calendar-cursor-holidays)))
324 323
325 (autoload 'check-calendar-holidays "holidays") 324 (autoload 'check-calendar-holidays "holidays")
326 (autoload 'diary-list-entries "diary-lib") 325 (autoload 'diary-list-entries "diary-lib")
327 326
328 (defun calendar-mouse-holidays () 327 (defun calendar-mouse-holidays (&optional event)
329 "Pop up menu of holidays for mouse selected date." 328 "Pop up menu of holidays for mouse selected date."
330 (interactive) 329 (interactive "e")
331 (let* ((date (calendar-event-to-date)) 330 (let* ((date (calendar-event-to-date))
332 (l (mapcar 'list (check-calendar-holidays date))) 331 (l (mapcar 'list (check-calendar-holidays date)))
333 (selection 332 (selection
334 (cal-menu-x-popup-menu 333 (cal-menu-x-popup-menu
335 event 334 event
338 (append 337 (append
339 (list (format "Holidays for %s" (calendar-date-string date))) 338 (list (format "Holidays for %s" (calendar-date-string date)))
340 (if l l '("None"))))))) 339 (if l l '("None")))))))
341 (and selection (call-interactively selection)))) 340 (and selection (call-interactively selection))))
342 341
343 (defun calendar-mouse-view-diary-entries (&optional date diary) 342 (defun calendar-mouse-view-diary-entries (&optional date diary event)
344 "Pop up menu of diary entries for mouse-selected date. 343 "Pop up menu of diary entries for mouse-selected date.
345 Use optional DATE and alternative file DIARY. 344 Use optional DATE and alternative file DIARY.
346 345
347 Any holidays are shown if `holidays-in-diary-buffer' is t." 346 Any holidays are shown if `holidays-in-diary-buffer' is t."
348 (interactive) 347 (interactive "i\ni\ne")
349 (let* ((date (if date date (calendar-event-to-date))) 348 (let* ((date (if date date (calendar-event-to-date)))
350 (diary-file (if diary diary diary-file)) 349 (diary-file (if diary diary diary-file))
351 (diary-list-include-blanks nil) 350 (diary-list-include-blanks nil)
352 (diary-display-hook 'ignore) 351 (diary-display-hook 'ignore)
353 (diary-entries 352 (diary-entries
488 (interactive) 487 (interactive)
489 (save-excursion 488 (save-excursion
490 (calendar-mouse-goto-date (calendar-event-to-date)) 489 (calendar-mouse-goto-date (calendar-event-to-date))
491 (cal-tex-cursor-year-landscape nil))) 490 (cal-tex-cursor-year-landscape nil)))
492 491
493 (defun calendar-mouse-print-dates () 492 (defun calendar-mouse-print-dates (&optional event)
494 "Pop up menu of equivalent dates to mouse selected date." 493 "Pop up menu of equivalent dates to mouse selected date."
495 (interactive) 494 (interactive "e")
496 (let ((date (calendar-event-to-date)) 495 (let* ((date (calendar-event-to-date))
497 (selection 496 (selection
498 (cal-menu-x-popup-menu 497 (cal-menu-x-popup-menu
499 event 498 event
500 (list 499 (list
501 (concat (calendar-date-string date) " (Gregorian)") 500 (concat (calendar-date-string date) " (Gregorian)")
522 (if (not (string-equal i "")) 521 (if (not (string-equal i ""))
523 (list (list (format "Islamic date (before sunset): %s" i))))) 522 (list (list (format "Islamic date (before sunset): %s" i)))))
524 (list 523 (list
525 (list (format "Chinese date: %s" 524 (list (format "Chinese date: %s"
526 (calendar-chinese-date-string date)))) 525 (calendar-chinese-date-string date))))
527 ; (list '("Chinese date (select to echo Chinese date)" 526 ;; (list '("Chinese date (select to echo Chinese date)"
528 ; . calendar-mouse-chinese-date)) 527 ;; . calendar-mouse-chinese-date))
529 (let ((c (calendar-coptic-date-string date))) 528 (let ((c (calendar-coptic-date-string date)))
530 (if (not (string-equal c "")) 529 (if (not (string-equal c ""))
531 (list (list (format "Coptic date: %s" c))))) 530 (list (list (format "Coptic date: %s" c)))))
532 (let ((e (calendar-ethiopic-date-string date))) 531 (let ((e (calendar-ethiopic-date-string date)))
533 (if (not (string-equal e "")) 532 (if (not (string-equal e ""))
578 "Pop up submenu for Mouse-2 for cal-tex commands for selected date in the calendar window." 577 "Pop up submenu for Mouse-2 for cal-tex commands for selected date in the calendar window."
579 (interactive "e") 578 (interactive "e")
580 (let* ((selection 579 (let* ((selection
581 (cal-menu-x-popup-menu 580 (cal-menu-x-popup-menu
582 event 581 event
583 (list (calendar-date-string date t nil) 582 (list (calendar-date-string (calendar-event-to-date t) t nil)
584 (list 583 (list
585 "" 584 ""
586 '("Daily (1 page)" . cal-tex-mouse-day) 585 '("Daily (1 page)" . cal-tex-mouse-day)
587 '("Weekly (1 page)" . cal-tex-mouse-week) 586 '("Weekly (1 page)" . cal-tex-mouse-week)
588 '("Weekly (2 pages)" . cal-tex-mouse-week2) 587 '("Weekly (2 pages)" . cal-tex-mouse-week2)
601 "Pop up sub-submenu for Mouse-2 for Filofax cal-tex commands for selected date." 600 "Pop up sub-submenu for Mouse-2 for Filofax cal-tex commands for selected date."
602 (interactive "e") 601 (interactive "e")
603 (let* ((selection 602 (let* ((selection
604 (cal-menu-x-popup-menu 603 (cal-menu-x-popup-menu
605 event 604 event
606 (list (calendar-date-string date t nil) 605 (list (calendar-date-string (calendar-event-to-date t) t nil)
607 (list 606 (list
608 "" 607 ""
609 '("Filofax Daily (one-day-per-page)" . 608 '("Filofax Daily (one-day-per-page)" .
610 cal-tex-mouse-filofax-daily) 609 cal-tex-mouse-filofax-daily)
611 '("Filofax Weekly (2-weeks-at-a-glance)" . 610 '("Filofax Weekly (2-weeks-at-a-glance)" .
637 636
638 (run-hooks 'cal-menu-load-hook) 637 (run-hooks 'cal-menu-load-hook)
639 638
640 (provide 'cal-menu) 639 (provide 'cal-menu)
641 640
642 ;;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9 641 ;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9
643 ;;; cal-menu.el ends here 642 ;;; cal-menu.el ends here