mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-04 02:51:31 -08:00
Code Issues Projects Releases Wiki Activity

Edward M. Reingold <reingold@emr.cs.iit.edu>

Browse source 
(calendar-mode-map): Add `calendar-goto-day-of-year' to menu.
(calendar-flatten): New function.
(calendar-mouse-view-other-diary-entries)
(calendar-mouse-view-diary-entries): Rewritten to put any holidays in
the menu title and to show multi-line diary entries correctly in the
menu.
This commit is contained in:
Glenn Morris 2003-08-17 22:48:54 +00:00
parent c34ff8ac89
commit f9df0ca042
1 changed files with 44 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

82
lisp/calendar/cal-menu.el
View file

@ -117,6 +117,8 @@
'("Astronomical Date" . calendar-goto-astro-day-number))
(define-key calendar-mode-map [menu-bar goto iso]
'("ISO Date" . calendar-goto-iso-date))
(define-key calendar-mode-map [menu-bar goto day-of-year]
'("Day of Year" . calendar-goto-day-of-year))
(define-key calendar-mode-map [menu-bar goto gregorian]
'("Other Date" . calendar-goto-date))
(define-key calendar-mode-map [menu-bar goto end-of-year]
@ -164,6 +166,15 @@
(define-key calendar-mode-map [menu-bar scroll fwd-1]
'("Forward 1 Month" . scroll-calendar-left))
(defun calendar-flatten (list)
"Flatten LIST eliminating sublists structure; result is a list of atoms.
This is the same as the preorder list of leaves in a rooted forest."
(if (atom list)
(list list)
(if (cdr list)
(append (calendar-flatten (car list)) (calendar-flatten (cdr list)))
(calendar-flatten (car list)))))
(defun cal-menu-x-popup-menu (position menu)
"Like `x-popup-menu', but prints an error message if popup menus are
not available."
@ -307,53 +318,48 @@ ERROR is t, otherwise just returns nil."
(if l l '("None")))))))
(and selection (call-interactively selection))))
(defun calendar-mouse-view-diary-entries ()
"Pop up menu of diary entries for mouse selected date."
(defun calendar-mouse-view-diary-entries (&optional date diary)
"Pop up menu of diary entries for mouse-selected date.
Use optional DATE and alternative file DIARY.
Any holidays are shown if `holidays-in-diary-buffer' is t."
(interactive)
(let* ((date (calendar-event-to-date))
(l (mapcar '(lambda (x) (list (car (cdr x))))
(let ((diary-list-include-blanks nil)
(diary-display-hook 'ignore))
(list-diary-entries date 1))))
(let* ((date (if date date (calendar-event-to-date)))
(diary-file (if diary diary diary-file))
(diary-list-include-blanks nil)
(diary-display-hook 'ignore)
(diary-entries
(mapcar '(lambda (x) (split-string (car (cdr x)) "\^M\\|\n"))
(list-diary-entries date 1)))
(holidays (if holidays-in-diary-buffer
(mapcar '(lambda (x) (list x))
(check-calendar-holidays date))))
(title (concat "Diary entries "
(if diary (format "from %s " diary) "")
"for "
(calendar-date-string date)))
(selection
(cal-menu-x-popup-menu
event
(list
(format "Diary entries for %s" (calendar-date-string date))
(append
(list (format "Diary entries for %s" (calendar-date-string date)))
(if l l '("None")))))))
(list title
(append
(list title)
(if holidays
(mapcar '(lambda (x) (list (concat " " (car x))))
holidays))
(if holidays
(list "--shadow-etched-in" "--shadow-etched-in"))
(if diary-entries
(mapcar 'list (calendar-flatten diary-entries))
'("None")))))))
(and selection (call-interactively selection))))
(defun calendar-mouse-view-other-diary-entries ()
"Pop up menu of diary entries from alternative file on mouse-selected date."
(interactive)
(let* ((date (calendar-event-to-date))
(diary-list-include-blanks nil)
(diary-display-hook 'ignore)
(diary-file (read-file-name
"Enter diary file name: "
default-directory nil t))
; The following doesn't really do the right thing. The problem is
; that a newline in the diary entry does not give a newline in a
; pop-up menu; for that you need a separate list item. When the (car
; (cdr x)) contains newlines, the item should be split into a list of
; items. Too minor and messy to worry about.
(l (mapcar '(lambda (x) (list (car (cdr x))))
(list-diary-entries date 1)))
(selection
(cal-menu-x-popup-menu
event
(list
(format "Diary entries from %s for %s"
diary-file
(calendar-date-string date))
(append
(list (format "Diary entries from %s for %s"
diary-file
(calendar-date-string date)))
(if l l '("None")))))))
(and selection (call-interactively selection))))
(calendar-mouse-view-diary-entries
(calendar-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."