diff options
| author | Glenn Morris | 2003-06-22 01:02:22 +0000 |
|---|---|---|
| committer | Glenn Morris | 2003-06-22 01:02:22 +0000 |
| commit | c87a1f384ef6ba15559fffbce610c78768178a7a (patch) | |
| tree | 76ccfc0ad965301fff6ef478e8b449b97b1a2e73 | |
| parent | f4bbb3646abf65aa04d39a814d76367d65958397 (diff) | |
| download | emacs-c87a1f384ef6ba15559fffbce610c78768178a7a.tar.gz emacs-c87a1f384ef6ba15559fffbce610c78768178a7a.zip | |
(diary-check-diary-file): New function.
(diary, view-diary-entries, show-all-diary-entries)
(mark-diary-entries): Use it.
(view-other-diary-entries): Doc fix. Use `prefix-numeric-value'.
(diary-syntax-table, diary-attrtype-convert, diary-mail-days): Doc fix.
(diary-modified, d-file): No need to defvar (for compiler).
(list-diary-entries): No need for `let*' so use `let'.
(simple-diary-display): Use `diary-file' directly rather than
inheriting `d-file' from `list-diary-entries' caller.
(make-fancy-diary-buffer, show-all-diary-entries): `mode-line-format'
already buffer-local.
(diary-mail-addr): Set to the empty string (rather than nil) if
undefined, as per `user-mail-address'.
(diary-mail-entries): Doc fix. Error if `diary-mail-address' unset.
(mark-sexp-diary-entries): Don't regexp-quote sexp-mark twice.
Remove an un-needed `if'.
(list-sexp-diary-entries): Remove local vars mark and s-entry, and
use `let' rather than `let*'.
(diary-date, insert-monthly-diary-entry)
(insert-yearly-diary-entry, insert-anniversary-diary-entry)
(insert-block-diary-entry, insert-cyclic-diary-entry)
(font-lock-diary-date-forms): No need for `let*' so use `let'.
(make-diary-entry): Doc fix. Use `or' rather than `if'.
(diary-font-lock-keywords): Use `when'. `cal-islam' is required
feature, not `cal-islamic'.
`calendar-islamic-month-name-array-leap-year' does not exist - use
`calendar-islamic-month-name-array'.
| -rw-r--r-- | lisp/calendar/diary-lib.el | 518 |
1 files changed, 245 insertions, 273 deletions
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 75a1fc16ac7..83f35c279b5 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; diary-lib.el --- diary functions | 1 | ;;; diary-lib.el --- diary functions |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995 Free Software | 3 | ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2003 |
| 4 | ;; 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 | ;; Keywords: calendar | 7 | ;; Keywords: calendar |
| @@ -38,6 +38,16 @@ | |||
| 38 | 38 | ||
| 39 | (require 'calendar) | 39 | (require 'calendar) |
| 40 | 40 | ||
| 41 | (defun diary-check-diary-file () | ||
| 42 | "Check that the file specified by `diary-file' exists and is readable. | ||
| 43 | If so, return the expanded file name, otherwise signal an error." | ||
| 44 | (let ((d-file (substitute-in-file-name diary-file))) | ||
| 45 | (if (and d-file (file-exists-p d-file)) | ||
| 46 | (if (file-readable-p d-file) | ||
| 47 | d-file | ||
| 48 | (error "Diary file `%s' is not readable" diary-file)) | ||
| 49 | (error "Diary file `%s' does not exist" diary-file)))) | ||
| 50 | |||
| 41 | ;;;###autoload | 51 | ;;;###autoload |
| 42 | (defun diary (&optional arg) | 52 | (defun diary (&optional arg) |
| 43 | "Generate the diary window for ARG days starting with the current date. | 53 | "Generate the diary window for ARG days starting with the current date. |
| @@ -45,19 +55,14 @@ If no argument is provided, the number of days of diary entries is governed | |||
| 45 | by the variable `number-of-diary-entries'. This function is suitable for | 55 | by the variable `number-of-diary-entries'. This function is suitable for |
| 46 | execution in a `.emacs' file." | 56 | execution in a `.emacs' file." |
| 47 | (interactive "P") | 57 | (interactive "P") |
| 48 | (let ((d-file (substitute-in-file-name diary-file)) | 58 | (diary-check-diary-file) |
| 49 | (date (calendar-current-date))) | 59 | (let ((date (calendar-current-date))) |
| 50 | (if (and d-file (file-exists-p d-file)) | 60 | (list-diary-entries |
| 51 | (if (file-readable-p d-file) | 61 | date |
| 52 | (list-diary-entries | 62 | (cond (arg (prefix-numeric-value arg)) |
| 53 | date | 63 | ((vectorp number-of-diary-entries) |
| 54 | (cond | 64 | (aref number-of-diary-entries (calendar-day-of-week date))) |
| 55 | (arg (prefix-numeric-value arg)) | 65 | (t number-of-diary-entries))))) |
| 56 | ((vectorp number-of-diary-entries) | ||
| 57 | (aref number-of-diary-entries (calendar-day-of-week date))) | ||
| 58 | (t number-of-diary-entries))) | ||
| 59 | (error "Your diary file is not readable!")) | ||
| 60 | (error "You don't have a diary file!")))) | ||
| 61 | 66 | ||
| 62 | (defun view-diary-entries (arg) | 67 | (defun view-diary-entries (arg) |
| 63 | "Prepare and display a buffer with diary entries. | 68 | "Prepare and display a buffer with diary entries. |
| @@ -65,22 +70,16 @@ Searches the file named in `diary-file' for entries that | |||
| 65 | match ARG days starting with the date indicated by the cursor position | 70 | match ARG days starting with the date indicated by the cursor position |
| 66 | in the displayed three-month calendar." | 71 | in the displayed three-month calendar." |
| 67 | (interactive "p") | 72 | (interactive "p") |
| 68 | (let ((d-file (substitute-in-file-name diary-file))) | 73 | (diary-check-diary-file) |
| 69 | (if (and d-file (file-exists-p d-file)) | 74 | (list-diary-entries (calendar-cursor-to-date t) arg)) |
| 70 | (if (file-readable-p d-file) | ||
| 71 | (list-diary-entries (calendar-cursor-to-date t) arg) | ||
| 72 | (error "Diary file is not readable!")) | ||
| 73 | (error "You don't have a diary file!")))) | ||
| 74 | 75 | ||
| 75 | (defun view-other-diary-entries (arg d-file) | 76 | (defun view-other-diary-entries (arg d-file) |
| 76 | "Prepare and display buffer of diary entries from an alternative diary file. | 77 | "Prepare and display buffer of diary entries from an alternative diary file. |
| 77 | Prompts for a file name and searches that file for entries that match ARG | 78 | Searches for entries that match ARG days, starting with the date indicated |
| 78 | days starting with the date indicated by the cursor position in the displayed | 79 | by the cursor position in the displayed three-month calendar. |
| 79 | three-month calendar." | 80 | D-FILE specifies the file to use as the diary file." |
| 80 | (interactive | 81 | (interactive |
| 81 | (list (cond ((null current-prefix-arg) 1) | 82 | (list (if arg (prefix-numeric-value arg) 1) |
| 82 | ((listp current-prefix-arg) (car current-prefix-arg)) | ||
| 83 | (t current-prefix-arg)) | ||
| 84 | (read-file-name "Enter diary file name: " default-directory nil t))) | 83 | (read-file-name "Enter diary file name: " default-directory nil t))) |
| 85 | (let ((diary-file d-file)) | 84 | (let ((diary-file d-file)) |
| 86 | (view-diary-entries arg))) | 85 | (view-diary-entries arg))) |
| @@ -169,12 +168,11 @@ No diary entry if there is no sunset on that date.") | |||
| 169 | (defvar diary-syntax-table (copy-syntax-table (standard-syntax-table)) | 168 | (defvar diary-syntax-table (copy-syntax-table (standard-syntax-table)) |
| 170 | "The syntax table used when parsing dates in the diary file. | 169 | "The syntax table used when parsing dates in the diary file. |
| 171 | It is the standard syntax table used in Fundamental mode, but with the | 170 | It is the standard syntax table used in Fundamental mode, but with the |
| 172 | syntax of `*' changed to be a word constituent.") | 171 | syntax of `*' and `:' changed to be word constituents.") |
| 173 | 172 | ||
| 174 | (modify-syntax-entry ?* "w" diary-syntax-table) | 173 | (modify-syntax-entry ?* "w" diary-syntax-table) |
| 175 | (modify-syntax-entry ?: "w" diary-syntax-table) | 174 | (modify-syntax-entry ?: "w" diary-syntax-table) |
| 176 | 175 | ||
| 177 | (defvar diary-modified) | ||
| 178 | (defvar diary-entries-list) | 176 | (defvar diary-entries-list) |
| 179 | (defvar displayed-year) | 177 | (defvar displayed-year) |
| 180 | (defvar displayed-month) | 178 | (defvar displayed-month) |
| @@ -182,12 +180,11 @@ syntax of `*' changed to be a word constituent.") | |||
| 182 | (defvar date) | 180 | (defvar date) |
| 183 | (defvar number) | 181 | (defvar number) |
| 184 | (defvar date-string) | 182 | (defvar date-string) |
| 185 | (defvar d-file) | ||
| 186 | (defvar original-date) | 183 | (defvar original-date) |
| 187 | 184 | ||
| 188 | (defun diary-attrtype-convert (attrvalue type) | 185 | (defun diary-attrtype-convert (attrvalue type) |
| 189 | "Convert the attrvalue from a string to the appropriate type for using | 186 | "Convert string ATTRVALUE to TYPE appropriate for a face description. |
| 190 | in a face description" | 187 | Valid TYPEs are: string, symbol, int, stringtnil, tnil." |
| 191 | (let (ret) | 188 | (let (ret) |
| 192 | (setq ret (cond ((eq type 'string) attrvalue) | 189 | (setq ret (cond ((eq type 'string) attrvalue) |
| 193 | ((eq type 'symbol) (read attrvalue)) | 190 | ((eq type 'symbol) (read attrvalue)) |
| @@ -297,12 +294,12 @@ These hooks have the following distinct roles: | |||
| 297 | notification function." | 294 | notification function." |
| 298 | 295 | ||
| 299 | (if (< 0 number) | 296 | (if (< 0 number) |
| 300 | (let* ((original-date date);; save for possible use in the hooks | 297 | (let ((original-date date);; save for possible use in the hooks |
| 301 | old-diary-syntax-table | 298 | old-diary-syntax-table |
| 302 | diary-entries-list | 299 | diary-entries-list |
| 303 | file-glob-attrs | 300 | file-glob-attrs |
| 304 | (date-string (calendar-date-string date)) | 301 | (date-string (calendar-date-string date)) |
| 305 | (d-file (substitute-in-file-name diary-file))) | 302 | (d-file (substitute-in-file-name diary-file))) |
| 306 | (message "Preparing diary...") | 303 | (message "Preparing diary...") |
| 307 | (save-excursion | 304 | (save-excursion |
| 308 | (let ((diary-buffer (find-buffer-visiting d-file))) | 305 | (let ((diary-buffer (find-buffer-visiting d-file))) |
| @@ -491,7 +488,8 @@ changing the variable `diary-include-string'." | |||
| 491 | (setq buffer-read-only t) | 488 | (setq buffer-read-only t) |
| 492 | (display-buffer holiday-buffer) | 489 | (display-buffer holiday-buffer) |
| 493 | (message "No diary entries for %s" date-string)) | 490 | (message "No diary entries for %s" date-string)) |
| 494 | (display-buffer (find-buffer-visiting d-file)) | 491 | (display-buffer (find-buffer-visiting |
| 492 | (substitute-in-file-name diary-file))) | ||
| 495 | (message "Preparing diary...done")))) | 493 | (message "Preparing diary...done")))) |
| 496 | 494 | ||
| 497 | (defface diary-button-face '((((type pc) (class color)) | 495 | (defface diary-button-face '((((type pc) (class color)) |
| @@ -641,7 +639,6 @@ This function is provided for optional use as the `diary-display-hook'." | |||
| 641 | (save-excursion | 639 | (save-excursion |
| 642 | (set-buffer (get-buffer-create fancy-diary-buffer)) | 640 | (set-buffer (get-buffer-create fancy-diary-buffer)) |
| 643 | (setq buffer-read-only nil) | 641 | (setq buffer-read-only nil) |
| 644 | (make-local-variable 'mode-line-format) | ||
| 645 | (calendar-set-mode-line "Diary Entries") | 642 | (calendar-set-mode-line "Diary Entries") |
| 646 | (erase-buffer) | 643 | (erase-buffer) |
| 647 | (set-buffer-modified-p nil) | 644 | (set-buffer-modified-p nil) |
| @@ -694,36 +691,27 @@ This function gets rid of the selective display of the diary file so that | |||
| 694 | all entries, not just some, are visible. If there is no diary buffer, one | 691 | all entries, not just some, are visible. If there is no diary buffer, one |
| 695 | is created." | 692 | is created." |
| 696 | (interactive) | 693 | (interactive) |
| 697 | (let ((d-file (substitute-in-file-name diary-file))) | 694 | (let ((d-file (diary-check-diary-file))) |
| 698 | (if (and d-file (file-exists-p d-file)) | 695 | (save-excursion |
| 699 | (if (file-readable-p d-file) | 696 | (set-buffer (or (find-buffer-visiting d-file) |
| 700 | (save-excursion | 697 | (find-file-noselect d-file t))) |
| 701 | (let ((diary-buffer (find-buffer-visiting d-file))) | 698 | (let ((buffer-read-only nil) |
| 702 | (set-buffer (if diary-buffer | 699 | (diary-modified (buffer-modified-p))) |
| 703 | diary-buffer | 700 | (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) |
| 704 | (find-file-noselect d-file t))) | 701 | (setq selective-display nil |
| 705 | (let ((buffer-read-only nil) | 702 | mode-line-format default-mode-line-format) |
| 706 | (diary-modified (buffer-modified-p))) | 703 | (display-buffer (current-buffer)) |
| 707 | (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) | 704 | (set-buffer-modified-p diary-modified))))) |
| 708 | (setq selective-display nil) | ||
| 709 | (make-local-variable 'mode-line-format) | ||
| 710 | (setq mode-line-format default-mode-line-format) | ||
| 711 | (display-buffer (current-buffer)) | ||
| 712 | (set-buffer-modified-p diary-modified)))) | ||
| 713 | (error "Your diary file is not readable!")) | ||
| 714 | (error "You don't have a diary file!")))) | ||
| 715 | |||
| 716 | |||
| 717 | 705 | ||
| 718 | (defcustom diary-mail-addr | 706 | (defcustom diary-mail-addr |
| 719 | (if (boundp 'user-mail-address) user-mail-address nil) | 707 | (if (boundp 'user-mail-address) user-mail-address "") |
| 720 | "*Email address that `diary-mail-entries' will send email to." | 708 | "*Email address that `diary-mail-entries' will send email to." |
| 721 | :group 'diary | 709 | :group 'diary |
| 722 | :type '(choice string (const nil)) | 710 | :type 'string |
| 723 | :version "20.3") | 711 | :version "20.3") |
| 724 | 712 | ||
| 725 | (defcustom diary-mail-days 7 | 713 | (defcustom diary-mail-days 7 |
| 726 | "*Number of days for `diary-mail-entries' to check." | 714 | "*Default number of days for `diary-mail-entries' to check." |
| 727 | :group 'diary | 715 | :group 'diary |
| 728 | :type 'integer | 716 | :type 'integer |
| 729 | :version "20.3") | 717 | :version "20.3") |
| @@ -732,6 +720,7 @@ is created." | |||
| 732 | (defun diary-mail-entries (&optional ndays) | 720 | (defun diary-mail-entries (&optional ndays) |
| 733 | "Send a mail message showing diary entries for next NDAYS days. | 721 | "Send a mail message showing diary entries for next NDAYS days. |
| 734 | If no prefix argument is given, NDAYS is set to `diary-mail-days'. | 722 | If no prefix argument is given, NDAYS is set to `diary-mail-days'. |
| 723 | Mail is sent to the address specified by `diary-mail-addr'. | ||
| 735 | 724 | ||
| 736 | You can call `diary-mail-entries' every night using an at/cron job. | 725 | You can call `diary-mail-entries' every night using an at/cron job. |
| 737 | For example, this script will run the program at 2am daily. Since | 726 | For example, this script will run the program at 2am daily. Since |
| @@ -742,6 +731,7 @@ all relevant variables are set, as done here. | |||
| 742 | # diary-rem.sh -- repeatedly run the Emacs diary-reminder | 731 | # diary-rem.sh -- repeatedly run the Emacs diary-reminder |
| 743 | emacs -batch \\ | 732 | emacs -batch \\ |
| 744 | -eval \"(setq diary-mail-days 3 \\ | 733 | -eval \"(setq diary-mail-days 3 \\ |
| 734 | diary-file \\\"/path/to/diary.file\\\" \\ | ||
| 745 | european-calendar-style t \\ | 735 | european-calendar-style t \\ |
| 746 | diary-mail-addr \\\"user@host.name\\\" )\" \\ | 736 | diary-mail-addr \\\"user@host.name\\\" )\" \\ |
| 747 | -l diary-lib -f diary-mail-entries | 737 | -l diary-lib -f diary-mail-entries |
| @@ -752,18 +742,20 @@ system. Alternatively, you can specify a cron entry: | |||
| 752 | 0 1 * * * diary-rem.sh | 742 | 0 1 * * * diary-rem.sh |
| 753 | to run it every morning at 1am." | 743 | to run it every morning at 1am." |
| 754 | (interactive "P") | 744 | (interactive "P") |
| 755 | (let ((diary-display-hook 'fancy-diary-display)) | 745 | (if (string-equal diary-mail-addr "") |
| 756 | (list-diary-entries (calendar-current-date) (or ndays diary-mail-days))) | 746 | (error "You must set `diary-mail-addr' to use this command") |
| 757 | (compose-mail diary-mail-addr | 747 | (let ((diary-display-hook 'fancy-diary-display)) |
| 758 | (concat "Diary entries generated " | 748 | (list-diary-entries (calendar-current-date) (or ndays diary-mail-days))) |
| 759 | (calendar-date-string (calendar-current-date)))) | 749 | (compose-mail diary-mail-addr |
| 760 | (insert | 750 | (concat "Diary entries generated " |
| 761 | (if (get-buffer fancy-diary-buffer) | 751 | (calendar-date-string (calendar-current-date)))) |
| 762 | (save-excursion | 752 | (insert |
| 763 | (set-buffer fancy-diary-buffer) | 753 | (if (get-buffer fancy-diary-buffer) |
| 764 | (buffer-substring (point-min) (point-max))) | 754 | (save-excursion |
| 765 | "No entries found")) | 755 | (set-buffer fancy-diary-buffer) |
| 766 | (call-interactively (get mail-user-agent 'sendfunc))) | 756 | (buffer-substring (point-min) (point-max))) |
| 757 | "No entries found")) | ||
| 758 | (call-interactively (get mail-user-agent 'sendfunc)))) | ||
| 767 | 759 | ||
| 768 | 760 | ||
| 769 | (defun diary-name-pattern (string-array &optional fullname) | 761 | (defun diary-name-pattern (string-array &optional fullname) |
| @@ -799,127 +791,120 @@ After the entries are marked, the hooks `nongregorian-diary-marking-hook' and | |||
| 799 | `mark-diary-entries-hook' are run." | 791 | `mark-diary-entries-hook' are run." |
| 800 | (interactive) | 792 | (interactive) |
| 801 | (setq mark-diary-entries-in-calendar t) | 793 | (setq mark-diary-entries-in-calendar t) |
| 802 | (let (file-glob-attrs | 794 | (let ((marking-diary-entries t) |
| 803 | marks | 795 | file-glob-attrs marks) |
| 804 | (d-file (substitute-in-file-name diary-file)) | 796 | (save-excursion |
| 805 | (marking-diary-entries t)) | 797 | (set-buffer (find-file-noselect (diary-check-diary-file) t)) |
| 806 | (if (and d-file (file-exists-p d-file)) | 798 | (message "Marking diary entries...") |
| 807 | (if (file-readable-p d-file) | 799 | (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
| 808 | (save-excursion | 800 | (let ((d diary-date-forms) |
| 809 | (message "Marking diary entries...") | 801 | (old-diary-syntax-table (syntax-table)) |
| 810 | (set-buffer (find-file-noselect d-file t)) | 802 | temp) |
| 811 | (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) | 803 | (set-syntax-table diary-syntax-table) |
| 812 | (let ((d diary-date-forms) | 804 | (while d |
| 813 | (old-diary-syntax-table (syntax-table)) | 805 | (let* ((date-form (if (equal (car (car d)) 'backup) |
| 814 | temp) | 806 | (cdr (car d)) |
| 815 | (set-syntax-table diary-syntax-table) | 807 | (car d)));; ignore 'backup directive |
| 816 | (while d | 808 | (dayname (diary-name-pattern calendar-day-name-array)) |
| 817 | (let* | 809 | (monthname |
| 818 | ((date-form (if (equal (car (car d)) 'backup) | 810 | (concat |
| 819 | (cdr (car d)) | 811 | (diary-name-pattern calendar-month-name-array) |
| 820 | (car d)));; ignore 'backup directive | 812 | "\\|\\*")) |
| 821 | (dayname (diary-name-pattern calendar-day-name-array)) | 813 | (month "[0-9]+\\|\\*") |
| 822 | (monthname | 814 | (day "[0-9]+\\|\\*") |
| 823 | (concat | 815 | (year "[0-9]+\\|\\*") |
| 824 | (diary-name-pattern calendar-month-name-array) | 816 | (l (length date-form)) |
| 825 | "\\|\\*")) | 817 | (d-name-pos (- l (length (memq 'dayname date-form)))) |
| 826 | (month "[0-9]+\\|\\*") | 818 | (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) |
| 827 | (day "[0-9]+\\|\\*") | 819 | (m-name-pos (- l (length (memq 'monthname date-form)))) |
| 828 | (year "[0-9]+\\|\\*") | 820 | (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) |
| 829 | (l (length date-form)) | 821 | (d-pos (- l (length (memq 'day date-form)))) |
| 830 | (d-name-pos (- l (length (memq 'dayname date-form)))) | 822 | (d-pos (if (/= l d-pos) (+ 2 d-pos))) |
| 831 | (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) | 823 | (m-pos (- l (length (memq 'month date-form)))) |
| 832 | (m-name-pos (- l (length (memq 'monthname date-form)))) | 824 | (m-pos (if (/= l m-pos) (+ 2 m-pos))) |
| 833 | (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) | 825 | (y-pos (- l (length (memq 'year date-form)))) |
| 834 | (d-pos (- l (length (memq 'day date-form)))) | 826 | (y-pos (if (/= l y-pos) (+ 2 y-pos))) |
| 835 | (d-pos (if (/= l d-pos) (+ 2 d-pos))) | 827 | (regexp |
| 836 | (m-pos (- l (length (memq 'month date-form)))) | 828 | (concat |
| 837 | (m-pos (if (/= l m-pos) (+ 2 m-pos))) | 829 | "\\(\\`\\|\^M\\|\n\\)\\(" |
| 838 | (y-pos (- l (length (memq 'year date-form)))) | 830 | (mapconcat 'eval date-form "\\)\\(") |
| 839 | (y-pos (if (/= l y-pos) (+ 2 y-pos))) | 831 | "\\)")) |
| 840 | (regexp | 832 | (case-fold-search t)) |
| 841 | (concat | 833 | (goto-char (point-min)) |
| 842 | "\\(\\`\\|\^M\\|\n\\)\\(" | 834 | (while (re-search-forward regexp nil t) |
| 843 | (mapconcat 'eval date-form "\\)\\(") | 835 | (let* ((dd-name |
| 844 | "\\)")) | 836 | (if d-name-pos |
| 845 | (case-fold-search t)) | 837 | (buffer-substring-no-properties |
| 846 | (goto-char (point-min)) | 838 | (match-beginning d-name-pos) |
| 847 | (while (re-search-forward regexp nil t) | 839 | (match-end d-name-pos)))) |
| 848 | (let* ((dd-name | 840 | (mm-name |
| 849 | (if d-name-pos | 841 | (if m-name-pos |
| 850 | (buffer-substring-no-properties | 842 | (buffer-substring-no-properties |
| 851 | (match-beginning d-name-pos) | 843 | (match-beginning m-name-pos) |
| 852 | (match-end d-name-pos)))) | 844 | (match-end m-name-pos)))) |
| 853 | (mm-name | 845 | (mm (string-to-int |
| 854 | (if m-name-pos | 846 | (if m-pos |
| 855 | (buffer-substring-no-properties | 847 | (buffer-substring-no-properties |
| 856 | (match-beginning m-name-pos) | 848 | (match-beginning m-pos) |
| 857 | (match-end m-name-pos)))) | 849 | (match-end m-pos)) |
| 858 | (mm (string-to-int | 850 | ""))) |
| 859 | (if m-pos | 851 | (dd (string-to-int |
| 860 | (buffer-substring-no-properties | 852 | (if d-pos |
| 861 | (match-beginning m-pos) | 853 | (buffer-substring-no-properties |
| 862 | (match-end m-pos)) | 854 | (match-beginning d-pos) |
| 863 | ""))) | 855 | (match-end d-pos)) |
| 864 | (dd (string-to-int | 856 | ""))) |
| 865 | (if d-pos | 857 | (y-str (if y-pos |
| 866 | (buffer-substring-no-properties | 858 | (buffer-substring-no-properties |
| 867 | (match-beginning d-pos) | 859 | (match-beginning y-pos) |
| 868 | (match-end d-pos)) | 860 | (match-end y-pos)))) |
| 869 | ""))) | 861 | (yy (if (not y-str) |
| 870 | (y-str (if y-pos | 862 | 0 |
| 871 | (buffer-substring-no-properties | 863 | (if (and (= (length y-str) 2) |
| 872 | (match-beginning y-pos) | 864 | abbreviated-calendar-year) |
| 873 | (match-end y-pos)))) | 865 | (let* ((current-y |
| 874 | (yy (if (not y-str) | 866 | (extract-calendar-year |
| 875 | 0 | 867 | (calendar-current-date))) |
| 876 | (if (and (= (length y-str) 2) | 868 | (y (+ (string-to-int y-str) |
| 877 | abbreviated-calendar-year) | 869 | (* 100 |
| 878 | (let* ((current-y | 870 | (/ current-y 100))))) |
| 879 | (extract-calendar-year | 871 | (if (> (- y current-y) 50) |
| 880 | (calendar-current-date))) | 872 | (- y 100) |
| 881 | (y (+ (string-to-int y-str) | 873 | (if (> (- current-y y) 50) |
| 882 | (* 100 | 874 | (+ y 100) |
| 883 | (/ current-y 100))))) | 875 | y))) |
| 884 | (if (> (- y current-y) 50) | 876 | (string-to-int y-str)))) |
| 885 | (- y 100) | 877 | (save-excursion |
| 886 | (if (> (- current-y y) 50) | 878 | (setq entry (buffer-substring-no-properties |
| 887 | (+ y 100) | 879 | (point) (line-end-position)) |
| 888 | y))) | 880 | temp (diary-pull-attrs entry file-glob-attrs) |
| 889 | (string-to-int y-str)))) | 881 | entry (nth 0 temp) |
| 890 | (save-excursion | 882 | marks (nth 1 temp)))) |
| 891 | (setq entry (buffer-substring-no-properties (point) (line-end-position)) | 883 | (if dd-name |
| 892 | temp (diary-pull-attrs entry file-glob-attrs) | 884 | (mark-calendar-days-named |
| 893 | entry (nth 0 temp) | 885 | (cdr (assoc-ignore-case |
| 894 | marks (nth 1 temp)))) | 886 | (substring dd-name 0 3) |
| 895 | (if dd-name | 887 | (calendar-make-alist |
| 896 | (mark-calendar-days-named | 888 | calendar-day-name-array |
| 897 | (cdr (assoc-ignore-case | 889 | 0 |
| 898 | (substring dd-name 0 3) | 890 | (lambda (x) (substring x 0 3))))) marks) |
| 899 | (calendar-make-alist | 891 | (if mm-name |
| 900 | calendar-day-name-array | 892 | (if (string-equal mm-name "*") |
| 901 | 0 | 893 | (setq mm 0) |
| 902 | (lambda (x) (substring x 0 3))))) marks) | 894 | (setq mm |
| 903 | (if mm-name | 895 | (cdr (assoc-ignore-case |
| 904 | (if (string-equal mm-name "*") | 896 | (substring mm-name 0 3) |
| 905 | (setq mm 0) | 897 | (calendar-make-alist |
| 906 | (setq mm | 898 | calendar-month-name-array |
| 907 | (cdr (assoc-ignore-case | 899 | 1 |
| 908 | (substring mm-name 0 3) | 900 | (lambda (x) (substring x 0 3)))))))) |
| 909 | (calendar-make-alist | 901 | (mark-calendar-date-pattern mm dd yy marks)))) |
| 910 | calendar-month-name-array | 902 | (setq d (cdr d)))) |
| 911 | 1 | 903 | (mark-sexp-diary-entries) |
| 912 | (lambda (x) (substring x 0 3))) | 904 | (run-hooks 'nongregorian-diary-marking-hook |
| 913 | ))))) | 905 | 'mark-diary-entries-hook) |
| 914 | (mark-calendar-date-pattern mm dd yy marks)))) | 906 | (set-syntax-table old-diary-syntax-table) |
| 915 | (setq d (cdr d)))) | 907 | (message "Marking diary entries...done"))))) |
| 916 | (mark-sexp-diary-entries) | ||
| 917 | (run-hooks 'nongregorian-diary-marking-hook | ||
| 918 | 'mark-diary-entries-hook) | ||
| 919 | (set-syntax-table old-diary-syntax-table) | ||
| 920 | (message "Marking diary entries...done"))) | ||
| 921 | (error "Your diary file is not readable!")) | ||
| 922 | (error "You don't have a diary file!")))) | ||
| 923 | 908 | ||
| 924 | (defun mark-sexp-diary-entries () | 909 | (defun mark-sexp-diary-entries () |
| 925 | "Mark days in the calendar window that have sexp diary entries. | 910 | "Mark days in the calendar window that have sexp diary entries. |
| @@ -927,16 +912,11 @@ Each entry in the diary file (or included files) visible in the calendar window | |||
| 927 | is marked. See the documentation for the function `list-sexp-diary-entries'." | 912 | is marked. See the documentation for the function `list-sexp-diary-entries'." |
| 928 | (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol)) | 913 | (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol)) |
| 929 | (s-entry (concat "\\(\\`\\|\^M\\|\n\\)\\(" | 914 | (s-entry (concat "\\(\\`\\|\^M\\|\n\\)\\(" |
| 930 | (regexp-quote sexp-mark) "(\\)\\|\\(" | 915 | sexp-mark "(\\)\\|\\(" |
| 931 | (regexp-quote diary-nonmarking-symbol) | 916 | (regexp-quote diary-nonmarking-symbol) |
| 932 | (regexp-quote sexp-mark) "(diary-remind\\)")) | 917 | sexp-mark "(diary-remind\\)")) |
| 933 | (m) | 918 | (file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
| 934 | (y) | 919 | m y first-date last-date mark file-glob-attrs) |
| 935 | (first-date) | ||
| 936 | (last-date) | ||
| 937 | (mark) | ||
| 938 | file-glob-attrs) | ||
| 939 | (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) | ||
| 940 | (save-excursion | 920 | (save-excursion |
| 941 | (set-buffer calendar-buffer) | 921 | (set-buffer calendar-buffer) |
| 942 | (setq m displayed-month) | 922 | (setq m displayed-month) |
| @@ -950,9 +930,7 @@ is marked. See the documentation for the function `list-sexp-diary-entries'." | |||
| 950 | (list m (calendar-last-day-of-month m y) y))) | 930 | (list m (calendar-last-day-of-month m y) y))) |
| 951 | (goto-char (point-min)) | 931 | (goto-char (point-min)) |
| 952 | (while (re-search-forward s-entry nil t) | 932 | (while (re-search-forward s-entry nil t) |
| 953 | (if (char-equal (preceding-char) ?\() | 933 | (setq marking-diary-entry (char-equal (preceding-char) ?\()) |
| 954 | (setq marking-diary-entry t) | ||
| 955 | (setq marking-diary-entry nil)) | ||
| 956 | (re-search-backward "(") | 934 | (re-search-backward "(") |
| 957 | (let ((sexp-start (point)) | 935 | (let ((sexp-start (point)) |
| 958 | sexp entry entry-start line-start marks) | 936 | sexp entry entry-start line-start marks) |
| @@ -1288,21 +1266,19 @@ A number of built-in functions are available for this type of diary entry: | |||
| 1288 | 1266 | ||
| 1289 | Marking these entries is *extremely* time consuming, so these entries are | 1267 | Marking these entries is *extremely* time consuming, so these entries are |
| 1290 | best if they are nonmarking." | 1268 | best if they are nonmarking." |
| 1291 | (let* ((mark (regexp-quote diary-nonmarking-symbol)) | 1269 | (let ((s-entry (concat "\\(\\`\\|\^M\\|\n\\)" |
| 1292 | (sexp-mark (regexp-quote sexp-diary-entry-symbol)) | 1270 | (regexp-quote diary-nonmarking-symbol) |
| 1293 | (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) | 1271 | "?" |
| 1294 | entry-found file-glob-attrs marks) | 1272 | (regexp-quote sexp-diary-entry-symbol) |
| 1273 | "(")) | ||
| 1274 | entry-found file-glob-attrs marks) | ||
| 1295 | (goto-char (point-min)) | 1275 | (goto-char (point-min)) |
| 1296 | (save-excursion | 1276 | (save-excursion |
| 1297 | (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))) | 1277 | (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))) |
| 1298 | (while (re-search-forward s-entry nil t) | 1278 | (while (re-search-forward s-entry nil t) |
| 1299 | (backward-char 1) | 1279 | (backward-char 1) |
| 1300 | (let ((sexp-start (point)) | 1280 | (let ((sexp-start (point)) |
| 1301 | (sexp) | 1281 | sexp entry specifier entry-start line-start) |
| 1302 | (entry) | ||
| 1303 | (specifier) | ||
| 1304 | (entry-start) | ||
| 1305 | (line-start)) | ||
| 1306 | (forward-sexp) | 1282 | (forward-sexp) |
| 1307 | (setq sexp (buffer-substring-no-properties sexp-start (point))) | 1283 | (setq sexp (buffer-substring-no-properties sexp-start (point))) |
| 1308 | (save-excursion | 1284 | (save-excursion |
| @@ -1382,15 +1358,15 @@ all values. | |||
| 1382 | 1358 | ||
| 1383 | An optional parameter MARK specifies a face or single-character string to | 1359 | An optional parameter MARK specifies a face or single-character string to |
| 1384 | use when highlighting the day in the calendar." | 1360 | use when highlighting the day in the calendar." |
| 1385 | (let* ((dd (if european-calendar-style | 1361 | (let ((dd (if european-calendar-style |
| 1386 | month | 1362 | month |
| 1387 | day)) | 1363 | day)) |
| 1388 | (mm (if european-calendar-style | 1364 | (mm (if european-calendar-style |
| 1389 | day | 1365 | day |
| 1390 | month)) | 1366 | month)) |
| 1391 | (m (extract-calendar-month date)) | 1367 | (m (extract-calendar-month date)) |
| 1392 | (y (extract-calendar-year date)) | 1368 | (y (extract-calendar-year date)) |
| 1393 | (d (extract-calendar-day date))) | 1369 | (d (extract-calendar-day date))) |
| 1394 | (if (and | 1370 | (if (and |
| 1395 | (or (and (listp dd) (memq d dd)) | 1371 | (or (and (listp dd) (memq d dd)) |
| 1396 | (equal d dd) | 1372 | (equal d dd) |
| @@ -1616,9 +1592,8 @@ Do nothing if DATE or STRING is nil." | |||
| 1616 | 1592 | ||
| 1617 | (defun make-diary-entry (string &optional nonmarking file) | 1593 | (defun make-diary-entry (string &optional nonmarking file) |
| 1618 | "Insert a diary entry STRING which may be NONMARKING in FILE. | 1594 | "Insert a diary entry STRING which may be NONMARKING in FILE. |
| 1619 | If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." | 1595 | If omitted, NONMARKING defaults to nil and FILE defaults to `diary-file'." |
| 1620 | (find-file-other-window | 1596 | (find-file-other-window (substitute-in-file-name (or file diary-file))) |
| 1621 | (substitute-in-file-name (if file file diary-file))) | ||
| 1622 | (widen) | 1597 | (widen) |
| 1623 | (goto-char (point-max)) | 1598 | (goto-char (point-max)) |
| 1624 | (when (let ((case-fold-search t)) | 1599 | (when (let ((case-fold-search t)) |
| @@ -1651,10 +1626,10 @@ Prefix arg will make the entry nonmarking." | |||
| 1651 | "Insert a monthly diary entry for the day of the month indicated by point. | 1626 | "Insert a monthly diary entry for the day of the month indicated by point. |
| 1652 | Prefix arg will make the entry nonmarking." | 1627 | Prefix arg will make the entry nonmarking." |
| 1653 | (interactive "P") | 1628 | (interactive "P") |
| 1654 | (let* ((calendar-date-display-form | 1629 | (let ((calendar-date-display-form |
| 1655 | (if european-calendar-style | 1630 | (if european-calendar-style |
| 1656 | '(day " * ") | 1631 | '(day " * ") |
| 1657 | '("* " day)))) | 1632 | '("* " day)))) |
| 1658 | (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t) | 1633 | (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t) |
| 1659 | arg))) | 1634 | arg))) |
| 1660 | 1635 | ||
| @@ -1662,10 +1637,10 @@ Prefix arg will make the entry nonmarking." | |||
| 1662 | "Insert an annual diary entry for the day of the year indicated by point. | 1637 | "Insert an annual diary entry for the day of the year indicated by point. |
| 1663 | Prefix arg will make the entry nonmarking." | 1638 | Prefix arg will make the entry nonmarking." |
| 1664 | (interactive "P") | 1639 | (interactive "P") |
| 1665 | (let* ((calendar-date-display-form | 1640 | (let ((calendar-date-display-form |
| 1666 | (if european-calendar-style | 1641 | (if european-calendar-style |
| 1667 | '(day " " monthname) | 1642 | '(day " " monthname) |
| 1668 | '(monthname " " day)))) | 1643 | '(monthname " " day)))) |
| 1669 | (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t) | 1644 | (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t) |
| 1670 | arg))) | 1645 | arg))) |
| 1671 | 1646 | ||
| @@ -1673,10 +1648,10 @@ Prefix arg will make the entry nonmarking." | |||
| 1673 | "Insert an anniversary diary entry for the date given by point. | 1648 | "Insert an anniversary diary entry for the date given by point. |
| 1674 | Prefix arg will make the entry nonmarking." | 1649 | Prefix arg will make the entry nonmarking." |
| 1675 | (interactive "P") | 1650 | (interactive "P") |
| 1676 | (let* ((calendar-date-display-form | 1651 | (let ((calendar-date-display-form |
| 1677 | (if european-calendar-style | 1652 | (if european-calendar-style |
| 1678 | '(day " " month " " year) | 1653 | '(day " " month " " year) |
| 1679 | '(month " " day " " year)))) | 1654 | '(month " " day " " year)))) |
| 1680 | (make-diary-entry | 1655 | (make-diary-entry |
| 1681 | (format "%s(diary-anniversary %s)" | 1656 | (format "%s(diary-anniversary %s)" |
| 1682 | sexp-diary-entry-symbol | 1657 | sexp-diary-entry-symbol |
| @@ -1687,15 +1662,14 @@ Prefix arg will make the entry nonmarking." | |||
| 1687 | "Insert a block diary entry for the days between the point and marked date. | 1662 | "Insert a block diary entry for the days between the point and marked date. |
| 1688 | Prefix arg will make the entry nonmarking." | 1663 | Prefix arg will make the entry nonmarking." |
| 1689 | (interactive "P") | 1664 | (interactive "P") |
| 1690 | (let* ((calendar-date-display-form | 1665 | (let ((calendar-date-display-form |
| 1691 | (if european-calendar-style | 1666 | (if european-calendar-style |
| 1692 | '(day " " month " " year) | 1667 | '(day " " month " " year) |
| 1693 | '(month " " day " " year))) | 1668 | '(month " " day " " year))) |
| 1694 | (cursor (calendar-cursor-to-date t)) | 1669 | (cursor (calendar-cursor-to-date t)) |
| 1695 | (mark (or (car calendar-mark-ring) | 1670 | (mark (or (car calendar-mark-ring) |
| 1696 | (error "No mark set in this buffer"))) | 1671 | (error "No mark set in this buffer"))) |
| 1697 | (start) | 1672 | start end) |
| 1698 | (end)) | ||
| 1699 | (if (< (calendar-absolute-from-gregorian mark) | 1673 | (if (< (calendar-absolute-from-gregorian mark) |
| 1700 | (calendar-absolute-from-gregorian cursor)) | 1674 | (calendar-absolute-from-gregorian cursor)) |
| 1701 | (setq start mark | 1675 | (setq start mark |
| @@ -1713,10 +1687,10 @@ Prefix arg will make the entry nonmarking." | |||
| 1713 | "Insert a cyclic diary entry starting at the date given by point. | 1687 | "Insert a cyclic diary entry starting at the date given by point. |
| 1714 | Prefix arg will make the entry nonmarking." | 1688 | Prefix arg will make the entry nonmarking." |
| 1715 | (interactive "P") | 1689 | (interactive "P") |
| 1716 | (let* ((calendar-date-display-form | 1690 | (let ((calendar-date-display-form |
| 1717 | (if european-calendar-style | 1691 | (if european-calendar-style |
| 1718 | '(day " " month " " year) | 1692 | '(day " " month " " year) |
| 1719 | '(month " " day " " year)))) | 1693 | '(month " " day " " year)))) |
| 1720 | (make-diary-entry | 1694 | (make-diary-entry |
| 1721 | (format "%s(diary-cyclic %d %s)" | 1695 | (format "%s(diary-cyclic %d %s)" |
| 1722 | sexp-diary-entry-symbol | 1696 | sexp-diary-entry-symbol |
| @@ -1788,14 +1762,14 @@ Prefix arg will make the entry nonmarking." | |||
| 1788 | "Create a list of font-lock patterns for `diary-date-forms' with MONTH-LIST. | 1762 | "Create a list of font-lock patterns for `diary-date-forms' with MONTH-LIST. |
| 1789 | If given, optional SYMBOL must be a prefix to entries. | 1763 | If given, optional SYMBOL must be a prefix to entries. |
| 1790 | If optional NOABBREV is t, do not allow abbreviations in names." | 1764 | If optional NOABBREV is t, do not allow abbreviations in names." |
| 1791 | (let* ((dayname | 1765 | (let ((dayname |
| 1792 | (concat "\\(" (diary-name-pattern calendar-day-name-array) "\\)")) | 1766 | (concat "\\(" (diary-name-pattern calendar-day-name-array) "\\)")) |
| 1793 | (monthname (concat "\\(" | 1767 | (monthname (concat "\\(" |
| 1794 | (diary-name-pattern month-list noabbrev) | 1768 | (diary-name-pattern month-list noabbrev) |
| 1795 | "\\|\\*\\)")) | 1769 | "\\|\\*\\)")) |
| 1796 | (month "\\([0-9]+\\|\\*\\)") | 1770 | (month "\\([0-9]+\\|\\*\\)") |
| 1797 | (day "\\([0-9]+\\|\\*\\)") | 1771 | (day "\\([0-9]+\\|\\*\\)") |
| 1798 | (year "-?\\([0-9]+\\|\\*\\)")) | 1772 | (year "-?\\([0-9]+\\|\\*\\)")) |
| 1799 | (mapcar '(lambda (x) | 1773 | (mapcar '(lambda (x) |
| 1800 | (cons | 1774 | (cons |
| 1801 | (concat "^" (regexp-quote diary-nonmarking-symbol) "?" | 1775 | (concat "^" (regexp-quote diary-nonmarking-symbol) "?" |
| @@ -1817,24 +1791,22 @@ If optional NOABBREV is t, do not allow abbreviations in names." | |||
| 1817 | (defvar diary-font-lock-keywords | 1791 | (defvar diary-font-lock-keywords |
| 1818 | (append | 1792 | (append |
| 1819 | (font-lock-diary-date-forms calendar-month-name-array) | 1793 | (font-lock-diary-date-forms calendar-month-name-array) |
| 1820 | (if (or (memq 'mark-hebrew-diary-entries | 1794 | (when (or (memq 'mark-hebrew-diary-entries |
| 1821 | nongregorian-diary-marking-hook) | 1795 | nongregorian-diary-marking-hook) |
| 1822 | (memq 'list-hebrew-diary-entries | 1796 | (memq 'list-hebrew-diary-entries |
| 1823 | nongregorian-diary-listing-hook)) | 1797 | nongregorian-diary-listing-hook)) |
| 1824 | (progn | 1798 | (require 'cal-hebrew) |
| 1825 | (require 'cal-hebrew) | 1799 | (font-lock-diary-date-forms |
| 1826 | (font-lock-diary-date-forms | 1800 | calendar-hebrew-month-name-array-leap-year |
| 1827 | calendar-hebrew-month-name-array-leap-year | 1801 | hebrew-diary-entry-symbol t)) |
| 1828 | hebrew-diary-entry-symbol t))) | 1802 | (when (or (memq 'mark-islamic-diary-entries |
| 1829 | (if (or (memq 'mark-islamic-diary-entries | 1803 | nongregorian-diary-marking-hook) |
| 1830 | nongregorian-diary-marking-hook) | 1804 | (memq 'list-islamic-diary-entries |
| 1831 | (memq 'list-islamic-diary-entries | 1805 | nongregorian-diary-listing-hook)) |
| 1832 | nongregorian-diary-listing-hook)) | 1806 | (require 'cal-islam) |
| 1833 | (progn | 1807 | (font-lock-diary-date-forms |
| 1834 | (require 'cal-islamic) | 1808 | calendar-islamic-month-name-array |
| 1835 | (font-lock-diary-date-forms | 1809 | islamic-diary-entry-symbol t)) |
| 1836 | calendar-islamic-month-name-array-leap-year | ||
| 1837 | islamic-diary-entry-symbol t))) | ||
| 1838 | (list | 1810 | (list |
| 1839 | (cons | 1811 | (cons |
| 1840 | (concat "^" (regexp-quote diary-include-string) ".*$") | 1812 | (concat "^" (regexp-quote diary-include-string) ".*$") |