aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-03-10 02:44:51 +0000
committerGlenn Morris2008-03-10 02:44:51 +0000
commit55e8cf9463d9821785fe227537e183f103d29727 (patch)
treeed96db1a50f886bce21af1f76960861f37f760db
parent37a68866aa6fd30bcd423b48cb8871b80027f0ba (diff)
downloademacs-55e8cf9463d9821785fe227537e183f103d29727.tar.gz
emacs-55e8cf9463d9821785fe227537e183f103d29727.zip
(diary-face-attrs): Fix custom :type.
(diary-face-attrs, diary-glob-file-regexp-prefix, diary-unknown-time) (diary-pull-attrs, diary-header-line-flag, diary-list-entries) (diary-unhide-everything, include-other-diary-files, diary-goto-entry) (mark-included-diary-files, mark-calendar-days-named) (mark-calendar-date-pattern, mark-calendar-month, diary-entry-compare) (diary-remind, insert-diary-entry, insert-weekly-diary-entry) (insert-monthly-diary-entry, insert-yearly-diary-entry) (insert-anniversary-diary-entry, insert-block-diary-entry) (insert-cyclic-diary-entry, fancy-diary-font-lock-keywords) (diary-font-lock-sexps): Doc fixes. (diary-remind-message, mark-calendar-month): Use zerop. (diary-attrtype-convert, diary-pull-attrs): Simplify. (diary-list-entries): Revert let to let* (previous change).
-rw-r--r--lisp/calendar/diary-lib.el305
1 files changed, 161 insertions, 144 deletions
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index af65f4bf8bc..ec91e48078e 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -46,11 +46,6 @@ are holidays."
46 :type 'boolean 46 :type 'boolean
47 :group 'diary) 47 :group 'diary)
48 48
49(defcustom diary-glob-file-regexp-prefix "^\\#"
50 "Regular expression prepended to attribute-regexps for file-wide specifiers."
51 :type 'regexp
52 :group 'diary)
53
54(defcustom diary-face 'diary 49(defcustom diary-face 'diary
55 "Face name to use for diary entries." 50 "Face name to use for diary entries."
56 :type 'face 51 :type 'face
@@ -58,6 +53,13 @@ are holidays."
58(make-obsolete-variable 'diary-face "customize the face `diary' instead." 53(make-obsolete-variable 'diary-face "customize the face `diary' instead."
59 "23.1") 54 "23.1")
60 55
56;; Face markup of calendar and diary displays: Any entry line that
57;; ends with [foo:value] where foo is a face attribute (except :box
58;; :stipple) or with [face:blah] tags, will have these values applied
59;; to the calendar and fancy diary displays. These attributes "stack"
60;; on calendar displays. File-wide attributes can be defined as
61;; follows: the first line matching "^# [tag:value]" defines the value
62;; for that particular tag.
61(defcustom diary-face-attrs 63(defcustom diary-face-attrs
62 '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string) 64 '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string)
63 (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string) 65 (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string)
@@ -75,12 +77,29 @@ are holidays."
75;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box) 77;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box)
76;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple) 78;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple)
77 ) 79 )
78 "A list of (regexp regnum attr attrtype) lists where the 80 "Alist of (REGEXP SUBEXP ATTRIBUTE TYPE) elements.
79regexp says how to find the tag, the regnum says which 81This is used by `diary-pull-attrs' to fontify certain diary
80parenthetical sub-regexp this regexp looks for, and the attr says 82elements. REGEXP is a regular expression to for, and SUBEXP is
81which attribute of the face (or that this _is_ a face) is being 83the numbered sub-expression to extract. `diary-glob-file-regexp-prefix'
82modified." 84is prepended to REGEXP for file-wide specifiers. ATTRIBUTE
83 :type 'sexp 85specifies which face attribute (e.g. `:foreground') to modify, or
86that this is a face (`:face') to apply. TYPE is the type of
87attribute being applied. Available TYPES (see `diary-attrtype-convert')
88are: `string', `symbol', `int', `tnil',`stringtnil.'"
89 :type '(repeat (list (string :tag "Regular expression")
90 (integer :tag "Sub-expression")
91 (symbol :tag "Attribute (e.g. :foreground)")
92 (choice (const string :tag "A string")
93 (const symbol :tag "A symbol")
94 (const int :tag "An integer")
95 (const tnil :tag "`t' or `nil'")
96 (const stringtnil
97 :tag "A string, `t', or `nil'"))))
98 :group 'diary)
99
100(defcustom diary-glob-file-regexp-prefix "^\\#"
101 "Regular expression prepended to `diary-face-attrs' for file-wide specifiers."
102 :type 'regexp
84 :group 'diary) 103 :group 'diary)
85 104
86(defcustom diary-file-name-prefix nil 105(defcustom diary-file-name-prefix nil
@@ -182,7 +201,7 @@ instead of deleting it, or changing the function used to do the printing."
182 :group 'diary) 201 :group 'diary)
183 202
184(defcustom diary-unknown-time -9999 203(defcustom diary-unknown-time -9999
185 "Value returned by diary-entry-time when no time is found. 204 "Value returned by `diary-entry-time' when no time is found.
186The default value -9999 causes entries with no recognizable time to be placed 205The default value -9999 causes entries with no recognizable time to be placed
187before those with times; 9999 would place entries with no recognizable time 206before those with times; 9999 would place entries with no recognizable time
188after those with times." 207after those with times."
@@ -205,7 +224,7 @@ after those with times."
205 224
206(defcustom diary-remind-message 225(defcustom diary-remind-message
207 '("Reminder: Only " 226 '("Reminder: Only "
208 (if (= 0 (% days 7)) 227 (if (zerop (% days 7))
209 (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks")) 228 (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks"))
210 (concat (int-to-string days) (if (= 1 days) " day" " days"))) 229 (concat (int-to-string days) (if (= 1 days) " day" " days")))
211 " until " 230 " until "
@@ -410,84 +429,57 @@ No diary entry if there is no sunset on that date.")
410It is the standard syntax table used in Fundamental mode, but with the 429It is the standard syntax table used in Fundamental mode, but with the
411syntax of `*' and `:' changed to be word constituents.") 430syntax of `*' and `:' changed to be word constituents.")
412 431
413(defvar diary-entries-list)
414(defvar displayed-year)
415(defvar displayed-month)
416(defvar date)
417(defvar number)
418(defvar date-string)
419(defvar original-date)
420
421(defun diary-attrtype-convert (attrvalue type) 432(defun diary-attrtype-convert (attrvalue type)
422 "Convert string ATTRVALUE to TYPE appropriate for a face description. 433 "Convert string ATTRVALUE to TYPE appropriate for a face description.
423Valid TYPEs are: string, symbol, int, stringtnil, tnil." 434Valid TYPEs are: string, symbol, int, stringtnil, tnil."
424 (let (ret) 435 (cond ((eq type 'string) attrvalue)
425 (setq ret (cond ((eq type 'string) attrvalue) 436 ((eq type 'symbol) (read attrvalue)) ; FIXME intern-soft?
426 ((eq type 'symbol) (read attrvalue)) 437 ((eq type 'int) (string-to-number attrvalue))
427 ((eq type 'int) (string-to-number attrvalue)) 438 ((eq type 'stringtnil)
428 ((eq type 'stringtnil) 439 (cond ((string-equal "t" attrvalue) t)
429 (cond ((string= "t" attrvalue) t) 440 ((string-equal "nil" attrvalue) nil)
430 ((string= "nil" attrvalue) nil) 441 (t attrvalue)))
431 (t attrvalue))) 442 ((eq type 'tnil) (string-equal "t" attrvalue))))
432 ((eq type 'tnil)
433 (cond ((string= "t" attrvalue) t)
434 ((string= "nil" attrvalue) nil)))))
435; (message "(%s)[%s]=[%s]" (print type) attrvalue ret)
436 ret))
437
438 443
439(defun diary-pull-attrs (entry fileglobattrs) 444(defun diary-pull-attrs (entry fileglobattrs)
440 "Pull the face-related attributes off the entry, merge with the 445 "Search for matches for regexps from `diary-face-attrs'.
441fileglobattrs, and return the (possibly modified) entry and face 446If ENTRY is nil, searches from the start of the current buffer, and
442data in a list of attrname attrvalue values. 447prepends all regexps with `diary-glob-file-regexp-prefix'.
443The entry will be modified to drop all tags that are used for face matching. 448If ENTRY is a string, search for matches in that string, and remove them.
444If entry is nil, then the fileglobattrs are being searched for, 449Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs.
445the fileglobattrs variable is ignored, and 450When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE)
446diary-glob-file-regexp-prefix is prepended to the regexps before each 451pairs."
447search." 452 (let (regexp regnum attrname attrname attrvalue type ret-attr)
448 (save-excursion 453 (if (null entry)
449 (let (regexp regnum attrname attr-list attrname attrvalue type 454 (save-excursion
450 ret-attr attr) 455 (dolist (attr diary-face-attrs)
451 (if (null entry) 456 ;; FIXME inefficient searching.
452 (progn
453 (setq ret-attr '()
454 attr-list diary-face-attrs)
455 (while attr-list
456 (goto-char (point-min))
457 (setq attr (car attr-list)
458 regexp (nth 0 attr)
459 regnum (nth 1 attr)
460 attrname (nth 2 attr)
461 type (nth 3 attr)
462 regexp (concat diary-glob-file-regexp-prefix regexp))
463 (setq attrvalue nil)
464 (if (re-search-forward regexp (point-max) t)
465 (setq attrvalue (match-string-no-properties regnum)))
466 (if (and attrvalue
467 (setq attrvalue (diary-attrtype-convert attrvalue type)))
468 (setq ret-attr (append ret-attr (list attrname attrvalue))))
469 (setq attr-list (cdr attr-list)))
470 (setq fileglobattrs ret-attr))
471 (progn
472 (setq ret-attr fileglobattrs
473 attr-list diary-face-attrs)
474 (while attr-list
475 (goto-char (point-min)) 457 (goto-char (point-min))
476 (setq attr (car attr-list) 458 (setq regexp (concat diary-glob-file-regexp-prefix (car attr))
477 regexp (nth 0 attr) 459 regnum (cadr attr)
478 regnum (nth 1 attr)
479 attrname (nth 2 attr) 460 attrname (nth 2 attr)
480 type (nth 3 attr)) 461 type (nth 3 attr)
481 (setq attrvalue nil) 462 attrvalue (if (re-search-forward regexp nil t)
482 (if (string-match regexp entry) 463 (match-string-no-properties regnum)))
483 (progn 464 (and attrvalue
484 (setq attrvalue (match-string-no-properties regnum entry)) 465 (setq attrvalue (diary-attrtype-convert attrvalue type))
485 (setq entry (replace-match "" t t entry)))) 466 (setq ret-attr (append ret-attr
486 (if (and attrvalue 467 (list attrname attrvalue))))))
487 (setq attrvalue (diary-attrtype-convert attrvalue type))) 468 (setq ret-attr fileglobattrs)
488 (setq ret-attr (append ret-attr (list attrname attrvalue)))) 469 (dolist (attr diary-face-attrs)
489 (setq attr-list (cdr attr-list))))) 470 (setq regexp (car attr)
490 (list entry ret-attr)))) 471 regnum (cadr attr)
472 attrname (nth 2 attr)
473 type (nth 3 attr)
474 attrvalue nil)
475 ;; FIXME multiple matches?
476 (if (string-match regexp entry)
477 (setq attrvalue (match-string-no-properties regnum entry)
478 entry (replace-match "" t t entry)))
479 (and attrvalue
480 (setq attrvalue (diary-attrtype-convert attrvalue type))
481 (setq ret-attr (append ret-attr (list attrname attrvalue))))))
482 (list entry ret-attr)))
491 483
492(defun diary-set-maybe-redraw (symbol value) 484(defun diary-set-maybe-redraw (symbol value)
493 "Set SYMBOL's value to VALUE, and redraw the diary if necessary. 485 "Set SYMBOL's value to VALUE, and redraw the diary if necessary.
@@ -503,7 +495,7 @@ just visiting the `diary-file'), and SYMBOL's value is to be changed."
503;; This can be removed once the kill/yank treatment of invisible text 495;; This can be removed once the kill/yank treatment of invisible text
504;; (see etc/TODO) is fixed. -- gm 496;; (see etc/TODO) is fixed. -- gm
505(defcustom diary-header-line-flag t 497(defcustom diary-header-line-flag t
506 "If non-nil, `simple-diary-display' will show a header line. 498 "Non-nil means `simple-diary-display' will show a header line.
507The format of the header is specified by `diary-header-line-format'." 499The format of the header is specified by `diary-header-line-format'."
508 :group 'diary 500 :group 'diary
509 :type 'boolean 501 :type 'boolean
@@ -530,8 +522,6 @@ Only used if `diary-header-line-flag' is non-nil."
530 :set 'diary-set-maybe-redraw 522 :set 'diary-set-maybe-redraw
531 :version "22.1") 523 :version "22.1")
532 524
533(defvar diary-saved-point) ; internal
534
535;; The first version of this also checked for diary-selective-display 525;; The first version of this also checked for diary-selective-display
536;; in the non-fancy case. This was an attempt to distinguish between 526;; in the non-fancy case. This was an attempt to distinguish between
537;; displaying the diary and just visiting the diary file. However, 527;; displaying the diary and just visiting the diary file. However,
@@ -586,6 +576,8 @@ Can be used by programs integrating a diary list into other buffers (e.g.
586org.el and planner.el) to modify the string or add properties to it. 576org.el and planner.el) to modify the string or add properties to it.
587The function takes a string argument and must return a string.") 577The function takes a string argument and must return a string.")
588 578
579(defvar diary-entries-list) ; bound in diary-list-entries
580
589(defun add-to-diary-list (date string specifier &optional marker 581(defun add-to-diary-list (date string specifier &optional marker
590 globcolor literal) 582 globcolor literal)
591 "Add an entry to `diary-entries-list'. 583 "Add an entry to `diary-entries-list'.
@@ -604,7 +596,7 @@ FILENAME being the file containing the diary entry."
604 (if diary-file-name-prefix 596 (if diary-file-name-prefix
605 (let ((prefix (funcall diary-file-name-prefix-function 597 (let ((prefix (funcall diary-file-name-prefix-function
606 (buffer-file-name)))) 598 (buffer-file-name))))
607 (or (string= prefix "") 599 (or (string-equal prefix "")
608 (setq string (format "[%s] %s" prefix string))))) 600 (setq string (format "[%s] %s" prefix string)))))
609 (and diary-modify-entry-list-string-function 601 (and diary-modify-entry-list-string-function
610 (setq string (funcall diary-modify-entry-list-string-function 602 (setq string (funcall diary-modify-entry-list-string-function
@@ -643,9 +635,9 @@ These hooks have the following distinct roles:
643 before the display hook is run. 635 before the display hook is run.
644 636
645 `diary-display-hook' does the actual display of information. If this is 637 `diary-display-hook' does the actual display of information. If this is
646 nil, simple-diary-display will be used. Use add-hook to set this to 638 nil, `simple-diary-display' will be used. Use `add-hook' to use
647 fancy-diary-display, if desired. If you want no diary display, use 639 `fancy-diary-display', if desired. If you want no diary display, use
648 add-hook to set this to ignore. 640 add-hook to set this to `ignore'.
649 641
650 `diary-hook' is run last. This can be used for an appointment 642 `diary-hook' is run last. This can be used for an appointment
651 notification function. 643 notification function.
@@ -704,7 +696,7 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
704 (year (extract-calendar-year date)) 696 (year (extract-calendar-year date))
705 (entry-found (list-sexp-diary-entries date))) 697 (entry-found (list-sexp-diary-entries date)))
706 (dolist (date-form diary-date-forms) 698 (dolist (date-form diary-date-forms)
707 (let ((backup (when (eq (car date-form) 'backup) 699 (let* ((backup (when (eq (car date-form) 'backup)
708 (setq date-form (cdr date-form)) 700 (setq date-form (cdr date-form))
709 t)) 701 t))
710 (dayname 702 (dayname
@@ -726,6 +718,8 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
726 (regexp 718 (regexp
727 (concat 719 (concat
728 "^" mark "?\\(" 720 "^" mark "?\\("
721 ;; This must be let* so that date-form
722 ;; can use day etc.
729 (mapconcat 'eval date-form "\\)\\(?:") 723 (mapconcat 'eval date-form "\\)\\(?:")
730 "\\)")) 724 "\\)"))
731 (case-fold-search t)) 725 (case-fold-search t))
@@ -779,15 +773,19 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
779 diary-entries-list)))))) 773 diary-entries-list))))))
780 774
781(defun diary-unhide-everything () 775(defun diary-unhide-everything ()
776 "Show all invisible text in the diary."
782 (kill-local-variable 'diary-selective-display) 777 (kill-local-variable 'diary-selective-display)
783 (remove-overlays (point-min) (point-max) 'invisible 'diary) 778 (remove-overlays (point-min) (point-max) 'invisible 'diary)
784 (kill-local-variable 'mode-line-format)) 779 (kill-local-variable 'mode-line-format))
785 780
781(defvar original-date) ; bound in diary-list-entries
782(defvar number)
783
786(defun include-other-diary-files () 784(defun include-other-diary-files ()
787 "Include the diary entries from other diary files with those of diary-file. 785 "Include the diary entries from other diary files with those of `diary-file'.
788This function is suitable for use in `list-diary-entries-hook'; 786This function is suitable for use in `list-diary-entries-hook';
789it enables you to use shared diary files together with your own. 787it enables you to use shared diary files together with your own.
790The files included are specified in the diaryfile by lines of this form: 788The files included are specified in the `diary-file' by lines of this form:
791 #include \"filename\" 789 #include \"filename\"
792This is recursive; that is, #include directives in diary files thus included 790This is recursive; that is, #include directives in diary files thus included
793are obeyed. You can change the `#include' to some other string by 791are obeyed. You can change the `#include' to some other string by
@@ -821,6 +819,10 @@ changing the variable `diary-include-string'."
821 (sleep-for 2)))) 819 (sleep-for 2))))
822 (goto-char (point-min))) 820 (goto-char (point-min)))
823 821
822;; Bound in diary-list-entries.
823(defvar date-string)
824(defvar diary-saved-point)
825
824(defun simple-diary-display () 826(defun simple-diary-display ()
825 "Display the diary buffer if there are any relevant entries or holidays." 827 "Display the diary buffer if there are any relevant entries or holidays."
826 (let* ((holiday-list (if holidays-in-diary-buffer 828 (let* ((holiday-list (if holidays-in-diary-buffer
@@ -853,7 +855,7 @@ changing the variable `diary-include-string'."
853 (with-current-buffer 855 (with-current-buffer
854 (find-buffer-visiting (substitute-in-file-name diary-file)) 856 (find-buffer-visiting (substitute-in-file-name diary-file))
855 (let ((window (display-buffer (current-buffer)))) 857 (let ((window (display-buffer (current-buffer))))
856 ;; d-s-p is passed from list-diary-entries. 858 ;; d-s-p is passed from diary-list-entries.
857 (set-window-point window diary-saved-point) 859 (set-window-point window diary-saved-point)
858 (set-window-start window (point-min)))) 860 (set-window-start window (point-min))))
859 (message "Preparing diary...done")))) 861 (message "Preparing diary...done"))))
@@ -863,7 +865,7 @@ changing the variable `diary-include-string'."
863 "Default face used for buttons." 865 "Default face used for buttons."
864 :version "22.1" 866 :version "22.1"
865 :group 'diary) 867 :group 'diary)
866;; backward-compatibility alias 868;; Backward-compatibility alias. FIXME make obsolete.
867(put 'diary-button-face 'face-alias 'diary-button) 869(put 'diary-button-face 'face-alias 'diary-button)
868 870
869(define-button-type 'diary-entry 871(define-button-type 'diary-entry
@@ -871,6 +873,7 @@ changing the variable `diary-include-string'."
871 'face 'diary-button) 873 'face 'diary-button)
872 874
873(defun diary-goto-entry (button) 875(defun diary-goto-entry (button)
876 "Jump to the diary entry for the button at point."
874 (let* ((locator (button-get button 'locator)) 877 (let* ((locator (button-get button 'locator))
875 (marker (car locator)) 878 (marker (car locator))
876 markbuf file) 879 markbuf file)
@@ -896,7 +899,8 @@ changing the variable `diary-include-string'."
896(defun fancy-diary-display () 899(defun fancy-diary-display ()
897 "Prepare a diary buffer with relevant entries in a fancy, noneditable form. 900 "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
898This function is provided for optional use as the `diary-display-hook'." 901This function is provided for optional use as the `diary-display-hook'."
899 (with-current-buffer ;; Turn off selective-display in the diary file's buffer. 902 ;; Turn off selective-display in the diary file's buffer.
903 (with-current-buffer
900 (find-buffer-visiting (substitute-in-file-name diary-file)) 904 (find-buffer-visiting (substitute-in-file-name diary-file))
901 (diary-unhide-everything)) 905 (diary-unhide-everything))
902 (if (or (not diary-entries-list) 906 (if (or (not diary-entries-list)
@@ -918,7 +922,8 @@ This function is provided for optional use as the `diary-display-hook'."
918 (setq buffer-read-only t) 922 (setq buffer-read-only t)
919 (display-buffer holiday-buffer) 923 (display-buffer holiday-buffer)
920 (message "No diary entries for %s" date-string))) 924 (message "No diary entries for %s" date-string)))
921 (with-current-buffer;; Prepare the fancy diary buffer. 925 ;; Prepare the fancy diary buffer.
926 (with-current-buffer
922 (make-fancy-diary-buffer) 927 (make-fancy-diary-buffer)
923 (setq buffer-read-only nil) 928 (setq buffer-read-only nil)
924 (let ((entry-list diary-entries-list) 929 (let ((entry-list diary-entries-list)
@@ -1133,7 +1138,7 @@ to run it every morning at 1am."
1133 "Return a regexp matching the strings in the array STRING-ARRAY. 1138 "Return a regexp matching the strings in the array STRING-ARRAY.
1134If the optional argument ABBREV-ARRAY is present, then the function 1139If the optional argument ABBREV-ARRAY is present, then the function
1135`calendar-abbrev-construct' is used to construct abbreviations from the 1140`calendar-abbrev-construct' is used to construct abbreviations from the
1136two supplied arrays. The returned regexp will then also match these 1141two supplied arrays. The returned regexp will then also match these
1137abbreviations, with or without final `.' characters. If the optional 1142abbreviations, with or without final `.' characters. If the optional
1138argument PAREN is non-nil, the regexp is surrounded by parentheses." 1143argument PAREN is non-nil, the regexp is surrounded by parentheses."
1139 (regexp-opt (append string-array 1144 (regexp-opt (append string-array
@@ -1246,9 +1251,10 @@ diary entries."
1246 y))) 1251 y)))
1247 (string-to-number y-str))))) 1252 (string-to-number y-str)))))
1248 (setq marks (nth 1 1253 (setq marks (nth 1
1249 (diary-pull-attrs (buffer-substring-no-properties 1254 (diary-pull-attrs
1250 (point) (line-end-position)) 1255 (buffer-substring-no-properties
1251 file-glob-attrs))) 1256 (point) (line-end-position))
1257 file-glob-attrs)))
1252 (if dd-name 1258 (if dd-name
1253 (mark-calendar-days-named 1259 (mark-calendar-days-named
1254 (cdr (assoc-string 1260 (cdr (assoc-string
@@ -1270,6 +1276,9 @@ diary entries."
1270 'mark-diary-entries-hook)) 1276 'mark-diary-entries-hook))
1271 (message "Marking diary entries...done"))))) 1277 (message "Marking diary entries...done")))))
1272 1278
1279(defvar displayed-year) ; bound in generate-calendar
1280(defvar displayed-month)
1281
1273(defun mark-sexp-diary-entries () 1282(defun mark-sexp-diary-entries ()
1274 "Mark days in the calendar window that have sexp diary entries. 1283 "Mark days in the calendar window that have sexp diary entries.
1275Each entry in the diary file (or included files) visible in the calendar window 1284Each entry in the diary file (or included files) visible in the calendar window
@@ -1301,11 +1310,12 @@ is marked. See the documentation for the function `list-sexp-diary-entries'."
1301 (setq sexp (buffer-substring-no-properties sexp-start (point))) 1310 (setq sexp (buffer-substring-no-properties sexp-start (point)))
1302 (forward-char 1) 1311 (forward-char 1)
1303 (if (and (bolp) (not (looking-at "[ \t]"))) 1312 (if (and (bolp) (not (looking-at "[ \t]")))
1304 (progn;; Diary entry consists only of the sexp 1313 ;; Diary entry consists only of the sexp.
1314 (progn
1305 (backward-char 1) 1315 (backward-char 1)
1306 (setq entry "")) 1316 (setq entry ""))
1307 (setq entry-start (point)) 1317 (setq entry-start (point))
1308 ;; Find end of entry 1318 ;; Find end of entry.
1309 (forward-line 1) 1319 (forward-line 1)
1310 (while (looking-at "[ \t]") 1320 (while (looking-at "[ \t]")
1311 (forward-line 1)) 1321 (forward-line 1))
@@ -1328,7 +1338,7 @@ is marked. See the documentation for the function `list-sexp-diary-entries'."
1328 "Mark the diary entries from other diary files with those of the diary file. 1338 "Mark the diary entries from other diary files with those of the diary file.
1329This function is suitable for use as the `mark-diary-entries-hook'; it enables 1339This function is suitable for use as the `mark-diary-entries-hook'; it enables
1330you to use shared diary files together with your own. The files included are 1340you to use shared diary files together with your own. The files included are
1331specified in the diary-file by lines of this form: 1341specified in the `diary-file' by lines of this form:
1332 #include \"filename\" 1342 #include \"filename\"
1333This is recursive; that is, #include directives in diary files thus included 1343This is recursive; that is, #include directives in diary files thus included
1334are obeyed. You can change the `#include' to some other string by 1344are obeyed. You can change the `#include' to some other string by
@@ -1360,7 +1370,8 @@ changing the variable `diary-include-string'."
1360 1370
1361(defun mark-calendar-days-named (dayname &optional color) 1371(defun mark-calendar-days-named (dayname &optional color)
1362 "Mark all dates in the calendar window that are day DAYNAME of the week. 1372 "Mark all dates in the calendar window that are day DAYNAME of the week.
13630 means all Sundays, 1 means all Mondays, and so on." 13730 means all Sundays, 1 means all Mondays, and so on.
1374Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
1364 (with-current-buffer calendar-buffer 1375 (with-current-buffer calendar-buffer
1365 (let ((prev-month displayed-month) 1376 (let ((prev-month displayed-month)
1366 (prev-year displayed-year) 1377 (prev-year displayed-year)
@@ -1371,16 +1382,18 @@ changing the variable `diary-include-string'."
1371 (increment-calendar-month succ-month succ-year 1) 1382 (increment-calendar-month succ-month succ-year 1)
1372 (increment-calendar-month prev-month prev-year -1) 1383 (increment-calendar-month prev-month prev-year -1)
1373 (setq day (calendar-absolute-from-gregorian 1384 (setq day (calendar-absolute-from-gregorian
1374 (calendar-nth-named-day 1 dayname prev-month prev-year))) 1385 (calendar-nth-named-day 1 dayname prev-month prev-year))
1375 (setq last-day (calendar-absolute-from-gregorian 1386 last-day (calendar-absolute-from-gregorian
1376 (calendar-nth-named-day -1 dayname succ-month succ-year))) 1387 (calendar-nth-named-day -1 dayname succ-month succ-year)))
1377 (while (<= day last-day) 1388 (while (<= day last-day)
1378 (mark-visible-calendar-date (calendar-gregorian-from-absolute day) color) 1389 (mark-visible-calendar-date (calendar-gregorian-from-absolute day)
1390 color)
1379 (setq day (+ day 7)))))) 1391 (setq day (+ day 7))))))
1380 1392
1381(defun mark-calendar-date-pattern (month day year &optional color) 1393(defun mark-calendar-date-pattern (month day year &optional color)
1382 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. 1394 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
1383A value of 0 in any position is a wildcard." 1395A value of 0 in any position is a wildcard.
1396Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
1384 (with-current-buffer calendar-buffer 1397 (with-current-buffer calendar-buffer
1385 (let ((m displayed-month) 1398 (let ((m displayed-month)
1386 (y displayed-year)) 1399 (y displayed-year))
@@ -1390,13 +1403,14 @@ A value of 0 in any position is a wildcard."
1390 (increment-calendar-month m y 1))))) 1403 (increment-calendar-month m y 1)))))
1391 1404
1392(defun mark-calendar-month (month year p-month p-day p-year &optional color) 1405(defun mark-calendar-month (month year p-month p-day p-year &optional color)
1393 "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. 1406 "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P-DAY/P-YEAR.
1394A value of 0 in any position of the pattern is a wildcard." 1407A value of 0 in any position of the pattern is a wildcard.
1408Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
1395 (if (or (and (= month p-month) 1409 (if (or (and (= month p-month)
1396 (or (= p-year 0) (= year p-year))) 1410 (or (zerop p-year) (= year p-year)))
1397 (and (= p-month 0) 1411 (and (= p-month 0)
1398 (or (= p-year 0) (= year p-year)))) 1412 (or (zerop p-year) (= year p-year))))
1399 (if (= p-day 0) 1413 (if (zerop p-day)
1400 (calendar-for-loop 1414 (calendar-for-loop
1401 i from 1 to (calendar-last-day-of-month month year) do 1415 i from 1 to (calendar-last-day-of-month month year) do
1402 (mark-visible-calendar-date (list month i year) color)) 1416 (mark-visible-calendar-date (list month i year) color))
@@ -1407,7 +1421,7 @@ A value of 0 in any position of the pattern is a wildcard."
1407 (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) 1421 (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
1408 1422
1409(defun diary-entry-compare (e1 e2) 1423(defun diary-entry-compare (e1 e2)
1410 "Returns t if E1 is earlier than E2." 1424 "Return t if E1 is earlier than E2."
1411 (or (calendar-date-compare e1 e2) 1425 (or (calendar-date-compare e1 e2)
1412 (and (calendar-date-equal (car e1) (car e2)) 1426 (and (calendar-date-equal (car e1) (car e2))
1413 (let* ((ts1 (cadr e1)) (t1 (diary-entry-time ts1)) 1427 (let* ((ts1 (cadr e1)) (t1 (diary-entry-time ts1))
@@ -1425,23 +1439,23 @@ The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam,
1425XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can 1439XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can
1426be used instead of a colon (:) to separate the hour and minute parts." 1440be used instead of a colon (:) to separate the hour and minute parts."
1427 (let ((case-fold-search nil)) 1441 (let ((case-fold-search nil))
1428 (cond ((string-match ; Military time 1442 (cond ((string-match ; military time
1429 "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" 1443 "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
1430 s) 1444 s)
1431 (+ (* 100 (string-to-number (match-string 1 s))) 1445 (+ (* 100 (string-to-number (match-string 1 s)))
1432 (string-to-number (match-string 2 s)))) 1446 (string-to-number (match-string 2 s))))
1433 ((string-match ; Hour only XXam or XXpm 1447 ((string-match ; hour only (XXam or XXpm)
1434 "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) 1448 "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
1435 (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) 1449 (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
1436 (if (equal ?a (downcase (aref s (match-beginning 2)))) 1450 (if (equal ?a (downcase (aref s (match-beginning 2))))
1437 0 1200))) 1451 0 1200)))
1438 ((string-match ; Hour and minute XX:XXam or XX:XXpm 1452 ((string-match ; hour and minute (XX:XXam or XX:XXpm)
1439 "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) 1453 "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
1440 (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) 1454 (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
1441 (string-to-number (match-string 2 s)) 1455 (string-to-number (match-string 2 s))
1442 (if (equal ?a (downcase (aref s (match-beginning 3)))) 1456 (if (equal ?a (downcase (aref s (match-beginning 3))))
1443 0 1200))) 1457 0 1200)))
1444 (t diary-unknown-time)))) ; Unrecognizable 1458 (t diary-unknown-time)))) ; unrecognizable
1445 1459
1446(defun list-sexp-diary-entries (date) 1460(defun list-sexp-diary-entries (date)
1447 "Add sexp entries for DATE from the diary file to `diary-entries-list'. 1461 "Add sexp entries for DATE from the diary file to `diary-entries-list'.
@@ -1484,7 +1498,7 @@ A number of built-in functions are available for this type of diary entry:
1484 (DAYNAME=0 means Sunday, 1 means Monday, and so on; 1498 (DAYNAME=0 means Sunday, 1 means Monday, and so on;
1485 if N is negative it counts backward from the end of 1499 if N is negative it counts backward from the end of
1486 the month. MONTH can be a list of months, a single 1500 the month. MONTH can be a list of months, a single
1487 month, or t to specify all months. Optional DAY means 1501 month, or t to specify all months. Optional DAY means
1488 Nth DAYNAME of MONTH on or after/before DAY. DAY defaults 1502 Nth DAYNAME of MONTH on or after/before DAY. DAY defaults
1489 to 1 if N>0 and the last day of the month if N<0. An 1503 to 1 if N>0 and the last day of the month if N<0. An
1490 optional parameter MARK specifies a face or single-character 1504 optional parameter MARK specifies a face or single-character
@@ -1627,7 +1641,8 @@ best if they are nonmarking."
1627 entry-start (1+ line-start)) 1641 entry-start (1+ line-start))
1628 (forward-char 1) 1642 (forward-char 1)
1629 (if (and (bolp) (not (looking-at "[ \t]"))) 1643 (if (and (bolp) (not (looking-at "[ \t]")))
1630 (progn;; Diary entry consists only of the sexp 1644 ;; Diary entry consists only of the sexp.
1645 (progn
1631 (backward-char 1) 1646 (backward-char 1)
1632 (setq entry "")) 1647 (setq entry ""))
1633 (setq entry-start (point)) 1648 (setq entry-start (point))
@@ -1678,6 +1693,7 @@ best if they are nonmarking."
1678 (result entry) 1693 (result entry)
1679 (t nil)))) 1694 (t nil))))
1680 1695
1696(defvar date)
1681(defvar entry) 1697(defvar entry)
1682 1698
1683;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. 1699;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
@@ -1752,17 +1768,18 @@ highlighting the day in the calendar."
1752 (let* ((m (extract-calendar-month date)) 1768 (let* ((m (extract-calendar-month date))
1753 (d (extract-calendar-day date)) 1769 (d (extract-calendar-day date))
1754 (y (extract-calendar-year date)) 1770 (y (extract-calendar-year date))
1755 (limit; last (n>0) or first (n<0) possible base date for entry 1771 ;; Last (n>0) or first (n<0) possible base date for entry.
1772 (limit
1756 (calendar-nth-named-absday (- n) dayname m y d)) 1773 (calendar-nth-named-absday (- n) dayname m y d))
1757 (last-abs (if (> n 0) limit (+ limit 6))) 1774 (last-abs (if (> n 0) limit (+ limit 6)))
1758 (first-abs (if (> n 0) (- limit 6) limit)) 1775 (first-abs (if (> n 0) (- limit 6) limit))
1759 (last (calendar-gregorian-from-absolute last-abs)) 1776 (last (calendar-gregorian-from-absolute last-abs))
1760 (first (calendar-gregorian-from-absolute first-abs)) 1777 (first (calendar-gregorian-from-absolute first-abs))
1761 ; m1, d1 is first possible base date 1778 ;; m1, d1 is first possible base date.
1762 (m1 (extract-calendar-month first)) 1779 (m1 (extract-calendar-month first))
1763 (d1 (extract-calendar-day first)) 1780 (d1 (extract-calendar-day first))
1764 (y1 (extract-calendar-year first)) 1781 (y1 (extract-calendar-year first))
1765 ; m2, d2 is last possible base date 1782 ;; m2, d2 is last possible base date.
1766 (m2 (extract-calendar-month last)) 1783 (m2 (extract-calendar-month last))
1767 (d2 (extract-calendar-day last)) 1784 (d2 (extract-calendar-day last))
1768 (y2 (extract-calendar-year last))) 1785 (y2 (extract-calendar-year last)))
@@ -1775,11 +1792,11 @@ highlighting the day in the calendar."
1775 1 1792 1
1776 (calendar-last-day-of-month m1 y1))))) 1793 (calendar-last-day-of-month m1 y1)))))
1777 (and (<= d1 d) (<= d d2)))) 1794 (and (<= d1 d) (<= d d2))))
1778 ;; only possible base dates straddle two months 1795 ;; Only possible base dates straddle two months.
1779 (and (or (< y1 y2) 1796 (and (or (< y1 y2)
1780 (and (= y1 y2) (< m1 m2))) 1797 (and (= y1 y2) (< m1 m2)))
1781 (or 1798 (or
1782 ;; m1, d1 works as a base date 1799 ;; m1, d1 works as a base date.
1783 (and 1800 (and
1784 (or (eq month t) 1801 (or (eq month t)
1785 (if (listp month) 1802 (if (listp month)
@@ -1788,7 +1805,7 @@ highlighting the day in the calendar."
1788 (<= d1 (or day (if (> n 0) 1805 (<= d1 (or day (if (> n 0)
1789 1 1806 1
1790 (calendar-last-day-of-month m1 y1))))) 1807 (calendar-last-day-of-month m1 y1)))))
1791 ;; m2, d2 works as a base date 1808 ;; m2, d2 works as a base date.
1792 (and (or (eq month t) 1809 (and (or (eq month t)
1793 (if (listp month) 1810 (if (listp month)
1794 (memq m2 month) 1811 (memq m2 month)
@@ -1872,20 +1889,20 @@ returned.
1872In addition to the reminders beforehand, the diary entry also appears on the 1889In addition to the reminders beforehand, the diary entry also appears on the
1873date itself. 1890date itself.
1874 1891
1875A `diary-nonmarking-symbol' at the beginning of the line of the diary-remind 1892A `diary-nonmarking-symbol' at the beginning of the line of the `diary-remind'
1876entry specifies that the diary entry (not the reminder) is non-marking. 1893entry specifies that the diary entry (not the reminder) is non-marking.
1877Marking of reminders is independent of whether the entry itself is a marking 1894Marking of reminders is independent of whether the entry itself is a marking
1878or nonmarking; if optional parameter MARKING is non-nil then the reminders are 1895or nonmarking; if optional parameter MARKING is non-nil then the reminders are
1879marked on the calendar." 1896marked on the calendar."
1880 (let ((diary-entry (eval sexp))) 1897 (let ((diary-entry (eval sexp)))
1881 (cond 1898 (cond
1882 ;; Diary entry applies on date 1899 ;; Diary entry applies on date.
1883 ((and diary-entry 1900 ((and diary-entry
1884 (or (not marking-diary-entries) marking-diary-entry)) 1901 (or (not marking-diary-entries) marking-diary-entry))
1885 diary-entry) 1902 diary-entry)
1886 ;; Diary entry may apply to `days' before date 1903 ;; Diary entry may apply to `days' before date.
1887 ((and (integerp days) 1904 ((and (integerp days)
1888 (not diary-entry); Diary entry does not apply to date 1905 (not diary-entry) ; diary entry does not apply to date
1889 (or (not marking-diary-entries) marking)) 1906 (or (not marking-diary-entries) marking))
1890 (let ((date (calendar-gregorian-from-absolute 1907 (let ((date (calendar-gregorian-from-absolute
1891 (+ (calendar-absolute-from-gregorian date) days)))) 1908 (+ (calendar-absolute-from-gregorian date) days))))
@@ -1893,7 +1910,7 @@ marked on the calendar."
1893 ;; Discard any mark portion from diary-anniversary, etc. 1910 ;; Discard any mark portion from diary-anniversary, etc.
1894 (if (consp diary-entry) (setq diary-entry (cdr diary-entry))) 1911 (if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
1895 (mapconcat 'eval diary-remind-message "")))) 1912 (mapconcat 'eval diary-remind-message ""))))
1896 ;; Diary entry may apply to one of a list of days before date 1913 ;; Diary entry may apply to one of a list of days before date.
1897 ((and (listp days) days) 1914 ((and (listp days) days)
1898 (or (diary-remind sexp (car days) marking) 1915 (or (diary-remind sexp (car days) marking)
1899 (diary-remind sexp (cdr days) marking)))))) 1916 (diary-remind sexp (cdr days) marking))))))
@@ -1930,21 +1947,21 @@ If omitted, NONMARKING defaults to nil and FILE defaults to
1930 1947
1931(defun insert-diary-entry (arg) 1948(defun insert-diary-entry (arg)
1932 "Insert a diary entry for the date indicated by point. 1949 "Insert a diary entry for the date indicated by point.
1933Prefix arg will make the entry nonmarking." 1950Prefix argument ARG makes the entry nonmarking."
1934 (interactive "P") 1951 (interactive "P")
1935 (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t) 1952 (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t)
1936 arg)) 1953 arg))
1937 1954
1938(defun insert-weekly-diary-entry (arg) 1955(defun insert-weekly-diary-entry (arg)
1939 "Insert a weekly diary entry for the day of the week indicated by point. 1956 "Insert a weekly diary entry for the day of the week indicated by point.
1940Prefix arg will make the entry nonmarking." 1957Prefix argument ARG makes the entry nonmarking."
1941 (interactive "P") 1958 (interactive "P")
1942 (make-diary-entry (calendar-day-name (calendar-cursor-to-date t)) 1959 (make-diary-entry (calendar-day-name (calendar-cursor-to-date t))
1943 arg)) 1960 arg))
1944 1961
1945(defun insert-monthly-diary-entry (arg) 1962(defun insert-monthly-diary-entry (arg)
1946 "Insert a monthly diary entry for the day of the month indicated by point. 1963 "Insert a monthly diary entry for the day of the month indicated by point.
1947Prefix arg will make the entry nonmarking." 1964Prefix argument ARG makes the entry nonmarking."
1948 (interactive "P") 1965 (interactive "P")
1949 (let ((calendar-date-display-form 1966 (let ((calendar-date-display-form
1950 (if european-calendar-style 1967 (if european-calendar-style
@@ -1955,7 +1972,7 @@ Prefix arg will make the entry nonmarking."
1955 1972
1956(defun insert-yearly-diary-entry (arg) 1973(defun insert-yearly-diary-entry (arg)
1957 "Insert an annual diary entry for the day of the year indicated by point. 1974 "Insert an annual diary entry for the day of the year indicated by point.
1958Prefix arg will make the entry nonmarking." 1975Prefix argument ARG makes the entry nonmarking."
1959 (interactive "P") 1976 (interactive "P")
1960 (let ((calendar-date-display-form 1977 (let ((calendar-date-display-form
1961 (if european-calendar-style 1978 (if european-calendar-style
@@ -1966,7 +1983,7 @@ Prefix arg will make the entry nonmarking."
1966 1983
1967(defun insert-anniversary-diary-entry (arg) 1984(defun insert-anniversary-diary-entry (arg)
1968 "Insert an anniversary diary entry for the date given by point. 1985 "Insert an anniversary diary entry for the date given by point.
1969Prefix arg will make the entry nonmarking." 1986Prefix argument ARG makes the entry nonmarking."
1970 (interactive "P") 1987 (interactive "P")
1971 (let ((calendar-date-display-form 1988 (let ((calendar-date-display-form
1972 (if european-calendar-style 1989 (if european-calendar-style
@@ -1980,7 +1997,7 @@ Prefix arg will make the entry nonmarking."
1980 1997
1981(defun insert-block-diary-entry (arg) 1998(defun insert-block-diary-entry (arg)
1982 "Insert a block diary entry for the days between the point and marked date. 1999 "Insert a block diary entry for the days between the point and marked date.
1983Prefix arg will make the entry nonmarking." 2000Prefix argument ARG makes the entry nonmarking."
1984 (interactive "P") 2001 (interactive "P")
1985 (let ((calendar-date-display-form 2002 (let ((calendar-date-display-form
1986 (if european-calendar-style 2003 (if european-calendar-style
@@ -2005,7 +2022,7 @@ Prefix arg will make the entry nonmarking."
2005 2022
2006(defun insert-cyclic-diary-entry (arg) 2023(defun insert-cyclic-diary-entry (arg)
2007 "Insert a cyclic diary entry starting at the date given by point. 2024 "Insert a cyclic diary entry starting at the date given by point.
2008Prefix arg will make the entry nonmarking." 2025Prefix argument ARG makes the entry nonmarking."
2009 (interactive "P") 2026 (interactive "P")
2010 (let ((calendar-date-display-form 2027 (let ((calendar-date-display-form
2011 (if european-calendar-style 2028 (if european-calendar-style
@@ -2083,7 +2100,7 @@ Prefix arg will make the entry nonmarking."
2083 '("^Parashat.*$" . font-lock-comment-face) 2100 '("^Parashat.*$" . font-lock-comment-face)
2084 `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp 2101 `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
2085 diary-time-regexp) . 'diary-time)) 2102 diary-time-regexp) . 'diary-time))
2086 "Keywords to highlight in fancy diary display") 2103 "Keywords to highlight in fancy diary display.")
2087 2104
2088;; If region looks like it might start or end in the middle of a 2105;; If region looks like it might start or end in the middle of a
2089;; multiline pattern, extend the region to encompass the whole pattern. 2106;; multiline pattern, extend the region to encompass the whole pattern.
@@ -2118,7 +2135,7 @@ Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'."
2118 2135
2119 2136
2120(defun diary-font-lock-sexps (limit) 2137(defun diary-font-lock-sexps (limit)
2121 "Recognize sexp diary entry for font-locking." 2138 "Recognize sexp diary entry up to LIMIT for font-locking."
2122 (if (re-search-forward 2139 (if (re-search-forward
2123 (concat "^" (regexp-quote diary-nonmarking-symbol) 2140 (concat "^" (regexp-quote diary-nonmarking-symbol)
2124 "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)") 2141 "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)")
@@ -2152,12 +2169,12 @@ names."
2152 (if symbol (regexp-quote symbol) "") "\\(" 2169 (if symbol (regexp-quote symbol) "") "\\("
2153 (mapconcat 'eval 2170 (mapconcat 'eval
2154 ;; If backup, omit first item (backup) 2171 ;; If backup, omit first item (backup)
2155 ;; and last item (not part of date) 2172 ;; and last item (not part of date).
2156 (if (equal (car x) 'backup) 2173 (if (equal (car x) 'backup)
2157 (nreverse (cdr (reverse (cdr x)))) 2174 (nreverse (cdr (reverse (cdr x))))
2158 x) 2175 x)
2159 "") 2176 "")
2160 ;; With backup, last item is not part of date 2177 ;; With backup, last item is not part of date.
2161 (if (equal (car x) 'backup) 2178 (if (equal (car x) 'backup)
2162 (concat "\\)" (eval (car (reverse x)))) 2179 (concat "\\)" (eval (car (reverse x))))
2163 "\\)")) 2180 "\\)"))