Mercurial > emacs
comparison lisp/calendar/cal-menu.el @ 88123:375f2633d815
New directory
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Mon, 08 Sep 2003 11:56:09 +0000 |
| parents | 695cf19ef79e |
| children | 68c22ea6027c |
comparison
equal
deleted
inserted
replaced
| 52428:27bc8b966642 | 88123:375f2633d815 |
|---|---|
| 115 '("Hebrew Date" . calendar-goto-hebrew-date)) | 115 '("Hebrew Date" . calendar-goto-hebrew-date)) |
| 116 (define-key calendar-mode-map [menu-bar goto astro] | 116 (define-key calendar-mode-map [menu-bar goto astro] |
| 117 '("Astronomical Date" . calendar-goto-astro-day-number)) | 117 '("Astronomical Date" . calendar-goto-astro-day-number)) |
| 118 (define-key calendar-mode-map [menu-bar goto iso] | 118 (define-key calendar-mode-map [menu-bar goto iso] |
| 119 '("ISO Date" . calendar-goto-iso-date)) | 119 '("ISO Date" . calendar-goto-iso-date)) |
| 120 (define-key calendar-mode-map [menu-bar goto day-of-year] | |
| 121 '("Day of Year" . calendar-goto-day-of-year)) | |
| 122 (define-key calendar-mode-map [menu-bar goto gregorian] | 120 (define-key calendar-mode-map [menu-bar goto gregorian] |
| 123 '("Other Date" . calendar-goto-date)) | 121 '("Other Date" . calendar-goto-date)) |
| 124 (define-key calendar-mode-map [menu-bar goto end-of-year] | 122 (define-key calendar-mode-map [menu-bar goto end-of-year] |
| 125 '("End of Year" . calendar-end-of-year)) | 123 '("End of Year" . calendar-end-of-year)) |
| 126 (define-key calendar-mode-map [menu-bar goto beginning-of-year] | 124 (define-key calendar-mode-map [menu-bar goto beginning-of-year] |
| 163 '("Forward 1 Year" . "4\C-v")) | 161 '("Forward 1 Year" . "4\C-v")) |
| 164 (define-key calendar-mode-map [menu-bar scroll fwd-3] | 162 (define-key calendar-mode-map [menu-bar scroll fwd-3] |
| 165 '("Forward 3 Months" . scroll-calendar-left-three-months)) | 163 '("Forward 3 Months" . scroll-calendar-left-three-months)) |
| 166 (define-key calendar-mode-map [menu-bar scroll fwd-1] | 164 (define-key calendar-mode-map [menu-bar scroll fwd-1] |
| 167 '("Forward 1 Month" . scroll-calendar-left)) | 165 '("Forward 1 Month" . scroll-calendar-left)) |
| 168 | |
| 169 (defun calendar-flatten (list) | |
| 170 "Flatten LIST eliminating sublists structure; result is a list of atoms. | |
| 171 This is the same as the preorder list of leaves in a rooted forest." | |
| 172 (if (atom list) | |
| 173 (list list) | |
| 174 (if (cdr list) | |
| 175 (append (calendar-flatten (car list)) (calendar-flatten (cdr list))) | |
| 176 (calendar-flatten (car list))))) | |
| 177 | 166 |
| 178 (defun cal-menu-x-popup-menu (position menu) | 167 (defun cal-menu-x-popup-menu (position menu) |
| 179 "Like `x-popup-menu', but prints an error message if popup menus are | 168 "Like `x-popup-menu', but prints an error message if popup menus are |
| 180 not available." | 169 not available." |
| 181 (if (display-popup-menus-p) | 170 (if (display-popup-menus-p) |
| 316 (append | 305 (append |
| 317 (list (format "Holidays for %s" (calendar-date-string date))) | 306 (list (format "Holidays for %s" (calendar-date-string date))) |
| 318 (if l l '("None"))))))) | 307 (if l l '("None"))))))) |
| 319 (and selection (call-interactively selection)))) | 308 (and selection (call-interactively selection)))) |
| 320 | 309 |
| 321 (defun calendar-mouse-view-diary-entries (&optional date diary) | 310 (defun calendar-mouse-view-diary-entries () |
| 322 "Pop up menu of diary entries for mouse-selected date. | 311 "Pop up menu of diary entries for mouse selected date." |
| 323 Use optional DATE and alternative file DIARY. | 312 (interactive) |
| 324 | 313 (let* ((date (calendar-event-to-date)) |
| 325 Any holidays are shown if `holidays-in-diary-buffer' is t." | 314 (l (mapcar '(lambda (x) (list (car (cdr x)))) |
| 326 (interactive) | 315 (let ((diary-list-include-blanks nil) |
| 327 (let* ((date (if date date (calendar-event-to-date))) | 316 (diary-display-hook 'ignore)) |
| 328 (diary-file (if diary diary diary-file)) | 317 (list-diary-entries date 1)))) |
| 329 (diary-list-include-blanks nil) | |
| 330 (diary-display-hook 'ignore) | |
| 331 (diary-entries | |
| 332 (mapcar '(lambda (x) (split-string (car (cdr x)) "\^M\\|\n")) | |
| 333 (list-diary-entries date 1))) | |
| 334 (holidays (if holidays-in-diary-buffer | |
| 335 (mapcar '(lambda (x) (list x)) | |
| 336 (check-calendar-holidays date)))) | |
| 337 (title (concat "Diary entries " | |
| 338 (if diary (format "from %s " diary) "") | |
| 339 "for " | |
| 340 (calendar-date-string date))) | |
| 341 (selection | 318 (selection |
| 342 (cal-menu-x-popup-menu | 319 (cal-menu-x-popup-menu |
| 343 event | 320 event |
| 344 (list title | 321 (list |
| 345 (append | 322 (format "Diary entries for %s" (calendar-date-string date)) |
| 346 (list title) | 323 (append |
| 347 (if holidays | 324 (list (format "Diary entries for %s" (calendar-date-string date))) |
| 348 (mapcar '(lambda (x) (list (concat " " (car x)))) | 325 (if l l '("None"))))))) |
| 349 holidays)) | |
| 350 (if holidays | |
| 351 (list "--shadow-etched-in" "--shadow-etched-in")) | |
| 352 (if diary-entries | |
| 353 (mapcar 'list (calendar-flatten diary-entries)) | |
| 354 '("None"))))))) | |
| 355 (and selection (call-interactively selection)))) | 326 (and selection (call-interactively selection)))) |
| 356 | 327 |
| 357 (defun calendar-mouse-view-other-diary-entries () | 328 (defun calendar-mouse-view-other-diary-entries () |
| 358 "Pop up menu of diary entries from alternative file on mouse-selected date." | 329 "Pop up menu of diary entries from alternative file on mouse-selected date." |
| 359 (interactive) | 330 (interactive) |
| 360 (calendar-mouse-view-diary-entries | 331 (let* ((date (calendar-event-to-date)) |
| 361 (calendar-event-to-date) | 332 (diary-list-include-blanks nil) |
| 362 (read-file-name "Enter diary file name: " default-directory nil t))) | 333 (diary-display-hook 'ignore) |
| 334 (diary-file (read-file-name | |
| 335 "Enter diary file name: " | |
| 336 default-directory nil t)) | |
| 337 ; The following doesn't really do the right thing. The problem is | |
| 338 ; that a newline in the diary entry does not give a newline in a | |
| 339 ; pop-up menu; for that you need a separate list item. When the (car | |
| 340 ; (cdr x)) contains newlines, the item should be split into a list of | |
| 341 ; items. Too minor and messy to worry about. | |
| 342 (l (mapcar '(lambda (x) (list (car (cdr x)))) | |
| 343 (list-diary-entries date 1))) | |
| 344 (selection | |
| 345 (cal-menu-x-popup-menu | |
| 346 event | |
| 347 (list | |
| 348 (format "Diary entries from %s for %s" | |
| 349 diary-file | |
| 350 (calendar-date-string date)) | |
| 351 (append | |
| 352 (list (format "Diary entries from %s for %s" | |
| 353 diary-file | |
| 354 (calendar-date-string date))) | |
| 355 (if l l '("None"))))))) | |
| 356 (and selection (call-interactively selection)))) | |
| 363 | 357 |
| 364 (defun calendar-mouse-insert-diary-entry () | 358 (defun calendar-mouse-insert-diary-entry () |
| 365 "Insert diary entry for mouse-selected date." | 359 "Insert diary entry for mouse-selected date." |
| 366 (interactive) | 360 (interactive) |
| 367 (save-excursion | 361 (save-excursion |
| 616 | 610 |
| 617 (run-hooks 'cal-menu-load-hook) | 611 (run-hooks 'cal-menu-load-hook) |
| 618 | 612 |
| 619 (provide 'cal-menu) | 613 (provide 'cal-menu) |
| 620 | 614 |
| 621 ;;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9 | |
| 622 ;;; cal-menu.el ends here | 615 ;;; cal-menu.el ends here |