changeset 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 3132ffb5a7ab
children af8f4ec2f255
files lisp/calendar/diary-lib.el
diffstat 1 files changed, 55 insertions(+), 59 deletions(-) [+]
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) ".*$")