[Emacs-diffs] Changes to emacs/lisp/calendar/diary-lib.el

[Glenn Morris]

Index: emacs/lisp/calendar/diary-lib.el
diff -c emacs/lisp/calendar/diary-lib.el:1.68 
emacs/lisp/calendar/diary-lib.el:1.69
*** emacs/lisp/calendar/diary-lib.el:1.68       Sat Jun 21 21:02:22 2003
--- emacs/lisp/calendar/diary-lib.el    Sun Aug  3 10:00:56 2003
***************
*** 341,354 ****
                                          (car d)))
                            (backup (equal (car (car d)) 'backup))
                            (dayname
!                            (concat
!                             (calendar-day-name date) "\\|"
!                             (substring (calendar-day-name date) 0 3) ".?"))
                            (monthname
!                            (concat
!                             "\\*\\|"
!                             (calendar-month-name month) "\\|"
!                             (substring (calendar-month-name month) 0 3) ".?"))
                            (month (concat "\\*\\|0*" (int-to-string month)))
                            (day (concat "\\*\\|0*" (int-to-string day)))
                            (year
--- 341,353 ----
                                          (car d)))
                            (backup (equal (car (car d)) 'backup))
                            (dayname
!                            (format "%s\\|%s\\.?"
!                             (calendar-day-name date)
!                             (calendar-day-name date 'abbrev)))
                            (monthname
!                            (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,415 ****
--- 409,415 ----
                     '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,782 ****
         "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))
  
  (defvar marking-diary-entries nil
    "True during the marking of diary entries, nil otherwise.")
--- 757,779 ----
         "No entries found"))
      (call-interactively (get mail-user-agent 'sendfunc))))
  
! (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,815 ****
            (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))
                   (monthname
!                   (concat
!                    (diary-name-pattern calendar-month-name-array)
!                    "\\|\\*"))
                   (month "[0-9]+\\|\\*")
                   (day "[0-9]+\\|\\*")
                   (year "[0-9]+\\|\\*")
--- 802,814 ----
            (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
!                                       calendar-day-abbrev-array))
                   (monthname
!                   (format "%s\\|\\*"
!                    (diary-name-pattern calendar-month-name-array
!                                        calendar-month-abbrev-array)))
                   (month "[0-9]+\\|\\*")
                   (day "[0-9]+\\|\\*")
                   (year "[0-9]+\\|\\*")
***************
*** 883,903 ****
                  (if dd-name
                      (mark-calendar-days-named
                       (cdr (assoc-ignore-case
!                            (substring dd-name 0 3)
                             (calendar-make-alist
                              calendar-day-name-array
!                             0
!                             (lambda (x) (substring x 0 3))))) marks)
                    (if mm-name
!                       (if (string-equal mm-name "*")
!                           (setq mm 0)
!                         (setq mm
                                (cdr (assoc-ignore-case
!                                     (substring mm-name 0 3)
                                      (calendar-make-alist
                                       calendar-month-name-array
!                                      1
!                                      (lambda (x) (substring x 0 3))))))))
                    (mark-calendar-date-pattern mm dd yy marks))))
              (setq d (cdr d))))
          (mark-sexp-diary-entries)
--- 882,899 ----
                  (if dd-name
                      (mark-calendar-days-named
                       (cdr (assoc-ignore-case
!                            dd-name
                             (calendar-make-alist
                              calendar-day-name-array
!                             0 nil calendar-day-abbrev-array))) marks)
                    (if mm-name
!                       (setq mm
!                             (if (string-equal mm-name "*") 0
                                (cdr (assoc-ignore-case
!                                     mm-name
                                      (calendar-make-alist
                                       calendar-month-name-array
!                                      1 nil calendar-month-abbrev-array))))))
                    (mark-calendar-date-pattern mm dd yy marks))))
              (setq d (cdr d))))
          (mark-sexp-diary-entries)
***************
*** 1718,1731 ****
    (list
     (cons
      (concat
!      (let ((dayname
!           (concat "\\("
!                   (diary-name-pattern calendar-day-name-array t)
!                   "\\)"))
!          (monthname
!           (concat "\\("
!                   (diary-name-pattern calendar-month-name-array t)
!                   "\\)"))
           (day "[0-9]+")
             (month "[0-9]+")
           (year "-?[0-9]+"))
--- 1714,1721 ----
    (list
     (cons
      (concat
!      (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,1772 ****
              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.
  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)
!                            "\\|\\*\\)"))
          (month "\\([0-9]+\\|\\*\\)")
          (day "\\([0-9]+\\|\\*\\)")
          (year "-?\\([0-9]+\\|\\*\\)"))
--- 1748,1764 ----
              t))
        (error t))))
  
! (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 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,1796 ****
                  '(1 diary-face)))
              diary-date-forms)))
  
  (defvar diary-font-lock-keywords
        (append
!        (font-lock-diary-date-forms calendar-month-name-array)
         (when (or (memq 'mark-hebrew-diary-entries
                         nongregorian-diary-marking-hook)
                   (memq 'list-hebrew-diary-entries
--- 1780,1792 ----
                  '(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
!                                    nil calendar-month-abbrev-array)
         (when (or (memq 'mark-hebrew-diary-entries
                         nongregorian-diary-marking-hook)
                   (memq 'list-hebrew-diary-entries
***************
*** 1798,1804 ****
           (require 'cal-hebrew)
           (font-lock-diary-date-forms
            calendar-hebrew-month-name-array-leap-year
!           hebrew-diary-entry-symbol t))
         (when (or (memq 'mark-islamic-diary-entries
                         nongregorian-diary-marking-hook)
                   (memq 'list-islamic-diary-entries
--- 1794,1800 ----
           (require 'cal-hebrew)
           (font-lock-diary-date-forms
            calendar-hebrew-month-name-array-leap-year
!           hebrew-diary-entry-symbol))
         (when (or (memq 'mark-islamic-diary-entries
                         nongregorian-diary-marking-hook)
                   (memq 'list-islamic-diary-entries
***************
*** 1806,1812 ****
           (require 'cal-islam)
           (font-lock-diary-date-forms
            calendar-islamic-month-name-array
!           islamic-diary-entry-symbol t))
         (list
          (cons
           (concat "^" (regexp-quote diary-include-string) ".*$")
--- 1802,1808 ----
           (require 'cal-islam)
           (font-lock-diary-date-forms
            calendar-islamic-month-name-array
!           islamic-diary-entry-symbol))
         (list
          (cons
           (concat "^" (regexp-quote diary-include-string) ".*$")