diff options
| author | Glenn Morris | 2008-03-14 07:05:10 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-14 07:05:10 +0000 |
| commit | 71855cc518b43c24fbb4d92d0dcf3fff163c4e45 (patch) | |
| tree | e4302bcdf097d45a785859d0acee8217d9208e53 | |
| parent | 20a614c6c89381fdc59983b52623a177cd472cbc (diff) | |
| download | emacs-71855cc518b43c24fbb4d92d0dcf3fff163c4e45.tar.gz emacs-71855cc518b43c24fbb4d92d0dcf3fff163c4e45.zip | |
(displayed-month, displayed-year): Move declarations where needed.
(calendar-holiday-list, calendar-list-holidays)
(holiday-filter-visible-calendar): Move definitions before use.
(list-holidays): Use cadr.
Relocate obsolete aliases after their replacements.
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/calendar/holidays.el | 204 |
2 files changed, 109 insertions, 102 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d1b76f9e0a6..49a88cd1f4d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -93,6 +93,13 @@ | |||
| 93 | (calendar-buffer-list): Return buffers rather than strings (fixes | 93 | (calendar-buffer-list): Return buffers rather than strings (fixes |
| 94 | previous change). | 94 | previous change). |
| 95 | 95 | ||
| 96 | * calendar/holidays.el (displayed-month, displayed-year): | ||
| 97 | Move declarations where needed. | ||
| 98 | (calendar-holiday-list, calendar-list-holidays) | ||
| 99 | (holiday-filter-visible-calendar): Move definitions before use. | ||
| 100 | (list-holidays): Use cadr. | ||
| 101 | Relocate obsolete aliases after their replacements. | ||
| 102 | |||
| 96 | * textmodes/org-irc.el (top-level): CL not required when compiling. | 103 | * textmodes/org-irc.el (top-level): CL not required when compiling. |
| 97 | (org-irc-visit-erc): Replace runtime CL functions. | 104 | (org-irc-visit-erc): Replace runtime CL functions. |
| 98 | 105 | ||
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 3ed7fcfdac0..cce73c9c203 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el | |||
| @@ -47,14 +47,75 @@ | |||
| 47 | 47 | ||
| 48 | ;;; Code: | 48 | ;;; Code: |
| 49 | 49 | ||
| 50 | (defvar displayed-month) | ||
| 51 | (defvar displayed-year) | ||
| 52 | |||
| 53 | (require 'calendar) | 50 | (require 'calendar) |
| 54 | 51 | ||
| 55 | (eval-and-compile | 52 | (eval-and-compile |
| 56 | (load "hol-loaddefs" nil 'quiet)) | 53 | (load "hol-loaddefs" nil 'quiet)) |
| 57 | 54 | ||
| 55 | (defvar displayed-month) ; from generate-calendar | ||
| 56 | (defvar displayed-year) | ||
| 57 | |||
| 58 | ;;;###diary-autoload | ||
| 59 | (defun calendar-holiday-list () | ||
| 60 | "Form the list of holidays that occur on dates in the calendar window. | ||
| 61 | The holidays are those in the list `calendar-holidays'." | ||
| 62 | (let (holiday-list) | ||
| 63 | (dolist (p calendar-holidays) | ||
| 64 | (let* ((holidays | ||
| 65 | (if calendar-debug-sexp | ||
| 66 | (let ((stack-trace-on-error t)) | ||
| 67 | (eval p)) | ||
| 68 | (condition-case nil | ||
| 69 | (eval p) | ||
| 70 | (error (beep) | ||
| 71 | (message "Bad holiday list item: %s" p) | ||
| 72 | (sleep-for 2)))))) | ||
| 73 | (if holidays | ||
| 74 | (setq holiday-list (append holidays holiday-list))))) | ||
| 75 | (setq holiday-list (sort holiday-list 'calendar-date-compare)))) | ||
| 76 | |||
| 77 | ;;;###cal-autoload | ||
| 78 | (defun calendar-list-holidays () | ||
| 79 | "Create a buffer containing the holidays for the current calendar window. | ||
| 80 | The holidays are those in the list `calendar-notable-days'. Returns t if any | ||
| 81 | holidays are found, nil if not." | ||
| 82 | (interactive) | ||
| 83 | (message "Looking up holidays...") | ||
| 84 | (let ((holiday-list (calendar-holiday-list)) | ||
| 85 | (m1 displayed-month) | ||
| 86 | (y1 displayed-year) | ||
| 87 | (m2 displayed-month) | ||
| 88 | (y2 displayed-year)) | ||
| 89 | (if (not holiday-list) | ||
| 90 | (progn | ||
| 91 | (message "Looking up holidays...none found") | ||
| 92 | nil) | ||
| 93 | (set-buffer (get-buffer-create holiday-buffer)) | ||
| 94 | (setq buffer-read-only nil) | ||
| 95 | (increment-calendar-month m1 y1 -1) | ||
| 96 | (increment-calendar-month m2 y2 1) | ||
| 97 | (calendar-set-mode-line | ||
| 98 | (if (= y1 y2) | ||
| 99 | (format "Notable Dates from %s to %s, %d%%-" | ||
| 100 | (calendar-month-name m1) (calendar-month-name m2) y2) | ||
| 101 | (format "Notable Dates from %s, %d to %s, %d%%-" | ||
| 102 | (calendar-month-name m1) y1 (calendar-month-name m2) y2))) | ||
| 103 | (erase-buffer) | ||
| 104 | (insert | ||
| 105 | (mapconcat | ||
| 106 | (lambda (x) (concat (calendar-date-string (car x)) | ||
| 107 | ": " (cadr x))) | ||
| 108 | holiday-list "\n")) | ||
| 109 | (goto-char (point-min)) | ||
| 110 | (set-buffer-modified-p nil) | ||
| 111 | (setq buffer-read-only t) | ||
| 112 | (display-buffer holiday-buffer) | ||
| 113 | (message "Looking up holidays...done") | ||
| 114 | t))) | ||
| 115 | |||
| 116 | (define-obsolete-function-alias | ||
| 117 | 'list-calendar-holidays 'calendar-list-holidays "23.1") | ||
| 118 | |||
| 58 | ;;;###autoload | 119 | ;;;###autoload |
| 59 | (defun holidays (&optional arg) | 120 | (defun holidays (&optional arg) |
| 60 | "Display the holidays for last month, this month, and next month. | 121 | "Display the holidays for last month, this month, and next month. |
| @@ -63,8 +124,7 @@ This function is suitable for execution in a .emacs file." | |||
| 63 | (interactive "P") | 124 | (interactive "P") |
| 64 | (save-excursion | 125 | (save-excursion |
| 65 | (let* ((completion-ignore-case t) | 126 | (let* ((completion-ignore-case t) |
| 66 | (date (if arg | 127 | (date (if arg (calendar-read-date t) |
| 67 | (calendar-read-date t) | ||
| 68 | (calendar-current-date))) | 128 | (calendar-current-date))) |
| 69 | (displayed-month (extract-calendar-month date)) | 129 | (displayed-month (extract-calendar-month date)) |
| 70 | (displayed-year (extract-calendar-year date))) | 130 | (displayed-year (extract-calendar-year date))) |
| @@ -100,10 +160,10 @@ The optional LABEL is used to label the buffer created." | |||
| 100 | (int-to-string (extract-calendar-year | 160 | (int-to-string (extract-calendar-year |
| 101 | (calendar-current-date))))) | 161 | (calendar-current-date))))) |
| 102 | (end-year (calendar-read | 162 | (end-year (calendar-read |
| 103 | (format "Ending year (inclusive) of holidays (>=%s): " | 163 | (format "Ending year (inclusive) of holidays (>=%s): " |
| 104 | start-year) | 164 | start-year) |
| 105 | (lambda (x) (>= x start-year)) | 165 | (lambda (x) (>= x start-year)) |
| 106 | (int-to-string start-year))) | 166 | (int-to-string start-year))) |
| 107 | (completion-ignore-case t) | 167 | (completion-ignore-case t) |
| 108 | (lists | 168 | (lists |
| 109 | (list | 169 | (list |
| @@ -161,7 +221,7 @@ The optional LABEL is used to label the buffer created." | |||
| 161 | (insert | 221 | (insert |
| 162 | (mapconcat | 222 | (mapconcat |
| 163 | (lambda (x) (concat (calendar-date-string (car x)) | 223 | (lambda (x) (concat (calendar-date-string (car x)) |
| 164 | ": " (car (cdr x)))) | 224 | ": " (cadr x))) |
| 165 | holiday-list "\n")) | 225 | holiday-list "\n")) |
| 166 | (goto-char (point-min)) | 226 | (goto-char (point-min)) |
| 167 | (set-buffer-modified-p nil) | 227 | (set-buffer-modified-p nil) |
| @@ -185,6 +245,9 @@ The holidays are those in the list `calendar-holidays'." | |||
| 185 | (setq holiday-list (append holiday-list (cdr h))))) | 245 | (setq holiday-list (append holiday-list (cdr h))))) |
| 186 | holiday-list)) | 246 | holiday-list)) |
| 187 | 247 | ||
| 248 | (define-obsolete-function-alias | ||
| 249 | 'check-calendar-holidays 'calendar-check-holidays "23.1") | ||
| 250 | |||
| 188 | ;;;###cal-autoload | 251 | ;;;###cal-autoload |
| 189 | (defun calendar-cursor-holidays () | 252 | (defun calendar-cursor-holidays () |
| 190 | "Find holidays for the date specified by the cursor in the calendar window." | 253 | "Find holidays for the date specified by the cursor in the calendar window." |
| @@ -217,67 +280,11 @@ The holidays are those in the list `calendar-holidays'." | |||
| 217 | (setq mark-holidays-in-calendar t) | 280 | (setq mark-holidays-in-calendar t) |
| 218 | (message "Marking holidays...") | 281 | (message "Marking holidays...") |
| 219 | (dolist (holiday (calendar-holiday-list)) | 282 | (dolist (holiday (calendar-holiday-list)) |
| 220 | (mark-visible-calendar-date | 283 | (mark-visible-calendar-date (car holiday) calendar-holiday-marker)) |
| 221 | (car holiday) calendar-holiday-marker)) | ||
| 222 | (message "Marking holidays...done")) | 284 | (message "Marking holidays...done")) |
| 223 | 285 | ||
| 224 | ;;;###cal-autoload | 286 | (define-obsolete-function-alias |
| 225 | (defun calendar-list-holidays () | 287 | 'mark-calendar-holidays 'calendar-mark-holidays "23.1") |
| 226 | "Create a buffer containing the holidays for the current calendar window. | ||
| 227 | The holidays are those in the list `calendar-notable-days'. Returns t if any | ||
| 228 | holidays are found, nil if not." | ||
| 229 | (interactive) | ||
| 230 | (message "Looking up holidays...") | ||
| 231 | (let ((holiday-list (calendar-holiday-list)) | ||
| 232 | (m1 displayed-month) | ||
| 233 | (y1 displayed-year) | ||
| 234 | (m2 displayed-month) | ||
| 235 | (y2 displayed-year)) | ||
| 236 | (if (not holiday-list) | ||
| 237 | (progn | ||
| 238 | (message "Looking up holidays...none found") | ||
| 239 | nil) | ||
| 240 | (set-buffer (get-buffer-create holiday-buffer)) | ||
| 241 | (setq buffer-read-only nil) | ||
| 242 | (increment-calendar-month m1 y1 -1) | ||
| 243 | (increment-calendar-month m2 y2 1) | ||
| 244 | (calendar-set-mode-line | ||
| 245 | (if (= y1 y2) | ||
| 246 | (format "Notable Dates from %s to %s, %d%%-" | ||
| 247 | (calendar-month-name m1) (calendar-month-name m2) y2) | ||
| 248 | (format "Notable Dates from %s, %d to %s, %d%%-" | ||
| 249 | (calendar-month-name m1) y1 (calendar-month-name m2) y2))) | ||
| 250 | (erase-buffer) | ||
| 251 | (insert | ||
| 252 | (mapconcat | ||
| 253 | (lambda (x) (concat (calendar-date-string (car x)) | ||
| 254 | ": " (car (cdr x)))) | ||
| 255 | holiday-list "\n")) | ||
| 256 | (goto-char (point-min)) | ||
| 257 | (set-buffer-modified-p nil) | ||
| 258 | (setq buffer-read-only t) | ||
| 259 | (display-buffer holiday-buffer) | ||
| 260 | (message "Looking up holidays...done") | ||
| 261 | t))) | ||
| 262 | |||
| 263 | ;;;###diary-autoload | ||
| 264 | (defun calendar-holiday-list () | ||
| 265 | "Form the list of holidays that occur on dates in the calendar window. | ||
| 266 | The holidays are those in the list `calendar-holidays'." | ||
| 267 | (let (holiday-list) | ||
| 268 | (dolist (p calendar-holidays) | ||
| 269 | (let* ((holidays | ||
| 270 | (if calendar-debug-sexp | ||
| 271 | (let ((stack-trace-on-error t)) | ||
| 272 | (eval p)) | ||
| 273 | (condition-case nil | ||
| 274 | (eval p) | ||
| 275 | (error (beep) | ||
| 276 | (message "Bad holiday list item: %s" p) | ||
| 277 | (sleep-for 2)))))) | ||
| 278 | (if holidays | ||
| 279 | (setq holiday-list (append holidays holiday-list))))) | ||
| 280 | (setq holiday-list (sort holiday-list 'calendar-date-compare)))) | ||
| 281 | 288 | ||
| 282 | ;; Below are the functions that calculate the dates of holidays; these | 289 | ;; Below are the functions that calculate the dates of holidays; these |
| 283 | ;; are eval'ed in the function calendar-holiday-list. If you | 290 | ;; are eval'ed in the function calendar-holiday-list. If you |
| @@ -293,7 +300,7 @@ STRING)). Returns nil if it is not visible in the current calendar window." | |||
| 293 | (y displayed-year)) | 300 | (y displayed-year)) |
| 294 | (increment-calendar-month m y (- 11 month)) | 301 | (increment-calendar-month m y (- 11 month)) |
| 295 | (if (> m 9) | 302 | (if (> m 9) |
| 296 | (list (list (list month day y) string))))) | 303 | (list (list (list month day y) string))))) |
| 297 | 304 | ||
| 298 | (defun holiday-float (month dayname n string &optional day) | 305 | (defun holiday-float (month dayname n string &optional day) |
| 299 | "Holiday on MONTH, DAYNAME (Nth occurrence) called STRING. | 306 | "Holiday on MONTH, DAYNAME (Nth occurrence) called STRING. |
| @@ -305,18 +312,18 @@ If N<0, count backward from the end of MONTH. | |||
| 305 | An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY. | 312 | An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY. |
| 306 | 313 | ||
| 307 | Returns nil if it is not visible in the current calendar window." | 314 | Returns nil if it is not visible in the current calendar window." |
| 308 | ;; This is messy because the holiday may be visible, while the date on which | 315 | ;; This is messy because the holiday may be visible, while the date on which |
| 309 | ;; it is based is not. For example, the first Monday after December 30 may be | 316 | ;; it is based is not. For example, the first Monday after December 30 may be |
| 310 | ;; visible when January is not. For large values of |n| the problem is more | 317 | ;; visible when January is not. For large values of |n| the problem is more |
| 311 | ;; grotesque. If we didn't have to worry about such cases, we could just use | 318 | ;; grotesque. If we didn't have to worry about such cases, we could just use |
| 312 | 319 | ||
| 313 | ;; (let ((m displayed-month) | 320 | ;; (let ((m displayed-month) |
| 314 | ;; (y displayed-year)) | 321 | ;; (y displayed-year)) |
| 315 | ;; (increment-calendar-month m y (- 11 month)) | 322 | ;; (increment-calendar-month m y (- 11 month)) |
| 316 | ;; (if (> m 9); month in year y is visible | 323 | ;; (if (> m 9); month in year y is visible |
| 317 | ;; (list (list (calendar-nth-named-day n dayname month y day) string))))) | 324 | ;; (list (list (calendar-nth-named-day n dayname month y day) string))))) |
| 318 | 325 | ||
| 319 | ;; which is the way the function was originally written. | 326 | ;; which is the way the function was originally written. |
| 320 | 327 | ||
| 321 | (let* ((m1 displayed-month) | 328 | (let* ((m1 displayed-month) |
| 322 | (y1 displayed-year) | 329 | (y1 displayed-year) |
| @@ -336,8 +343,8 @@ Returns nil if it is not visible in the current calendar window." | |||
| 336 | (y2 (extract-calendar-year (calendar-gregorian-from-absolute d2))) | 343 | (y2 (extract-calendar-year (calendar-gregorian-from-absolute d2))) |
| 337 | (y ; year of base date | 344 | (y ; year of base date |
| 338 | (if (or (= y1 y2) (> month 9)) | 345 | (if (or (= y1 y2) (> month 9)) |
| 339 | y1 | 346 | y1 |
| 340 | y2)) | 347 | y2)) |
| 341 | (d ; day of base date | 348 | (d ; day of base date |
| 342 | (or day (if (> n 0) | 349 | (or day (if (> n 0) |
| 343 | 1 | 350 | 1 |
| @@ -348,6 +355,18 @@ Returns nil if it is not visible in the current calendar window." | |||
| 348 | (list (list (calendar-nth-named-day n dayname month y d) | 355 | (list (list (calendar-nth-named-day n dayname month y d) |
| 349 | string)))))) | 356 | string)))))) |
| 350 | 357 | ||
| 358 | (defun holiday-filter-visible-calendar (l) | ||
| 359 | "Return a list of all visible holidays of those on L." | ||
| 360 | (let ((visible ())) | ||
| 361 | (dolist (p l) | ||
| 362 | (and (car p) | ||
| 363 | (calendar-date-is-visible-p (car p)) | ||
| 364 | (push p visible))) | ||
| 365 | visible)) | ||
| 366 | |||
| 367 | (define-obsolete-function-alias | ||
| 368 | 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1") | ||
| 369 | |||
| 351 | (defun holiday-sexp (sexp string) | 370 | (defun holiday-sexp (sexp string) |
| 352 | "Sexp holiday for dates in the calendar window. | 371 | "Sexp holiday for dates in the calendar window. |
| 353 | SEXP is an expression in variable `year' evaluates to `date'. | 372 | SEXP is an expression in variable `year' evaluates to `date'. |
| @@ -437,7 +456,7 @@ is non-nil)." | |||
| 437 | (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule | 456 | (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule |
| 438 | (- ; ...corrected for the Gregorian century rule | 457 | (- ; ...corrected for the Gregorian century rule |
| 439 | (/ (* 3 century) 4)) | 458 | (/ (* 3 century) 4)) |
| 440 | (/ ; ...corrected for Metonic cycle inaccuracy | 459 | (/ ; ...corrected for Metonic cycle inaccuracy |
| 441 | (+ 5 (* 8 century)) 25) | 460 | (+ 5 (* 8 century)) 25) |
| 442 | (* 30 century)) ; keeps value positive | 461 | (* 30 century)) ; keeps value positive |
| 443 | 30)) | 462 | 30)) |
| @@ -480,25 +499,6 @@ is non-nil)." | |||
| 480 | (if (calendar-date-is-visible-p nicaean-easter) | 499 | (if (calendar-date-is-visible-p nicaean-easter) |
| 481 | (list (list nicaean-easter "Pascha (Greek Orthodox Easter)")))))) | 500 | (list (list nicaean-easter "Pascha (Greek Orthodox Easter)")))))) |
| 482 | 501 | ||
| 483 | (defun holiday-filter-visible-calendar (l) | ||
| 484 | "Return a list of all visible holidays of those on L." | ||
| 485 | (let ((visible ())) | ||
| 486 | (dolist (p l) | ||
| 487 | (and (car p) | ||
| 488 | (calendar-date-is-visible-p (car p)) | ||
| 489 | (push p visible))) | ||
| 490 | visible)) | ||
| 491 | |||
| 492 | ;; Backward compatibility. | ||
| 493 | (define-obsolete-function-alias | ||
| 494 | 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1") | ||
| 495 | (define-obsolete-function-alias | ||
| 496 | 'list-calendar-holidays 'calendar-list-holidays "23.1") | ||
| 497 | (define-obsolete-function-alias | ||
| 498 | 'mark-calendar-holidays 'calendar-mark-holidays "23.1") | ||
| 499 | (define-obsolete-function-alias | ||
| 500 | 'check-calendar-holidays 'calendar-check-holidays "23.1") | ||
| 501 | |||
| 502 | (provide 'holidays) | 502 | (provide 'holidays) |
| 503 | 503 | ||
| 504 | ;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37 | 504 | ;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37 |