Mercurial > emacs
comparison lisp/calendar/cal-menu.el @ 68368:94d20d05817b
Avoid macros from calendar.el so as to break
the nastiest part of the cyclic dependency.
(cal-menu-update): Use dotimes and calendar-increment-month.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Tue, 24 Jan 2006 17:14:16 +0000 |
| parents | 757a5ae466cd |
| children | d38bfc1692a5 5b7d410e31f9 |
comparison
equal
deleted
inserted
replaced
| 68367:a63682481954 | 68368:94d20d05817b |
|---|---|
| 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, 2002, 2003, 2004, 2005 | 3 ;; Copyright (C) 1994, 1995, 2001, 2002, 2003, 2004, 2005, 2006 |
| 4 ;; Free Software Foundation, Inc. | 4 ;; Free Software Foundation, Inc. |
| 5 | 5 |
| 6 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | 6 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
| 7 ;; Lara Rios <lrios@coewl.cen.uiuc.edu> | 7 ;; Lara Rios <lrios@coewl.cen.uiuc.edu> |
| 8 ;; Maintainer: Glenn Morris <rgm@gnu.org> | 8 ;; Maintainer: Glenn Morris <rgm@gnu.org> |
| 40 ;;; Code: | 40 ;;; Code: |
| 41 | 41 |
| 42 (defvar displayed-month) | 42 (defvar displayed-month) |
| 43 (defvar displayed-year) | 43 (defvar displayed-year) |
| 44 | 44 |
| 45 (eval-when-compile (require 'calendar)) | 45 ;; Don't require calendar because calendar requires us. |
| 46 ;; (eval-when-compile (require 'calendar)) | |
| 47 (defvar calendar-mode-map) | |
| 46 | 48 |
| 47 (define-key calendar-mode-map [menu-bar edit] 'undefined) | 49 (define-key calendar-mode-map [menu-bar edit] 'undefined) |
| 48 (define-key calendar-mode-map [menu-bar search] 'undefined) | 50 (define-key calendar-mode-map [menu-bar search] 'undefined) |
| 49 | 51 |
| 50 (define-key calendar-mode-map [down-mouse-2] 'calendar-mouse-2-date-menu) | 52 (define-key calendar-mode-map [down-mouse-2] 'calendar-mouse-2-date-menu) |
| 209 (defun cal-menu-update () | 211 (defun cal-menu-update () |
| 210 ;; Update the holiday part of calendar menu bar for the current display. | 212 ;; Update the holiday part of calendar menu bar for the current display. |
| 211 (condition-case nil | 213 (condition-case nil |
| 212 (if (eq major-mode 'calendar-mode) | 214 (if (eq major-mode 'calendar-mode) |
| 213 (let ((l)) | 215 (let ((l)) |
| 214 (calendar-for-loop;; Show 11 years--5 before, 5 after year of | 216 ;; Show 11 years--5 before, 5 after year of middle month |
| 215 ;; middle month | 217 (dotimes (i 11) |
| 216 i from (- displayed-year 5) to (+ displayed-year 5) do | 218 (let ((y (+ displayed-year -5 i))) |
| 217 (setq l (cons (vector (format "For Year %s" i) | 219 (push (vector (format "For Year %s" y) |
| 218 (list (list 'lambda 'nil '(interactive) | 220 (list (list 'lambda 'nil '(interactive) |
| 219 (list 'list-holidays i i))) | 221 (list 'list-holidays y y))) |
| 220 t) | 222 t) |
| 221 l))) | 223 l))) |
| 222 (setq l (cons ["Mark Holidays" mark-calendar-holidays t] | 224 (setq l (cons ["Mark Holidays" mark-calendar-holidays t] |
| 223 (cons ["Unmark Calendar" calendar-unmark t] | 225 (cons ["Unmark Calendar" calendar-unmark t] |
| 224 (cons "--" l)))) | 226 (cons "--" l)))) |
| 225 (define-key calendar-mode-map [menu-bar Holidays] | 227 (define-key calendar-mode-map [menu-bar Holidays] |
| 226 (cons "Holidays" (easy-menu-create-menu "Holidays" (nreverse l)))) | 228 (cons "Holidays" (easy-menu-create-menu "Holidays" (nreverse l)))) |
| 229 (define-key calendar-mode-map [menu-bar Holidays today] | 231 (define-key calendar-mode-map [menu-bar Holidays today] |
| 230 `(,(format "For Today (%s)" | 232 `(,(format "For Today (%s)" |
| 231 (calendar-date-string (calendar-current-date) t t)) | 233 (calendar-date-string (calendar-current-date) t t)) |
| 232 . cal-menu-today-holidays)) | 234 . cal-menu-today-holidays)) |
| 233 (let ((title | 235 (let ((title |
| 234 (let ((m1 displayed-month) | 236 (let ((my1 (calendar-increment-month -1)) |
| 235 (y1 displayed-year) | 237 (my2 (calendar-increment-month 1))) |
| 236 (m2 displayed-month) | 238 (if (= (cdr my1) (cdr my2)) |
| 237 (y2 displayed-year)) | |
| 238 (increment-calendar-month m1 y1 -1) | |
| 239 (increment-calendar-month m2 y2 1) | |
| 240 (if (= y1 y2) | |
| 241 (format "%s-%s, %d" | 239 (format "%s-%s, %d" |
| 242 (calendar-month-name m1 'abbrev) | 240 (calendar-month-name (car my1) 'abbrev) |
| 243 (calendar-month-name m2 'abbrev) | 241 (calendar-month-name (car my2) 'abbrev) |
| 244 y2) | 242 (cdr my2)) |
| 245 (format "%s, %d-%s, %d" | 243 (format "%s, %d-%s, %d" |
| 246 (calendar-month-name m1 'abbrev) | 244 (calendar-month-name (car my1) 'abbrev) |
| 247 y1 | 245 (cdr my1) |
| 248 (calendar-month-name m2 'abbrev) | 246 (calendar-month-name (car my2) 'abbrev) |
| 249 y2))))) | 247 (cdr my2)))))) |
| 250 (define-key calendar-mode-map [menu-bar Holidays 3-month] | 248 (define-key calendar-mode-map [menu-bar Holidays 3-month] |
| 251 `(,(format "For Window (%s)" title) | 249 `(,(format "For Window (%s)" title) |
| 252 . list-calendar-holidays))) | 250 . list-calendar-holidays))) |
| 253 (let ((date (calendar-cursor-to-date))) | 251 (let ((date (calendar-cursor-to-date))) |
| 254 (if date | 252 (if date |