Mercurial > emacs
diff lisp/calendar/diary-lib.el @ 52117:e8a77526768b
(list-diary-entries): Adapt for new behaviour of `calendar-day-name'
and `calendar-month-name' functions.
(diary-name-pattern): Use abbrev arrays, rather than fixing abbrevs at
three chars. Calling syntax change.
(mark-diary-entries): Adapt for new behaviours of
`diary-name-pattern' and `calendar-make-alist' functions.
(fancy-diary-font-lock-keywords): Adapt for new behaviour of
`diary-name-pattern' function.
(font-lock-diary-date-forms): Use abbrev arrays, rather than fixing
abbrevs at three chars. Calling syntax change.
(cal-hebrew, cal-islam): Require when compiling.
(diary-font-lock-keywords): Adapt for new behaviour of
`font-lock-diary-date-forms' function.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sun, 03 Aug 2003 14:00:56 +0000 |
parents | 6732b4ce8c04 |
children | c701edc37ab5 |
line wrap: on
line diff
--- a/lisp/calendar/diary-lib.el Sun Aug 03 14:00:03 2003 +0000 +++ b/lisp/calendar/diary-lib.el Sun Aug 03 14:00:56 2003 +0000 @@ -341,14 +341,13 @@ (car d))) (backup (equal (car (car d)) 'backup)) (dayname - (concat - (calendar-day-name date) "\\|" - (substring (calendar-day-name date) 0 3) ".?")) + (format "%s\\|%s\\.?" + (calendar-day-name date) + (calendar-day-name date 'abbrev))) (monthname - (concat - "\\*\\|" - (calendar-month-name month) "\\|" - (substring (calendar-month-name month) 0 3) ".?")) + (format "\\*\\|%s\\|%s\\.?" + (calendar-month-name month) + (calendar-month-name month 'abbrev))) (month (concat "\\*\\|0*" (int-to-string month))) (day (concat "\\*\\|0*" (int-to-string day))) (year @@ -410,6 +409,7 @@ 'list-diary-entries-hook) (if diary-display-hook (run-hooks 'diary-display-hook) + ;; FIXME Error if calendar-setup 'calendar-only -- gm. (simple-diary-display)) (run-hooks 'diary-hook) diary-entries-list)))) @@ -757,26 +757,23 @@ "No entries found")) (call-interactively (get mail-user-agent 'sendfunc)))) - -(defun diary-name-pattern (string-array &optional fullname) - "Convert a STRING-ARRAY, an array of strings to a pattern. -The pattern will match any of the strings, either entirely or abbreviated -to three characters. An abbreviated form will match with or without a period; -If the optional FULLNAME is t, abbreviations will not match, just the full -name." - (let ((pattern "")) - (calendar-for-loop i from 0 to (1- (length string-array)) do - (setq pattern - (concat - pattern - (if (string-equal pattern "") "" "\\|") - (aref string-array i) - (if fullname - "" - (concat - "\\|" - (substring (aref string-array i) 0 3) ".?"))))) - pattern)) +(defun diary-name-pattern (string-array &optional abbrev-array paren) + "Return a regexp matching the strings in the array STRING-ARRAY. +If the optional argument ABBREV-ARRAY is present, then the function +`calendar-abbrev-construct' is used to construct abbreviations from the +two supplied arrays. The returned regexp will then also match these +abbreviations, with or without final `.' characters. If the optional +argument PAREN is non-nil, the regexp is surrounded by parentheses." + (regexp-opt (append string-array + (if abbrev-array + (calendar-abbrev-construct abbrev-array + string-array)) + (if abbrev-array + (calendar-abbrev-construct abbrev-array + string-array + 'period)) + nil) + paren)) (defvar marking-diary-entries nil "True during the marking of diary entries, nil otherwise.") @@ -805,11 +802,13 @@ (let* ((date-form (if (equal (car (car d)) 'backup) (cdr (car d)) (car d)));; ignore 'backup directive - (dayname (diary-name-pattern calendar-day-name-array)) + (dayname + (diary-name-pattern calendar-day-name-array + calendar-day-abbrev-array)) (monthname - (concat - (diary-name-pattern calendar-month-name-array) - "\\|\\*")) + (format "%s\\|\\*" + (diary-name-pattern calendar-month-name-array + calendar-month-abbrev-array))) (month "[0-9]+\\|\\*") (day "[0-9]+\\|\\*") (year "[0-9]+\\|\\*") @@ -883,21 +882,18 @@ (if dd-name (mark-calendar-days-named (cdr (assoc-ignore-case - (substring dd-name 0 3) + dd-name (calendar-make-alist calendar-day-name-array - 0 - (lambda (x) (substring x 0 3))))) marks) + 0 nil calendar-day-abbrev-array))) marks) (if mm-name - (if (string-equal mm-name "*") - (setq mm 0) - (setq mm + (setq mm + (if (string-equal mm-name "*") 0 (cdr (assoc-ignore-case - (substring mm-name 0 3) + mm-name (calendar-make-alist calendar-month-name-array - 1 - (lambda (x) (substring x 0 3)))))))) + 1 nil calendar-month-abbrev-array)))))) (mark-calendar-date-pattern mm dd yy marks)))) (setq d (cdr d)))) (mark-sexp-diary-entries) @@ -1718,14 +1714,8 @@ (list (cons (concat - (let ((dayname - (concat "\\(" - (diary-name-pattern calendar-day-name-array t) - "\\)")) - (monthname - (concat "\\(" - (diary-name-pattern calendar-month-name-array t) - "\\)")) + (let ((dayname (diary-name-pattern calendar-day-name-array nil t)) + (monthname (diary-name-pattern calendar-month-name-array nil t)) (day "[0-9]+") (month "[0-9]+") (year "-?[0-9]+")) @@ -1758,15 +1748,17 @@ t)) (error t)))) -(defun font-lock-diary-date-forms (month-list &optional symbol noabbrev) - "Create a list of font-lock patterns for `diary-date-forms' with MONTH-LIST. +(defun font-lock-diary-date-forms (month-array &optional symbol abbrev-array) + "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. If given, optional SYMBOL must be a prefix to entries. -If optional NOABBREV is t, do not allow abbreviations in names." - (let ((dayname - (concat "\\(" (diary-name-pattern calendar-day-name-array) "\\)")) - (monthname (concat "\\(" - (diary-name-pattern month-list noabbrev) - "\\|\\*\\)")) +If optional ABBREV-ARRAY is present, the abbreviations constructed +from this array by the function `calendar-abbrev-construct' are +matched (with or without a final `.'), in addition to the full month +names." + (let ((dayname (diary-name-pattern calendar-day-name-array + calendar-day-abbrev-array t)) + (monthname (format "\\(%s\\|\\*\\)" + (diary-name-pattern month-array abbrev-array))) (month "\\([0-9]+\\|\\*\\)") (day "\\([0-9]+\\|\\*\\)") (year "-?\\([0-9]+\\|\\*\\)")) @@ -1788,9 +1780,13 @@ '(1 diary-face))) diary-date-forms))) +(eval-when-compile (require 'cal-hebrew) + (require 'cal-islam)) + (defvar diary-font-lock-keywords (append - (font-lock-diary-date-forms calendar-month-name-array) + (font-lock-diary-date-forms calendar-month-name-array + nil calendar-month-abbrev-array) (when (or (memq 'mark-hebrew-diary-entries nongregorian-diary-marking-hook) (memq 'list-hebrew-diary-entries @@ -1798,7 +1794,7 @@ (require 'cal-hebrew) (font-lock-diary-date-forms calendar-hebrew-month-name-array-leap-year - hebrew-diary-entry-symbol t)) + hebrew-diary-entry-symbol)) (when (or (memq 'mark-islamic-diary-entries nongregorian-diary-marking-hook) (memq 'list-islamic-diary-entries @@ -1806,7 +1802,7 @@ (require 'cal-islam) (font-lock-diary-date-forms calendar-islamic-month-name-array - islamic-diary-entry-symbol t)) + islamic-diary-entry-symbol)) (list (cons (concat "^" (regexp-quote diary-include-string) ".*$")