4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
7 |
|
;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk> |
8 |
;; Keywords: calendar |
;; Keywords: calendar |
9 |
|
|
10 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
297 |
:type 'sexp |
:type 'sexp |
298 |
:version "21.4") |
:version "21.4") |
299 |
|
|
300 |
|
(defvar diary-saved-point) ; internal |
301 |
|
|
302 |
(defun list-diary-entries (date number) |
(defun list-diary-entries (date number) |
303 |
"Create and display a buffer containing the relevant lines in diary-file. |
"Create and display a buffer containing the relevant lines in diary-file. |
304 |
The arguments are DATE and NUMBER; the entries selected are those |
The arguments are DATE and NUMBER; the entries selected are those |
348 |
(set-buffer diary-buffer) |
(set-buffer diary-buffer) |
349 |
(or (verify-visited-file-modtime diary-buffer) |
(or (verify-visited-file-modtime diary-buffer) |
350 |
(revert-buffer t t)))) |
(revert-buffer t t)))) |
351 |
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil ""))) |
;; d-s-p is passed to the diary display function. |
352 |
(setq selective-display t) |
(let ((diary-saved-point (point))) |
353 |
(setq selective-display-ellipses nil) |
(save-excursion |
354 |
(if diary-header-line-flag |
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil ""))) |
355 |
(setq header-line-format diary-header-line-format)) |
(setq selective-display t) |
356 |
(setq old-diary-syntax-table (syntax-table)) |
(setq selective-display-ellipses nil) |
357 |
(set-syntax-table diary-syntax-table) |
(if diary-header-line-flag |
358 |
(unwind-protect |
(setq header-line-format diary-header-line-format)) |
359 |
(let ((buffer-read-only nil) |
(setq old-diary-syntax-table (syntax-table)) |
360 |
(diary-modified (buffer-modified-p)) |
(set-syntax-table diary-syntax-table) |
361 |
(mark (regexp-quote diary-nonmarking-symbol))) |
(unwind-protect |
362 |
;; First and last characters must be ^M or \n for |
(let ((buffer-read-only nil) |
363 |
;; selective display to work properly |
(diary-modified (buffer-modified-p)) |
364 |
(goto-char (1- (point-max))) |
(mark (regexp-quote diary-nonmarking-symbol))) |
365 |
(if (not (looking-at "\^M\\|\n")) |
;; First and last characters must be ^M or \n for |
366 |
(progn |
;; selective display to work properly |
367 |
(goto-char (point-max)) |
(goto-char (1- (point-max))) |
368 |
(insert "\^M"))) |
(if (not (looking-at "\^M\\|\n")) |
369 |
(goto-char (point-min)) |
(progn |
370 |
(if (not (looking-at "\^M\\|\n")) |
(goto-char (point-max)) |
371 |
(insert "\^M")) |
(insert "\^M"))) |
372 |
(subst-char-in-region (point-min) (point-max) ?\n ?\^M t) |
(goto-char (point-min)) |
373 |
(calendar-for-loop i from 1 to number do |
(if (not (looking-at "\^M\\|\n")) |
374 |
(let ((d diary-date-forms) |
(insert "\^M")) |
375 |
(month (extract-calendar-month date)) |
(subst-char-in-region (point-min) (point-max) ?\n ?\^M t) |
376 |
(day (extract-calendar-day date)) |
(calendar-for-loop |
377 |
(year (extract-calendar-year date)) |
i from 1 to number do |
378 |
(entry-found (list-sexp-diary-entries date))) |
(let ((d diary-date-forms) |
379 |
(while d |
(month (extract-calendar-month date)) |
380 |
(let* |
(day (extract-calendar-day date)) |
381 |
((date-form (if (equal (car (car d)) 'backup) |
(year (extract-calendar-year date)) |
382 |
(cdr (car d)) |
(entry-found (list-sexp-diary-entries date))) |
383 |
(car d))) |
(while d |
384 |
(backup (equal (car (car d)) 'backup)) |
(let* |
385 |
(dayname |
((date-form (if (equal (car (car d)) 'backup) |
386 |
(format "%s\\|%s\\.?" |
(cdr (car d)) |
387 |
(calendar-day-name date) |
(car d))) |
388 |
(calendar-day-name date 'abbrev))) |
(backup (equal (car (car d)) 'backup)) |
389 |
(monthname |
(dayname |
390 |
(format "\\*\\|%s\\|%s\\.?" |
(format "%s\\|%s\\.?" |
391 |
(calendar-month-name month) |
(calendar-day-name date) |
392 |
(calendar-month-name month 'abbrev))) |
(calendar-day-name date 'abbrev))) |
393 |
(month (concat "\\*\\|0*" (int-to-string month))) |
(monthname |
394 |
(day (concat "\\*\\|0*" (int-to-string day))) |
(format "\\*\\|%s\\|%s\\.?" |
395 |
(year |
(calendar-month-name month) |
396 |
(concat |
(calendar-month-name month 'abbrev))) |
397 |
"\\*\\|0*" (int-to-string year) |
(month (concat "\\*\\|0*" (int-to-string month))) |
398 |
(if abbreviated-calendar-year |
(day (concat "\\*\\|0*" (int-to-string day))) |
399 |
(concat "\\|" (format "%02d" (% year 100))) |
(year |
400 |
""))) |
(concat |
401 |
(regexp |
"\\*\\|0*" (int-to-string year) |
402 |
(concat |
(if abbreviated-calendar-year |
403 |
"\\(\\`\\|\^M\\|\n\\)" mark "?\\(" |
(concat "\\|" (format "%02d" (% year 100))) |
404 |
(mapconcat 'eval date-form "\\)\\(") |
""))) |
405 |
"\\)")) |
(regexp |
406 |
(case-fold-search t)) |
(concat |
407 |
(goto-char (point-min)) |
"\\(\\`\\|\^M\\|\n\\)" mark "?\\(" |
408 |
(while (re-search-forward regexp nil t) |
(mapconcat 'eval date-form "\\)\\(") |
409 |
(if backup (re-search-backward "\\<" nil t)) |
"\\)")) |
410 |
(if (and (or (char-equal (preceding-char) ?\^M) |
(case-fold-search t)) |
411 |
(char-equal (preceding-char) ?\n)) |
(goto-char (point-min)) |
412 |
(not (looking-at " \\|\^I"))) |
(while (re-search-forward regexp nil t) |
413 |
;; Diary entry that consists only of date. |
(if backup (re-search-backward "\\<" nil t)) |
414 |
(backward-char 1) |
(if (and (or (char-equal (preceding-char) ?\^M) |
415 |
;; Found a nonempty diary entry--make it visible and |
(char-equal (preceding-char) ?\n)) |
416 |
;; add it to the list. |
(not (looking-at " \\|\^I"))) |
417 |
(setq entry-found t) |
;; Diary entry that consists only of date. |
418 |
(let ((entry-start (point)) |
(backward-char 1) |
419 |
date-start temp) |
;; Found a nonempty diary entry--make it |
420 |
(re-search-backward "\^M\\|\n\\|\\`") |
;; visible and add it to the list. |
421 |
(setq date-start (point)) |
(setq entry-found t) |
422 |
(re-search-forward "\^M\\|\n" nil t 2) |
(let ((entry-start (point)) |
423 |
(while (looking-at " \\|\^I") |
date-start temp) |
424 |
(re-search-forward "\^M\\|\n" nil t)) |
(re-search-backward "\^M\\|\n\\|\\`") |
425 |
(backward-char 1) |
(setq date-start (point)) |
426 |
(subst-char-in-region date-start |
(re-search-forward "\^M\\|\n" nil t 2) |
427 |
(point) ?\^M ?\n t) |
(while (looking-at " \\|\^I") |
428 |
(setq entry (buffer-substring entry-start (point)) |
(re-search-forward "\^M\\|\n" nil t)) |
429 |
temp (diary-pull-attrs entry file-glob-attrs) |
(backward-char 1) |
430 |
entry (nth 0 temp)) |
(subst-char-in-region date-start |
431 |
(add-to-diary-list |
(point) ?\^M ?\n t) |
432 |
date |
(setq entry (buffer-substring entry-start (point)) |
433 |
entry |
temp (diary-pull-attrs entry file-glob-attrs) |
434 |
(buffer-substring |
entry (nth 0 temp)) |
435 |
(1+ date-start) (1- entry-start)) |
(add-to-diary-list |
436 |
(copy-marker entry-start) (nth 1 temp)))))) |
date |
437 |
(setq d (cdr d))) |
entry |
438 |
(or entry-found |
(buffer-substring |
439 |
(not diary-list-include-blanks) |
(1+ date-start) (1- entry-start)) |
440 |
(setq diary-entries-list |
(copy-marker entry-start) (nth 1 temp)))))) |
441 |
(append diary-entries-list |
(setq d (cdr d))) |
442 |
(list (list date "" "" "" ""))))) |
(or entry-found |
443 |
(setq date |
(not diary-list-include-blanks) |
444 |
(calendar-gregorian-from-absolute |
(setq diary-entries-list |
445 |
(1+ (calendar-absolute-from-gregorian date)))) |
(append diary-entries-list |
446 |
(setq entry-found nil))) |
(list (list date "" "" "" ""))))) |
447 |
(set-buffer-modified-p diary-modified)) |
(setq date |
448 |
(set-syntax-table old-diary-syntax-table)) |
(calendar-gregorian-from-absolute |
449 |
(goto-char (point-min)) |
(1+ (calendar-absolute-from-gregorian date)))) |
450 |
(run-hooks 'nongregorian-diary-listing-hook |
(setq entry-found nil))) |
451 |
'list-diary-entries-hook) |
(set-buffer-modified-p diary-modified)) |
452 |
(if diary-display-hook |
(set-syntax-table old-diary-syntax-table)) |
453 |
(run-hooks 'diary-display-hook) |
(goto-char (point-min)) |
454 |
(simple-diary-display)) |
(run-hooks 'nongregorian-diary-listing-hook |
455 |
(run-hooks 'diary-hook) |
'list-diary-entries-hook) |
456 |
diary-entries-list)))) |
(if diary-display-hook |
457 |
|
(run-hooks 'diary-display-hook) |
458 |
|
(simple-diary-display)) |
459 |
|
(run-hooks 'diary-hook) |
460 |
|
diary-entries-list)))))) |
461 |
|
|
462 |
(defun include-other-diary-files () |
(defun include-other-diary-files () |
463 |
"Include the diary entries from other diary files with those of diary-file. |
"Include the diary entries from other diary files with those of diary-file. |
535 |
(setq buffer-read-only t) |
(setq buffer-read-only t) |
536 |
(display-buffer holiday-buffer) |
(display-buffer holiday-buffer) |
537 |
(message "No diary entries for %s" date-string)) |
(message "No diary entries for %s" date-string)) |
538 |
(display-buffer (find-buffer-visiting |
(with-current-buffer |
539 |
(substitute-in-file-name diary-file))) |
(find-buffer-visiting (substitute-in-file-name diary-file)) |
540 |
|
(let ((window (display-buffer (current-buffer)))) |
541 |
|
;; d-s-p is passed from list-diary-entries. |
542 |
|
(set-window-point window diary-saved-point) |
543 |
|
(set-window-start window (point-min)))) |
544 |
(message "Preparing diary...done")))) |
(message "Preparing diary...done")))) |
545 |
|
|
546 |
(defface diary-button-face '((((type pc) (class color)) |
(defface diary-button-face '((((type pc) (class color)) |