diff options
| author | Stefan Monnier | 2017-12-04 17:03:32 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2017-12-04 17:03:32 -0500 |
| commit | 559d685f68174d0401833a36cdcb573a88ee8e14 (patch) | |
| tree | 66f69c2a6eed522ebad4f1daecc4b1a107a67a66 | |
| parent | 2dd14bf72504c1ba2b505f70d864b13e0661fc79 (diff) | |
| download | emacs-559d685f68174d0401833a36cdcb573a88ee8e14.tar.gz emacs-559d685f68174d0401833a36cdcb573a88ee8e14.zip | |
* lisp/calendar/diary-lib.el: Use lexical-binding
(diary-pull-attrs): Avoid let...setq.
(diary-list-entries-2, diary-mark-entries-1)
(diary-font-lock-date-forms, diary-fancy-date-pattern):
Use calendar-dlet* around uses of diary-date-forms.
(list-only, number, date, entry): Don't declare globally.
(diary-including): Declare.
(diary-saved-point, date-string): Move before first use.
(diary-list-entries): Use calendar-dlet* around
diary-nongregorian-listing-hook and 'diary-list-entries-hook.
(displayed-year, displayed-month): Move before first use.
(diary-sexp-entry): Use calendar-let* around evaluation of the sexp.
(diary-remind): Use calendar-let* around evaluation of sexp.
| -rw-r--r-- | lisp/calendar/diary-lib.el | 502 |
1 files changed, 261 insertions, 241 deletions
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index e45f8b27622..4e7cbb313db 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; diary-lib.el --- diary functions | 1 | ;;; diary-lib.el --- diary functions -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1989-1990, 1992-1995, 2001-2017 Free Software | 3 | ;; Copyright (C) 1989-1990, 1992-1995, 2001-2017 Free Software |
| 4 | ;; Foundation, Inc. | 4 | ;; Foundation, Inc. |
| @@ -119,7 +119,7 @@ are: `string', `symbol', `int', `tnil', `stringtnil.'" | |||
| 119 | :type 'boolean | 119 | :type 'boolean |
| 120 | :group 'diary) | 120 | :group 'diary) |
| 121 | 121 | ||
| 122 | (defcustom diary-file-name-prefix-function 'identity | 122 | (defcustom diary-file-name-prefix-function #'identity |
| 123 | "The function that will take a diary file name and return the desired prefix." | 123 | "The function that will take a diary file name and return the desired prefix." |
| 124 | :type 'function | 124 | :type 'function |
| 125 | :group 'diary) | 125 | :group 'diary) |
| @@ -156,7 +156,7 @@ Used for example by the appointment package - see `appt-activate'." | |||
| 156 | :type 'hook | 156 | :type 'hook |
| 157 | :group 'diary) | 157 | :group 'diary) |
| 158 | 158 | ||
| 159 | (defcustom diary-display-function 'diary-fancy-display | 159 | (defcustom diary-display-function #'diary-fancy-display |
| 160 | "Function used to display the diary. | 160 | "Function used to display the diary. |
| 161 | The two standard options are `diary-fancy-display' and `diary-simple-display'. | 161 | The two standard options are `diary-fancy-display' and `diary-simple-display'. |
| 162 | 162 | ||
| @@ -185,9 +185,9 @@ diary buffer to be displayed with diary entries from various | |||
| 185 | included files, each day's entries sorted into lexicographic | 185 | included files, each day's entries sorted into lexicographic |
| 186 | order, add the following to your init file: | 186 | order, add the following to your init file: |
| 187 | 187 | ||
| 188 | (setq diary-display-function \\='diary-fancy-display) | 188 | (setq diary-display-function #\\='diary-fancy-display) |
| 189 | (add-hook \\='diary-list-entries-hook \\='diary-include-other-diary-files) | 189 | (add-hook \\='diary-list-entries-hook #\\='diary-include-other-diary-files) |
| 190 | (add-hook \\='diary-list-entries-hook \\='diary-sort-entries t) | 190 | (add-hook \\='diary-list-entries-hook #\\='diary-sort-entries t) |
| 191 | 191 | ||
| 192 | Note how the sort function is placed last, so that it can sort | 192 | Note how the sort function is placed last, so that it can sort |
| 193 | the entries included from other files. | 193 | the entries included from other files. |
| @@ -251,7 +251,7 @@ use `diary-mark-entries-hook', which runs only for the main diary file." | |||
| 251 | diary-islamic-mark-entries) | 251 | diary-islamic-mark-entries) |
| 252 | :group 'diary) | 252 | :group 'diary) |
| 253 | 253 | ||
| 254 | (defcustom diary-print-entries-hook 'lpr-buffer | 254 | (defcustom diary-print-entries-hook #'lpr-buffer |
| 255 | "Run by `diary-print-entries' after preparing a temporary diary buffer. | 255 | "Run by `diary-print-entries' after preparing a temporary diary buffer. |
| 256 | The buffer shows only the diary entries currently visible in the | 256 | The buffer shows only the diary entries currently visible in the |
| 257 | diary buffer. The default just does the printing. Other uses | 257 | diary buffer. The default just does the printing. Other uses |
| @@ -328,7 +328,8 @@ Returns a string using match elements 1-5, where: | |||
| 328 | ;; use the standard function calendar-date-string. | 328 | ;; use the standard function calendar-date-string. |
| 329 | (concat (if month | 329 | (concat (if month |
| 330 | (calendar-date-string (list month (string-to-number day) | 330 | (calendar-date-string (list month (string-to-number day) |
| 331 | (string-to-number year)) nil t) | 331 | (string-to-number year)) |
| 332 | nil t) | ||
| 332 | (cond ((eq calendar-date-style 'iso) "\\3 \\1 \\2") ; YMD | 333 | (cond ((eq calendar-date-style 'iso) "\\3 \\1 \\2") ; YMD |
| 333 | ((eq calendar-date-style 'european) "\\2 \\1 \\3") ; DMY | 334 | ((eq calendar-date-style 'european) "\\2 \\1 \\3") ; DMY |
| 334 | (t "\\1 \\2 \\3"))) ; MDY | 335 | (t "\\1 \\2 \\3"))) ; MDY |
| @@ -552,42 +553,40 @@ If ENTRY is a string, search for matches in that string, and remove them. | |||
| 552 | Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs. | 553 | Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs. |
| 553 | When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE) | 554 | When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE) |
| 554 | pairs." | 555 | pairs." |
| 555 | (let (regexp regnum attrname attrname attrvalue type ret-attr) | 556 | (let (ret-attr) |
| 556 | (if (null entry) | 557 | (if (null entry) |
| 557 | (save-excursion | 558 | (save-excursion |
| 558 | (dolist (attr diary-face-attrs) | 559 | (dolist (attr diary-face-attrs) |
| 559 | ;; FIXME inefficient searching. | 560 | ;; FIXME inefficient searching. |
| 560 | (goto-char (point-min)) | 561 | (goto-char (point-min)) |
| 561 | (setq regexp (concat diary-glob-file-regexp-prefix (car attr)) | 562 | (let* ((regexp (concat diary-glob-file-regexp-prefix (car attr))) |
| 562 | regnum (cadr attr) | 563 | (regnum (cadr attr)) |
| 563 | attrname (nth 2 attr) | 564 | (attrname (nth 2 attr)) |
| 564 | type (nth 3 attr) | 565 | (type (nth 3 attr)) |
| 565 | attrvalue (if (re-search-forward regexp nil t) | 566 | (attrvalue (if (re-search-forward regexp nil t) |
| 566 | (match-string-no-properties regnum))) | 567 | (match-string-no-properties regnum)))) |
| 567 | (and attrvalue | 568 | (and attrvalue |
| 568 | (setq attrvalue (diary-attrtype-convert attrvalue type)) | 569 | (setq attrvalue (diary-attrtype-convert attrvalue type)) |
| 569 | (setq ret-attr (append ret-attr | 570 | (setq ret-attr (append ret-attr |
| 570 | (list attrname attrvalue)))))) | 571 | (list attrname attrvalue))))))) |
| 571 | (setq ret-attr fileglobattrs) | 572 | (setq ret-attr fileglobattrs) |
| 572 | (dolist (attr diary-face-attrs) | 573 | (dolist (attr diary-face-attrs) |
| 573 | (setq regexp (car attr) | 574 | (let ((regexp (car attr)) |
| 574 | regnum (cadr attr) | 575 | (regnum (cadr attr)) |
| 575 | attrname (nth 2 attr) | 576 | (attrname (nth 2 attr)) |
| 576 | type (nth 3 attr) | 577 | (type (nth 3 attr)) |
| 577 | attrvalue nil) | 578 | (attrvalue nil)) |
| 578 | ;; If multiple matches, replace all, use the last (which may | 579 | ;; If multiple matches, replace all, use the last (which may |
| 579 | ;; be the first instance in the line, if the regexp is | 580 | ;; be the first instance in the line, if the regexp is |
| 580 | ;; anchored with $). | 581 | ;; anchored with $). |
| 581 | (while (string-match regexp entry) | 582 | (while (string-match regexp entry) |
| 582 | (setq attrvalue (match-string-no-properties regnum entry) | 583 | (setq attrvalue (match-string-no-properties regnum entry) |
| 583 | entry (replace-match "" t t entry))) | 584 | entry (replace-match "" t t entry))) |
| 584 | (and attrvalue | 585 | (and attrvalue |
| 585 | (setq attrvalue (diary-attrtype-convert attrvalue type)) | 586 | (setq attrvalue (diary-attrtype-convert attrvalue type)) |
| 586 | (setq ret-attr (append ret-attr (list attrname attrvalue)))))) | 587 | (setq ret-attr (append ret-attr (list attrname attrvalue))))))) |
| 587 | (list entry ret-attr))) | 588 | (list entry ret-attr))) |
| 588 | 589 | ||
| 589 | |||
| 590 | |||
| 591 | (defvar diary-modify-entry-list-string-function nil | 590 | (defvar diary-modify-entry-list-string-function nil |
| 592 | "Function applied to entry string before putting it into the entries list. | 591 | "Function applied to entry string before putting it into the entries list. |
| 593 | Can be used by programs integrating a diary list into other buffers (e.g. | 592 | Can be used by programs integrating a diary list into other buffers (e.g. |
| @@ -656,9 +655,12 @@ any entries were found." | |||
| 656 | (let* ((month (calendar-extract-month date)) | 655 | (let* ((month (calendar-extract-month date)) |
| 657 | (day (calendar-extract-day date)) | 656 | (day (calendar-extract-day date)) |
| 658 | (year (calendar-extract-year date)) | 657 | (year (calendar-extract-year date)) |
| 659 | (dayname (format "%s\\|%s\\.?" (calendar-day-name date) | ||
| 660 | (calendar-day-name date 'abbrev))) | ||
| 661 | (calendar-month-name-array (or months calendar-month-name-array)) | 658 | (calendar-month-name-array (or months calendar-month-name-array)) |
| 659 | (case-fold-search t) | ||
| 660 | entry-found) | ||
| 661 | (calendar-dlet* | ||
| 662 | ((dayname (format "%s\\|%s\\.?" (calendar-day-name date) | ||
| 663 | (calendar-day-name date 'abbrev))) | ||
| 662 | (monthname (format "\\*\\|%s%s" (calendar-month-name month) | 664 | (monthname (format "\\*\\|%s%s" (calendar-month-name month) |
| 663 | (if months "" | 665 | (if months "" |
| 664 | (format "\\|%s\\.?" | 666 | (format "\\|%s\\.?" |
| @@ -668,61 +670,60 @@ any entries were found." | |||
| 668 | (year (format "\\*\\|0*%d%s" year | 670 | (year (format "\\*\\|0*%d%s" year |
| 669 | (if diary-abbreviated-year-flag | 671 | (if diary-abbreviated-year-flag |
| 670 | (format "\\|%02d" (% year 100)) | 672 | (format "\\|%02d" (% year 100)) |
| 671 | ""))) | 673 | "")))) |
| 672 | (case-fold-search t) | 674 | (dolist (date-form diary-date-forms) |
| 673 | entry-found) | 675 | (let ((backup (when (eq (car date-form) 'backup) |
| 674 | (dolist (date-form diary-date-forms) | 676 | (setq date-form (cdr date-form)) |
| 675 | (let ((backup (when (eq (car date-form) 'backup) | 677 | t)) |
| 676 | (setq date-form (cdr date-form)) | 678 | ;; date-form uses day etc as set above. |
| 677 | t)) | 679 | (regexp (format "^%s?%s\\(%s\\)" (regexp-quote mark) |
| 678 | ;; date-form uses day etc as set above. | 680 | (if symbol (regexp-quote symbol) "") |
| 679 | (regexp (format "^%s?%s\\(%s\\)" (regexp-quote mark) | 681 | (mapconcat #'eval date-form "\\)\\(?:"))) |
| 680 | (if symbol (regexp-quote symbol) "") | 682 | entry-start date-start temp) |
| 681 | (mapconcat 'eval date-form "\\)\\(?:"))) | 683 | (goto-char (point-min)) |
| 682 | entry-start date-start temp) | 684 | (while (re-search-forward regexp nil t) |
| 683 | (goto-char (point-min)) | 685 | (if backup (re-search-backward "\\<" nil t)) |
| 684 | (while (re-search-forward regexp nil t) | 686 | ;; regexp moves us past the end of date, onto the next line. |
| 685 | (if backup (re-search-backward "\\<" nil t)) | 687 | ;; Trailing whitespace after date not allowed (see diary-file). |
| 686 | ;; regexp moves us past the end of date, onto the next line. | 688 | (if (and (bolp) (not (looking-at "[ \t]"))) |
| 687 | ;; Trailing whitespace after date not allowed (see diary-file). | 689 | ;; Diary entry that consists only of date. |
| 688 | (if (and (bolp) (not (looking-at "[ \t]"))) | 690 | (backward-char 1) |
| 689 | ;; Diary entry that consists only of date. | 691 | ;; Found a nonempty diary entry--make it |
| 690 | (backward-char 1) | 692 | ;; visible and add it to the list. |
| 691 | ;; Found a nonempty diary entry--make it | 693 | (setq date-start (line-end-position 0)) |
| 692 | ;; visible and add it to the list. | 694 | ;; Actual entry starts on the next-line? |
| 693 | (setq date-start (line-end-position 0)) | 695 | (if (looking-at "[ \t]*\n[ \t]") (forward-line 1)) |
| 694 | ;; Actual entry starts on the next-line? | 696 | (setq entry-found t |
| 695 | (if (looking-at "[ \t]*\n[ \t]") (forward-line 1)) | 697 | entry-start (point)) |
| 696 | (setq entry-found t | 698 | (forward-line 1) |
| 697 | entry-start (point)) | 699 | (while (looking-at "[ \t]") ; continued entry |
| 698 | (forward-line 1) | 700 | (forward-line 1)) |
| 699 | (while (looking-at "[ \t]") ; continued entry | 701 | (unless (and (eobp) (not (bolp))) |
| 700 | (forward-line 1)) | 702 | (backward-char 1)) |
| 701 | (unless (and (eobp) (not (bolp))) | 703 | (unless list-only |
| 702 | (backward-char 1)) | 704 | (remove-overlays date-start (point) 'invisible 'diary)) |
| 703 | (unless list-only | 705 | (setq temp (diary-pull-attrs |
| 704 | (remove-overlays date-start (point) 'invisible 'diary)) | 706 | (buffer-substring-no-properties |
| 705 | (setq temp (diary-pull-attrs | 707 | entry-start (point)) |
| 706 | (buffer-substring-no-properties | 708 | globattr)) |
| 707 | entry-start (point)) globattr)) | 709 | (diary-add-to-list |
| 708 | (diary-add-to-list | 710 | (or gdate date) (car temp) |
| 709 | (or gdate date) (car temp) | 711 | (buffer-substring-no-properties |
| 710 | (buffer-substring-no-properties (1+ date-start) (1- entry-start)) | 712 | (1+ date-start) (1- entry-start)) |
| 711 | (copy-marker entry-start) (cadr temp)))))) | 713 | (copy-marker entry-start) (cadr temp)))))) |
| 712 | entry-found)) | 714 | entry-found))) |
| 713 | 715 | ||
| 714 | (defvar original-date) ; from diary-list-entries | 716 | (defvar original-date) ; from diary-list-entries |
| 715 | (defvar file-glob-attrs) | 717 | (defvar file-glob-attrs) |
| 716 | (defvar list-only) | ||
| 717 | (defvar number) | ||
| 718 | 718 | ||
| 719 | (defun diary-list-entries-1 (months symbol absfunc) | 719 | (defun diary-list-entries-1 (months symbol absfunc) |
| 720 | "List diary entries of a certain type. | 720 | "List diary entries of a certain type. |
| 721 | MONTHS is an array of month names. SYMBOL marks diary entries of the type | 721 | MONTHS is an array of month names. SYMBOL marks diary entries of the type |
| 722 | in question. ABSFUNC is a function that converts absolute dates to dates | 722 | in question. ABSFUNC is a function that converts absolute dates to dates |
| 723 | of the appropriate type." | 723 | of the appropriate type." |
| 724 | (with-no-warnings (defvar number) (defvar list-only)) | ||
| 724 | (let ((gdate original-date)) | 725 | (let ((gdate original-date)) |
| 725 | (dotimes (_idummy number) | 726 | (dotimes (_ number) |
| 726 | (diary-list-entries-2 | 727 | (diary-list-entries-2 |
| 727 | (funcall absfunc (calendar-absolute-from-gregorian gdate)) | 728 | (funcall absfunc (calendar-absolute-from-gregorian gdate)) |
| 728 | diary-nonmarking-symbol file-glob-attrs list-only months symbol gdate) | 729 | diary-nonmarking-symbol file-glob-attrs list-only months symbol gdate) |
| @@ -735,6 +736,10 @@ of the appropriate type." | |||
| 735 | "List of any diary files included in the last call to `diary-list-entries'. | 736 | "List of any diary files included in the last call to `diary-list-entries'. |
| 736 | Or to `diary-mark-entries'.") | 737 | Or to `diary-mark-entries'.") |
| 737 | 738 | ||
| 739 | (defvar diary-saved-point) ; bound in diary-list-entries | ||
| 740 | (defvar diary-including) | ||
| 741 | (defvar date-string) ; bound in diary-list-entries | ||
| 742 | |||
| 738 | (defun diary-list-entries (date number &optional list-only) | 743 | (defun diary-list-entries (date number &optional list-only) |
| 739 | "Create and display a buffer containing the relevant lines in `diary-file'. | 744 | "Create and display a buffer containing the relevant lines in `diary-file'. |
| 740 | Selects entries for NUMBER days starting with date DATE. Hides any | 745 | Selects entries for NUMBER days starting with date DATE. Hides any |
| @@ -832,7 +837,7 @@ LIST-ONLY is non-nil, in which case it just returns the list." | |||
| 832 | (set (make-local-variable 'diary-selective-display) t) | 837 | (set (make-local-variable 'diary-selective-display) t) |
| 833 | (overlay-put ol 'invisible 'diary) | 838 | (overlay-put ol 'invisible 'diary) |
| 834 | (overlay-put ol 'evaporate t))) | 839 | (overlay-put ol 'evaporate t))) |
| 835 | (dotimes (_idummy number) | 840 | (dotimes (_ number) |
| 836 | (let ((sexp-found (diary-list-sexp-entries date)) | 841 | (let ((sexp-found (diary-list-sexp-entries date)) |
| 837 | (entry-found (diary-list-entries-2 | 842 | (entry-found (diary-list-entries-2 |
| 838 | date diary-nonmarking-symbol | 843 | date diary-nonmarking-symbol |
| @@ -848,8 +853,10 @@ LIST-ONLY is non-nil, in which case it just returns the list." | |||
| 848 | ;; every time, diary-include-other-diary-files | 853 | ;; every time, diary-include-other-diary-files |
| 849 | ;; binds it to nil (essentially) when it runs | 854 | ;; binds it to nil (essentially) when it runs |
| 850 | ;; in included files. | 855 | ;; in included files. |
| 851 | (run-hooks 'diary-nongregorian-listing-hook | 856 | (calendar-dlet* ((number number) |
| 852 | 'diary-list-entries-hook) | 857 | (list-only list-only)) |
| 858 | (run-hooks 'diary-nongregorian-listing-hook | ||
| 859 | 'diary-list-entries-hook)) | ||
| 853 | ;; We could make this explicit: | 860 | ;; We could make this explicit: |
| 854 | ;;; (run-hooks 'diary-nongregorian-listing-hook) | 861 | ;;; (run-hooks 'diary-nongregorian-listing-hook) |
| 855 | ;;; (if d-incp | 862 | ;;; (if d-incp |
| @@ -878,8 +885,6 @@ LIST-ONLY is non-nil, in which case it just returns the list." | |||
| 878 | (remove-overlays (point-min) (point-max) 'invisible 'diary)) | 885 | (remove-overlays (point-min) (point-max) 'invisible 'diary)) |
| 879 | (kill-local-variable 'mode-line-format)) | 886 | (kill-local-variable 'mode-line-format)) |
| 880 | 887 | ||
| 881 | (defvar original-date) ; bound in diary-list-entries | ||
| 882 | ;(defvar number) ; already declared above | ||
| 883 | 888 | ||
| 884 | (defun diary-include-files (&optional mark) | 889 | (defun diary-include-files (&optional mark) |
| 885 | "Process diary entries from included diary files. | 890 | "Process diary entries from included diary files. |
| @@ -894,8 +899,8 @@ This is recursive; that is, included files may include other files." | |||
| 894 | (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string)) | 899 | (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string)) |
| 895 | nil t) | 900 | nil t) |
| 896 | (let ((diary-file (match-string-no-properties 1)) | 901 | (let ((diary-file (match-string-no-properties 1)) |
| 897 | (diary-mark-entries-hook 'diary-mark-included-diary-files) | 902 | (diary-mark-entries-hook #'diary-mark-included-diary-files) |
| 898 | (diary-list-entries-hook 'diary-include-other-diary-files) | 903 | (diary-list-entries-hook #'diary-include-other-diary-files) |
| 899 | (diary-including t) | 904 | (diary-including t) |
| 900 | diary-hook diary-list-include-blanks efile) | 905 | diary-hook diary-list-include-blanks efile) |
| 901 | (if (file-exists-p diary-file) | 906 | (if (file-exists-p diary-file) |
| @@ -907,6 +912,13 @@ This is recursive; that is, included files may include other files." | |||
| 907 | (append diary-included-files (list efile))) | 912 | (append diary-included-files (list efile))) |
| 908 | (if mark | 913 | (if mark |
| 909 | (diary-mark-entries) | 914 | (diary-mark-entries) |
| 915 | ;; FIXME: `diary-include-files' can be run from | ||
| 916 | ;; diary-mark-entries-hook (via | ||
| 917 | ;; diary-mark-included-diary-files) or from | ||
| 918 | ;; diary-list-entries-hook (via | ||
| 919 | ;; diary-include-other-diary-files). In the "list" case, | ||
| 920 | ;; `number' is dynamically bound, but not in the "mark" case! | ||
| 921 | (with-no-warnings (defvar number)) | ||
| 910 | (setq diary-entries-list | 922 | (setq diary-entries-list |
| 911 | (append diary-entries-list | 923 | (append diary-entries-list |
| 912 | (diary-list-entries original-date number t))))) | 924 | (diary-list-entries original-date number t))))) |
| @@ -929,8 +941,6 @@ For details, see `diary-include-files'. | |||
| 929 | See also `diary-mark-included-diary-files'." | 941 | See also `diary-mark-included-diary-files'." |
| 930 | (diary-include-files)) | 942 | (diary-include-files)) |
| 931 | 943 | ||
| 932 | (defvar date-string) ; bound in diary-list-entries | ||
| 933 | |||
| 934 | (defun diary-display-no-entries () | 944 | (defun diary-display-no-entries () |
| 935 | "Common subroutine of `diary-simple-display' and `diary-fancy-display'. | 945 | "Common subroutine of `diary-simple-display' and `diary-fancy-display'. |
| 936 | Handles the case where there are no diary entries. | 946 | Handles the case where there are no diary entries. |
| @@ -940,7 +950,7 @@ Returns a cons (NOENTRIES . HOLIDAY-STRING)." | |||
| 940 | (hol-string (format "%s%s%s" | 950 | (hol-string (format "%s%s%s" |
| 941 | date-string | 951 | date-string |
| 942 | (if holiday-list ": " "") | 952 | (if holiday-list ": " "") |
| 943 | (mapconcat 'identity holiday-list "; "))) | 953 | (mapconcat #'identity holiday-list "; "))) |
| 944 | (msg (format "No diary entries for %s" hol-string)) | 954 | (msg (format "No diary entries for %s" hol-string)) |
| 945 | ;; Empty list, or single item with no text. | 955 | ;; Empty list, or single item with no text. |
| 946 | ;; FIXME multiple items with no text? | 956 | ;; FIXME multiple items with no text? |
| @@ -957,13 +967,11 @@ Returns a cons (NOENTRIES . HOLIDAY-STRING)." | |||
| 957 | ;; holiday-list which is too wide for a message gets a buffer. | 967 | ;; holiday-list which is too wide for a message gets a buffer. |
| 958 | (calendar-in-read-only-buffer holiday-buffer | 968 | (calendar-in-read-only-buffer holiday-buffer |
| 959 | (calendar-set-mode-line (format "Holidays for %s" date-string)) | 969 | (calendar-set-mode-line (format "Holidays for %s" date-string)) |
| 960 | (insert (mapconcat 'identity holiday-list "\n"))) | 970 | (insert (mapconcat #'identity holiday-list "\n"))) |
| 961 | (message "No diary entries for %s" date-string))) | 971 | (message "No diary entries for %s" date-string))) |
| 962 | (cons noentries hol-string))) | 972 | (cons noentries hol-string))) |
| 963 | 973 | ||
| 964 | 974 | ||
| 965 | (defvar diary-saved-point) ; bound in diary-list-entries | ||
| 966 | |||
| 967 | (defun diary-simple-display () | 975 | (defun diary-simple-display () |
| 968 | "Display the diary buffer if there are any relevant entries or holidays. | 976 | "Display the diary buffer if there are any relevant entries or holidays. |
| 969 | Entries that do not apply are made invisible. Holidays are shown | 977 | Entries that do not apply are made invisible. Holidays are shown |
| @@ -987,7 +995,7 @@ in the mode line. This is an option for `diary-display-function'." | |||
| 987 | (set-window-point window diary-saved-point) | 995 | (set-window-point window diary-saved-point) |
| 988 | (set-window-start window (point-min))))))) | 996 | (set-window-start window (point-min))))))) |
| 989 | 997 | ||
| 990 | (defvar diary-goto-entry-function 'diary-goto-entry | 998 | (defvar diary-goto-entry-function #'diary-goto-entry |
| 991 | "Function called to jump to a diary entry. | 999 | "Function called to jump to a diary entry. |
| 992 | Modes that require special handling of the included file | 1000 | Modes that require special handling of the included file |
| 993 | containing the diary entry can assign a suitable function to this | 1001 | containing the diary entry can assign a suitable function to this |
| @@ -1022,6 +1030,9 @@ variable.") | |||
| 1022 | (goto-char (match-beginning 1))))) | 1030 | (goto-char (match-beginning 1))))) |
| 1023 | (message "Unable to locate this diary entry"))))) | 1031 | (message "Unable to locate this diary entry"))))) |
| 1024 | 1032 | ||
| 1033 | (defvar displayed-year) ; bound in calendar-generate | ||
| 1034 | (defvar displayed-month) | ||
| 1035 | |||
| 1025 | (defun diary-fancy-display () | 1036 | (defun diary-fancy-display () |
| 1026 | "Prepare a diary buffer with relevant entries in a fancy, noneditable form. | 1037 | "Prepare a diary buffer with relevant entries in a fancy, noneditable form. |
| 1027 | Holidays are shown unless `diary-show-holidays-flag' is nil. | 1038 | Holidays are shown unless `diary-show-holidays-flag' is nil. |
| @@ -1204,7 +1215,7 @@ ensure that all relevant variables are set. | |||
| 1204 | (interactive "P") | 1215 | (interactive "P") |
| 1205 | (if (string-equal diary-mail-addr "") | 1216 | (if (string-equal diary-mail-addr "") |
| 1206 | (user-error "You must set `diary-mail-addr' to use this command") | 1217 | (user-error "You must set `diary-mail-addr' to use this command") |
| 1207 | (let ((diary-display-function 'diary-fancy-display)) | 1218 | (let ((diary-display-function #'diary-fancy-display)) |
| 1208 | (diary-list-entries (calendar-current-date) (or ndays diary-mail-days))) | 1219 | (diary-list-entries (calendar-current-date) (or ndays diary-mail-days))) |
| 1209 | (compose-mail diary-mail-addr | 1220 | (compose-mail diary-mail-addr |
| 1210 | (concat "Diary entries generated " | 1221 | (concat "Diary entries generated " |
| @@ -1242,109 +1253,111 @@ MARKFUNC is a function that marks entries of the appropriate type | |||
| 1242 | matching a given date pattern. MONTHS is an array of month names. | 1253 | matching a given date pattern. MONTHS is an array of month names. |
| 1243 | SYMBOL marks diary entries of the type in question. ABSFUNC is a | 1254 | SYMBOL marks diary entries of the type in question. ABSFUNC is a |
| 1244 | function that converts absolute dates to dates of the appropriate type. " | 1255 | function that converts absolute dates to dates of the appropriate type. " |
| 1245 | (let ((dayname (diary-name-pattern calendar-day-name-array | 1256 | (calendar-dlet* |
| 1246 | calendar-day-abbrev-array)) | 1257 | ((dayname (diary-name-pattern calendar-day-name-array |
| 1247 | (monthname (format "%s\\|\\*" | 1258 | calendar-day-abbrev-array)) |
| 1248 | (if months | 1259 | (monthname (format "%s\\|\\*" |
| 1249 | (diary-name-pattern months) | 1260 | (if months |
| 1250 | (diary-name-pattern calendar-month-name-array | 1261 | (diary-name-pattern months) |
| 1251 | calendar-month-abbrev-array)))) | 1262 | (diary-name-pattern calendar-month-name-array |
| 1252 | (month "[0-9]+\\|\\*") | 1263 | calendar-month-abbrev-array)))) |
| 1253 | (day "[0-9]+\\|\\*") | 1264 | (month "[0-9]+\\|\\*") |
| 1254 | (year "[0-9]+\\|\\*") | 1265 | (day "[0-9]+\\|\\*") |
| 1255 | (case-fold-search t) | 1266 | (year "[0-9]+\\|\\*")) |
| 1256 | marks) | 1267 | (let* ((case-fold-search t) |
| 1257 | (dolist (date-form diary-date-forms) | 1268 | marks) |
| 1258 | (if (eq (car date-form) 'backup) ; ignore 'backup directive | 1269 | (dolist (date-form diary-date-forms) |
| 1259 | (setq date-form (cdr date-form))) | 1270 | (if (eq (car date-form) 'backup) ; ignore 'backup directive |
| 1260 | (let* ((l (length date-form)) | 1271 | (setq date-form (cdr date-form))) |
| 1261 | (d-name-pos (- l (length (memq 'dayname date-form)))) | 1272 | (let* ((l (length date-form)) |
| 1262 | (d-name-pos (if (/= l d-name-pos) (1+ d-name-pos))) | 1273 | (d-name-pos (- l (length (memq 'dayname date-form)))) |
| 1263 | (m-name-pos (- l (length (memq 'monthname date-form)))) | 1274 | (d-name-pos (if (/= l d-name-pos) (1+ d-name-pos))) |
| 1264 | (m-name-pos (if (/= l m-name-pos) (1+ m-name-pos))) | 1275 | (m-name-pos (- l (length (memq 'monthname date-form)))) |
| 1265 | (d-pos (- l (length (memq 'day date-form)))) | 1276 | (m-name-pos (if (/= l m-name-pos) (1+ m-name-pos))) |
| 1266 | (d-pos (if (/= l d-pos) (1+ d-pos))) | 1277 | (d-pos (- l (length (memq 'day date-form)))) |
| 1267 | (m-pos (- l (length (memq 'month date-form)))) | 1278 | (d-pos (if (/= l d-pos) (1+ d-pos))) |
| 1268 | (m-pos (if (/= l m-pos) (1+ m-pos))) | 1279 | (m-pos (- l (length (memq 'month date-form)))) |
| 1269 | (y-pos (- l (length (memq 'year date-form)))) | 1280 | (m-pos (if (/= l m-pos) (1+ m-pos))) |
| 1270 | (y-pos (if (/= l y-pos) (1+ y-pos))) | 1281 | (y-pos (- l (length (memq 'year date-form)))) |
| 1271 | (regexp (format "^%s\\(%s\\)" | 1282 | (y-pos (if (/= l y-pos) (1+ y-pos))) |
| 1272 | (if symbol (regexp-quote symbol) "") | 1283 | (regexp (format "^%s\\(%s\\)" |
| 1273 | (mapconcat 'eval date-form "\\)\\(")))) | 1284 | (if symbol (regexp-quote symbol) "") |
| 1274 | (goto-char (point-min)) | 1285 | (mapconcat #'eval date-form "\\)\\(")))) |
| 1275 | (while (re-search-forward regexp nil t) | 1286 | (goto-char (point-min)) |
| 1276 | (let* ((dd-name | 1287 | (while (re-search-forward regexp nil t) |
| 1277 | (if d-name-pos | 1288 | (let* ((dd-name |
| 1278 | (match-string-no-properties d-name-pos))) | 1289 | (if d-name-pos |
| 1279 | (mm-name | 1290 | (match-string-no-properties d-name-pos))) |
| 1280 | (if m-name-pos | 1291 | (mm-name |
| 1281 | (match-string-no-properties m-name-pos))) | 1292 | (if m-name-pos |
| 1282 | (mm (string-to-number | 1293 | (match-string-no-properties m-name-pos))) |
| 1283 | (if m-pos | 1294 | (mm (string-to-number |
| 1284 | (match-string-no-properties m-pos) | 1295 | (if m-pos |
| 1285 | ""))) | 1296 | (match-string-no-properties m-pos) |
| 1286 | (dd (string-to-number | 1297 | ""))) |
| 1287 | (if d-pos | 1298 | (dd (string-to-number |
| 1288 | (match-string-no-properties d-pos) | 1299 | (if d-pos |
| 1289 | ""))) | 1300 | (match-string-no-properties d-pos) |
| 1290 | (y-str (if y-pos | 1301 | ""))) |
| 1291 | (match-string-no-properties y-pos))) | 1302 | (y-str (if y-pos |
| 1292 | (yy (if (not y-str) | 1303 | (match-string-no-properties y-pos))) |
| 1293 | 0 | 1304 | (yy (if (not y-str) |
| 1294 | (if (and (= (length y-str) 2) | 1305 | 0 |
| 1295 | diary-abbreviated-year-flag) | 1306 | (if (and (= (length y-str) 2) |
| 1296 | (let* ((current-y | 1307 | diary-abbreviated-year-flag) |
| 1297 | (calendar-extract-year | 1308 | (let* ((current-y |
| 1298 | (if absfunc | 1309 | (calendar-extract-year |
| 1299 | (funcall | 1310 | (if absfunc |
| 1300 | absfunc | 1311 | (funcall |
| 1301 | (calendar-absolute-from-gregorian | 1312 | absfunc |
| 1302 | (calendar-current-date))) | 1313 | (calendar-absolute-from-gregorian |
| 1303 | (calendar-current-date)))) | 1314 | (calendar-current-date))) |
| 1304 | (y (+ (string-to-number y-str) | 1315 | (calendar-current-date)))) |
| 1305 | ;; Current century, eg 2000. | 1316 | (y (+ (string-to-number y-str) |
| 1306 | (* 100 (/ current-y 100)))) | 1317 | ;; Current century, eg 2000. |
| 1307 | (offset (- y current-y))) | 1318 | (* 100 (/ current-y 100)))) |
| 1308 | ;; Add 2-digit year to current century. | 1319 | (offset (- y current-y))) |
| 1309 | ;; If more than 50 years in the future, | 1320 | ;; Add 2-digit year to current century. |
| 1310 | ;; assume last century. If more than 50 | 1321 | ;; If more than 50 years in the future, |
| 1311 | ;; years in the past, assume next century. | 1322 | ;; assume last century. If more than 50 |
| 1312 | (if (> offset 50) | 1323 | ;; years in the past, assume next century. |
| 1313 | (- y 100) | 1324 | (if (> offset 50) |
| 1314 | (if (< offset -50) | 1325 | (- y 100) |
| 1315 | (+ y 100) | 1326 | (if (< offset -50) |
| 1316 | y))) | 1327 | (+ y 100) |
| 1317 | (string-to-number y-str))))) | 1328 | y))) |
| 1318 | (setq marks (cadr (diary-pull-attrs | 1329 | (string-to-number y-str))))) |
| 1319 | (buffer-substring-no-properties | 1330 | (setq marks (cadr (diary-pull-attrs |
| 1320 | (point) (line-end-position)) | 1331 | (buffer-substring-no-properties |
| 1321 | file-glob-attrs))) | 1332 | (point) (line-end-position)) |
| 1322 | ;; Only mark all days of a given name if the pattern | 1333 | file-glob-attrs))) |
| 1323 | ;; contains no more specific elements. | 1334 | ;; Only mark all days of a given name if the pattern |
| 1324 | (if (and dd-name (not (or d-pos m-pos y-pos))) | 1335 | ;; contains no more specific elements. |
| 1325 | (calendar-mark-days-named | 1336 | (if (and dd-name (not (or d-pos m-pos y-pos))) |
| 1326 | (cdr (assoc-string dd-name | 1337 | (calendar-mark-days-named |
| 1338 | (cdr (assoc-string dd-name | ||
| 1339 | (calendar-make-alist | ||
| 1340 | calendar-day-name-array | ||
| 1341 | 0 nil calendar-day-abbrev-array | ||
| 1342 | (mapcar (lambda (e) | ||
| 1343 | (format "%s." e)) | ||
| 1344 | calendar-day-abbrev-array)) | ||
| 1345 | t)) | ||
| 1346 | marks) | ||
| 1347 | (if mm-name | ||
| 1348 | (setq mm | ||
| 1349 | (if (string-equal mm-name "*") 0 | ||
| 1350 | (cdr (assoc-string | ||
| 1351 | mm-name | ||
| 1352 | (if months (calendar-make-alist months) | ||
| 1327 | (calendar-make-alist | 1353 | (calendar-make-alist |
| 1328 | calendar-day-name-array | 1354 | calendar-month-name-array |
| 1329 | 0 nil calendar-day-abbrev-array | 1355 | 1 nil calendar-month-abbrev-array |
| 1330 | (mapcar (lambda (e) | 1356 | (mapcar (lambda (e) |
| 1331 | (format "%s." e)) | 1357 | (format "%s." e)) |
| 1332 | calendar-day-abbrev-array)) | 1358 | calendar-month-abbrev-array))) |
| 1333 | t)) marks) | 1359 | t))))) |
| 1334 | (if mm-name | 1360 | (funcall markfunc mm dd yy marks))))))))) |
| 1335 | (setq mm | ||
| 1336 | (if (string-equal mm-name "*") 0 | ||
| 1337 | (cdr (assoc-string | ||
| 1338 | mm-name | ||
| 1339 | (if months (calendar-make-alist months) | ||
| 1340 | (calendar-make-alist | ||
| 1341 | calendar-month-name-array | ||
| 1342 | 1 nil calendar-month-abbrev-array | ||
| 1343 | (mapcar (lambda (e) | ||
| 1344 | (format "%s." e)) | ||
| 1345 | calendar-month-abbrev-array))) | ||
| 1346 | t))))) | ||
| 1347 | (funcall markfunc mm dd yy marks)))))))) | ||
| 1348 | 1361 | ||
| 1349 | ;;;###cal-autoload | 1362 | ;;;###cal-autoload |
| 1350 | (defun diary-mark-entries (&optional redraw) | 1363 | (defun diary-mark-entries (&optional redraw) |
| @@ -1406,30 +1419,30 @@ marks. This is intended to deal with deleted diary entries." | |||
| 1406 | 1419 | ||
| 1407 | (defun diary-sexp-entry (sexp entry date) | 1420 | (defun diary-sexp-entry (sexp entry date) |
| 1408 | "Process a SEXP diary ENTRY for DATE." | 1421 | "Process a SEXP diary ENTRY for DATE." |
| 1409 | (let ((result (if calendar-debug-sexp | 1422 | (let ((result |
| 1410 | (let ((debug-on-error t)) | 1423 | (calendar-dlet* ((date date) |
| 1411 | (eval (car (read-from-string sexp)))) | 1424 | (entry entry)) |
| 1412 | (let (err) | 1425 | (if calendar-debug-sexp |
| 1413 | (condition-case err | 1426 | (let ((debug-on-error t)) |
| 1414 | (eval (car (read-from-string sexp))) | 1427 | (eval (car (read-from-string sexp)))) |
| 1415 | (error | 1428 | (condition-case err |
| 1416 | (display-warning | 1429 | (eval (car (read-from-string sexp))) |
| 1417 | 'diary | 1430 | (error |
| 1418 | (format "Bad diary sexp at line %d in %s:\n%s\n\ | 1431 | (display-warning |
| 1419 | Error: %s\n" | 1432 | 'diary |
| 1420 | (count-lines (point-min) (point)) | 1433 | (format "Bad diary sexp at line %d in %s:\n%s\n\ |
| 1421 | diary-file sexp err) | 1434 | Error: %S\n" |
| 1422 | :error) | 1435 | (count-lines (point-min) (point)) |
| 1423 | nil)))))) | 1436 | diary-file sexp err) |
| 1437 | :error) | ||
| 1438 | nil)))))) | ||
| 1424 | (cond ((stringp result) result) | 1439 | (cond ((stringp result) result) |
| 1425 | ((and (consp result) | 1440 | ((and (consp result) |
| 1426 | (stringp (cdr result))) result) | 1441 | (stringp (cdr result))) |
| 1442 | result) | ||
| 1427 | (result entry) | 1443 | (result entry) |
| 1428 | (t nil)))) | 1444 | (t nil)))) |
| 1429 | 1445 | ||
| 1430 | (defvar displayed-year) ; bound in calendar-generate | ||
| 1431 | (defvar displayed-month) | ||
| 1432 | |||
| 1433 | (defun diary-mark-sexp-entries () | 1446 | (defun diary-mark-sexp-entries () |
| 1434 | "Mark days in the calendar window that have sexp diary entries. | 1447 | "Mark days in the calendar window that have sexp diary entries. |
| 1435 | Each entry in the diary file (or included files) visible in the calendar window | 1448 | Each entry in the diary file (or included files) visible in the calendar window |
| @@ -1532,7 +1545,7 @@ passed to `calendar-mark-visible-date' as MARK." | |||
| 1532 | (let ((m displayed-month) | 1545 | (let ((m displayed-month) |
| 1533 | (y displayed-year)) | 1546 | (y displayed-year)) |
| 1534 | (calendar-increment-month m y -1) | 1547 | (calendar-increment-month m y -1) |
| 1535 | (dotimes (_idummy 3) | 1548 | (dotimes (_ 3) |
| 1536 | (calendar-mark-month m y month day year color) | 1549 | (calendar-mark-month m y month day year color) |
| 1537 | (calendar-increment-month m y 1))))) | 1550 | (calendar-increment-month m y 1))))) |
| 1538 | 1551 | ||
| @@ -1814,9 +1827,6 @@ form used internally by the calendar and diary." | |||
| 1814 | 1827 | ||
| 1815 | ;;; Sexp diary functions. | 1828 | ;;; Sexp diary functions. |
| 1816 | 1829 | ||
| 1817 | (defvar date) | ||
| 1818 | (defvar entry) | ||
| 1819 | |||
| 1820 | ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. | 1830 | ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. |
| 1821 | (defun diary-date (month day year &optional mark) | 1831 | (defun diary-date (month day year &optional mark) |
| 1822 | "Specific date(s) diary entry. | 1832 | "Specific date(s) diary entry. |
| @@ -1827,6 +1837,7 @@ of the input parameters changes according to `calendar-date-style' | |||
| 1827 | 1837 | ||
| 1828 | An optional parameter MARK specifies a face or single-character string | 1838 | An optional parameter MARK specifies a face or single-character string |
| 1829 | to use when highlighting the day in the calendar." | 1839 | to use when highlighting the day in the calendar." |
| 1840 | (with-no-warnings (defvar date) (defvar entry)) | ||
| 1830 | (let* ((ddate (diary-make-date month day year)) | 1841 | (let* ((ddate (diary-make-date month day year)) |
| 1831 | (dd (calendar-extract-day ddate)) | 1842 | (dd (calendar-extract-day ddate)) |
| 1832 | (mm (calendar-extract-month ddate)) | 1843 | (mm (calendar-extract-month ddate)) |
| @@ -1855,6 +1866,7 @@ of the input parameters changes according to `calendar-date-style' | |||
| 1855 | 1866 | ||
| 1856 | An optional parameter MARK specifies a face or single-character string | 1867 | An optional parameter MARK specifies a face or single-character string |
| 1857 | to use when highlighting the day in the calendar." | 1868 | to use when highlighting the day in the calendar." |
| 1869 | (with-no-warnings (defvar date) (defvar entry)) | ||
| 1858 | (let ((date1 (calendar-absolute-from-gregorian | 1870 | (let ((date1 (calendar-absolute-from-gregorian |
| 1859 | (diary-make-date m1 d1 y1))) | 1871 | (diary-make-date m1 d1 y1))) |
| 1860 | (date2 (calendar-absolute-from-gregorian | 1872 | (date2 (calendar-absolute-from-gregorian |
| @@ -1873,6 +1885,7 @@ DAY defaults to 1 if N>0, and MONTH's last day otherwise. | |||
| 1873 | MONTH can be a list of months, an integer, or t (meaning all months). | 1885 | MONTH can be a list of months, an integer, or t (meaning all months). |
| 1874 | Optional MARK specifies a face or single-character string to use when | 1886 | Optional MARK specifies a face or single-character string to use when |
| 1875 | highlighting the day in the calendar." | 1887 | highlighting the day in the calendar." |
| 1888 | (with-no-warnings (defvar date) (defvar entry)) | ||
| 1876 | ;; This is messy because the diary entry may apply, but the date on which it | 1889 | ;; This is messy because the diary entry may apply, but the date on which it |
| 1877 | ;; is based can be in a different month/year. For example, asking for the | 1890 | ;; is based can be in a different month/year. For example, asking for the |
| 1878 | ;; first Monday after December 30. For large values of |n| the problem is | 1891 | ;; first Monday after December 30. For large values of |n| the problem is |
| @@ -1951,6 +1964,7 @@ is considered to be March 1 in non-leap years. | |||
| 1951 | 1964 | ||
| 1952 | An optional parameter MARK specifies a face or single-character | 1965 | An optional parameter MARK specifies a face or single-character |
| 1953 | string to use when highlighting the day in the calendar." | 1966 | string to use when highlighting the day in the calendar." |
| 1967 | (with-no-warnings (defvar date) (defvar entry)) | ||
| 1954 | (let* ((ddate (diary-make-date month day year)) | 1968 | (let* ((ddate (diary-make-date month day year)) |
| 1955 | (dd (calendar-extract-day ddate)) | 1969 | (dd (calendar-extract-day ddate)) |
| 1956 | (mm (calendar-extract-month ddate)) | 1970 | (mm (calendar-extract-month ddate)) |
| @@ -1975,6 +1989,7 @@ and %s by the ordinal ending of that number (that is, `st', `nd', | |||
| 1975 | 1989 | ||
| 1976 | An optional parameter MARK specifies a face or single-character | 1990 | An optional parameter MARK specifies a face or single-character |
| 1977 | string to use when highlighting the day in the calendar." | 1991 | string to use when highlighting the day in the calendar." |
| 1992 | (with-no-warnings (defvar date) (defvar entry)) | ||
| 1978 | (or (> n 0) | 1993 | (or (> n 0) |
| 1979 | (user-error "Day count must be positive")) | 1994 | (user-error "Day count must be positive")) |
| 1980 | (let* ((diff (- (calendar-absolute-from-gregorian date) | 1995 | (let* ((diff (- (calendar-absolute-from-gregorian date) |
| @@ -1986,6 +2001,7 @@ string to use when highlighting the day in the calendar." | |||
| 1986 | 2001 | ||
| 1987 | (defun diary-day-of-year () | 2002 | (defun diary-day-of-year () |
| 1988 | "Day of year and number of days remaining in the year of date diary entry." | 2003 | "Day of year and number of days remaining in the year of date diary entry." |
| 2004 | (with-no-warnings (defvar date)) | ||
| 1989 | (calendar-day-of-year-string date)) | 2005 | (calendar-day-of-year-string date)) |
| 1990 | 2006 | ||
| 1991 | (defun diary-remind (sexp days &optional marking) | 2007 | (defun diary-remind (sexp days &optional marking) |
| @@ -2007,11 +2023,12 @@ whether the entry itself is a marking or nonmarking; if optional | |||
| 2007 | parameter MARKING is non-nil then the reminders are marked on the | 2023 | parameter MARKING is non-nil then the reminders are marked on the |
| 2008 | calendar." | 2024 | calendar." |
| 2009 | ;; `date' has a value at this point, from diary-sexp-entry. | 2025 | ;; `date' has a value at this point, from diary-sexp-entry. |
| 2026 | (with-no-warnings (defvar date)) | ||
| 2010 | ;; Convert a negative number to a list of days. | 2027 | ;; Convert a negative number to a list of days. |
| 2011 | (and (integerp days) | 2028 | (and (integerp days) |
| 2012 | (< days 0) | 2029 | (< days 0) |
| 2013 | (setq days (number-sequence 1 (- days)))) | 2030 | (setq days (number-sequence 1 (- days)))) |
| 2014 | (let ((diary-entry (eval sexp))) | 2031 | (calendar-dlet* ((diary-entry (eval sexp))) |
| 2015 | (cond | 2032 | (cond |
| 2016 | ;; Diary entry applies on date. | 2033 | ;; Diary entry applies on date. |
| 2017 | ((and diary-entry | 2034 | ((and diary-entry |
| @@ -2027,7 +2044,7 @@ calendar." | |||
| 2027 | (when (setq diary-entry (eval sexp)) | 2044 | (when (setq diary-entry (eval sexp)) |
| 2028 | ;; Discard any mark portion from diary-anniversary, etc. | 2045 | ;; Discard any mark portion from diary-anniversary, etc. |
| 2029 | (if (consp diary-entry) (setq diary-entry (cdr diary-entry))) | 2046 | (if (consp diary-entry) (setq diary-entry (cdr diary-entry))) |
| 2030 | (mapconcat 'eval diary-remind-message "")))) | 2047 | (mapconcat #'eval diary-remind-message "")))) |
| 2031 | ;; Diary entry may apply to one of a list of days before date. | 2048 | ;; Diary entry may apply to one of a list of days before date. |
| 2032 | ((and (listp days) days) | 2049 | ((and (listp days) days) |
| 2033 | (or (diary-remind sexp (car days) marking) | 2050 | (or (diary-remind sexp (car days) marking) |
| @@ -2224,18 +2241,19 @@ If given, optional SYMBOL must be a prefix to entries. If | |||
| 2224 | optional ABBREV-ARRAY is present, also matches the abbreviations | 2241 | optional ABBREV-ARRAY is present, also matches the abbreviations |
| 2225 | from this array (with or without a final `.'), in addition to the | 2242 | from this array (with or without a final `.'), in addition to the |
| 2226 | full month names." | 2243 | full month names." |
| 2227 | (let ((dayname (diary-name-pattern calendar-day-name-array | 2244 | (calendar-dlet* |
| 2228 | calendar-day-abbrev-array t)) | 2245 | ((dayname (diary-name-pattern calendar-day-name-array |
| 2229 | (monthname (format "\\(%s\\|\\*\\)" | 2246 | calendar-day-abbrev-array t)) |
| 2230 | (diary-name-pattern month-array abbrev-array))) | 2247 | (monthname (format "\\(%s\\|\\*\\)" |
| 2231 | (month "\\([0-9]+\\|\\*\\)") | 2248 | (diary-name-pattern month-array abbrev-array))) |
| 2232 | (day "\\([0-9]+\\|\\*\\)") | 2249 | (month "\\([0-9]+\\|\\*\\)") |
| 2233 | (year "-?\\([0-9]+\\|\\*\\)")) | 2250 | (day "\\([0-9]+\\|\\*\\)") |
| 2251 | (year "-?\\([0-9]+\\|\\*\\)")) | ||
| 2234 | (mapcar (lambda (x) | 2252 | (mapcar (lambda (x) |
| 2235 | (cons | 2253 | (cons |
| 2236 | (concat "^" (regexp-quote diary-nonmarking-symbol) "?" | 2254 | (concat "^" (regexp-quote diary-nonmarking-symbol) "?" |
| 2237 | (if symbol (regexp-quote symbol) "") "\\(" | 2255 | (if symbol (regexp-quote symbol) "") "\\(" |
| 2238 | (mapconcat 'eval | 2256 | (mapconcat #'eval |
| 2239 | ;; If backup, omit first item (backup) | 2257 | ;; If backup, omit first item (backup) |
| 2240 | ;; and last item (not part of date). | 2258 | ;; and last item (not part of date). |
| 2241 | (if (equal (car x) 'backup) | 2259 | (if (equal (car x) 'backup) |
| @@ -2312,7 +2330,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." | |||
| 2312 | 'font-lock-constant-face) | 2330 | 'font-lock-constant-face) |
| 2313 | (cons | 2331 | (cons |
| 2314 | (format "^%s?%s" (regexp-quote diary-nonmarking-symbol) | 2332 | (format "^%s?%s" (regexp-quote diary-nonmarking-symbol) |
| 2315 | (regexp-opt (mapcar 'regexp-quote | 2333 | (regexp-opt (mapcar #'regexp-quote |
| 2316 | (list diary-hebrew-entry-symbol | 2334 | (list diary-hebrew-entry-symbol |
| 2317 | diary-islamic-entry-symbol | 2335 | diary-islamic-entry-symbol |
| 2318 | diary-bahai-entry-symbol | 2336 | diary-bahai-entry-symbol |
| @@ -2345,10 +2363,10 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." | |||
| 2345 | (set (make-local-variable 'comment-start) diary-comment-start) | 2363 | (set (make-local-variable 'comment-start) diary-comment-start) |
| 2346 | (set (make-local-variable 'comment-end) diary-comment-end) | 2364 | (set (make-local-variable 'comment-end) diary-comment-end) |
| 2347 | (add-to-invisibility-spec '(diary . nil)) | 2365 | (add-to-invisibility-spec '(diary . nil)) |
| 2348 | (add-hook 'after-save-hook 'diary-redraw-calendar nil t) | 2366 | (add-hook 'after-save-hook #'diary-redraw-calendar nil t) |
| 2349 | ;; In case the file was modified externally, refresh the calendar | 2367 | ;; In case the file was modified externally, refresh the calendar |
| 2350 | ;; after refreshing the diary buffer. | 2368 | ;; after refreshing the diary buffer. |
| 2351 | (add-hook 'after-revert-hook 'diary-redraw-calendar nil t) | 2369 | (add-hook 'after-revert-hook #'diary-redraw-calendar nil t) |
| 2352 | (if diary-header-line-flag | 2370 | (if diary-header-line-flag |
| 2353 | (setq header-line-format diary-header-line-format))) | 2371 | (setq header-line-format diary-header-line-format))) |
| 2354 | 2372 | ||
| @@ -2359,18 +2377,19 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." | |||
| 2359 | "Return a regexp matching the first line of a fancy diary date header. | 2377 | "Return a regexp matching the first line of a fancy diary date header. |
| 2360 | This depends on the calendar date style." | 2378 | This depends on the calendar date style." |
| 2361 | (concat | 2379 | (concat |
| 2362 | (let ((dayname (diary-name-pattern calendar-day-name-array nil t)) | 2380 | (calendar-dlet* |
| 2363 | (monthname (diary-name-pattern calendar-month-name-array nil t)) | 2381 | ((dayname (diary-name-pattern calendar-day-name-array nil t)) |
| 2364 | (day "1") | 2382 | (monthname (diary-name-pattern calendar-month-name-array nil t)) |
| 2365 | (month "2") | 2383 | (day "1") |
| 2366 | ;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for? | 2384 | (month "2") |
| 2367 | (year "3")) | 2385 | ;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for? |
| 2386 | (year "3")) | ||
| 2368 | ;; This is ugly. c-d-d-form expects `day' etc to be "numbers in | 2387 | ;; This is ugly. c-d-d-form expects `day' etc to be "numbers in |
| 2369 | ;; string form"; eg the iso version calls string-to-number on some. | 2388 | ;; string form"; eg the iso version calls string-to-number on some. |
| 2370 | ;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583). | 2389 | ;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583). |
| 2371 | ;; Assumes no integers in c-day/month-name-array. | 2390 | ;; Assumes no integers in c-day/month-name-array. |
| 2372 | (replace-regexp-in-string "[0-9]+" "[0-9]+" | 2391 | (replace-regexp-in-string "[0-9]+" "[0-9]+" |
| 2373 | (mapconcat 'eval calendar-date-display-form "") | 2392 | (mapconcat #'eval calendar-date-display-form "") |
| 2374 | nil t)) | 2393 | nil t)) |
| 2375 | ;; Optional ": holiday name" after the date. | 2394 | ;; Optional ": holiday name" after the date. |
| 2376 | "\\(: .*\\)?")) | 2395 | "\\(: .*\\)?")) |
| @@ -2391,7 +2410,8 @@ This depends on the calendar date style." | |||
| 2391 | ("^Day.*omer.*$" . font-lock-builtin-face) | 2410 | ("^Day.*omer.*$" . font-lock-builtin-face) |
| 2392 | ("^Parashat.*$" . font-lock-comment-face) | 2411 | ("^Parashat.*$" . font-lock-comment-face) |
| 2393 | (,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp | 2412 | (,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp |
| 2394 | diary-time-regexp) . 'diary-time)) | 2413 | diary-time-regexp) |
| 2414 | . 'diary-time)) | ||
| 2395 | "Keywords to highlight in fancy diary display.") | 2415 | "Keywords to highlight in fancy diary display.") |
| 2396 | 2416 | ||
| 2397 | ;; If region looks like it might start or end in the middle of a | 2417 | ;; If region looks like it might start or end in the middle of a |