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

[Stefan Monnier]

Index: emacs/lisp/calendar/diary-lib.el
diff -c emacs/lisp/calendar/diary-lib.el:1.103 
emacs/lisp/calendar/diary-lib.el:1.104
*** emacs/lisp/calendar/diary-lib.el:1.103      Wed Sep 14 15:22:25 2005
--- emacs/lisp/calendar/diary-lib.el    Fri Sep 16 16:04:27 2005
***************
*** 865,969 ****
    (let ((marking-diary-entries t)
          file-glob-attrs marks)
      (with-current-buffer (find-file-noselect (diary-check-diary-file) t)
!       (setq mark-diary-entries-in-calendar t)
!       (message "Marking diary entries...")
!       (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
!       (let ((d diary-date-forms)
!             (old-diary-syntax-table (syntax-table))
!             temp)
!         (set-syntax-table diary-syntax-table)
!         (while d
!           (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]+\\|\\*")
!                  (l (length date-form))
!                  (d-name-pos (- l (length (memq 'dayname date-form))))
!                  (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
!                  (m-name-pos (- l (length (memq 'monthname date-form))))
!                  (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
!                  (d-pos (- l (length (memq 'day date-form))))
!                  (d-pos (if (/= l d-pos) (+ 2 d-pos)))
!                  (m-pos (- l (length (memq 'month date-form))))
!                  (m-pos (if (/= l m-pos) (+ 2 m-pos)))
!                  (y-pos (- l (length (memq 'year date-form))))
!                  (y-pos (if (/= l y-pos) (+ 2 y-pos)))
!                  (regexp
!                   (concat
!                    "\\(\\`\\|\^M\\|\n\\)\\("
!                    (mapconcat 'eval date-form "\\)\\(")
!                    "\\)"))
!                  (case-fold-search t))
!             (goto-char (point-min))
!             (while (re-search-forward regexp nil t)
!               (let* ((dd-name
!                       (if d-name-pos
!                           (match-string-no-properties d-name-pos)))
!                      (mm-name
!                       (if m-name-pos
!                           (match-string-no-properties m-name-pos)))
!                      (mm (string-to-number
!                           (if m-pos
!                               (match-string-no-properties m-pos)
!                             "")))
!                      (dd (string-to-number
!                           (if d-pos
!                               (match-string-no-properties d-pos)
!                             "")))
!                      (y-str (if y-pos
!                                 (match-string-no-properties y-pos)))
!                      (yy (if (not y-str)
!                              0
!                            (if (and (= (length y-str) 2)
!                                     abbreviated-calendar-year)
!                                (let* ((current-y
!                                        (extract-calendar-year
!                                         (calendar-current-date)))
!                                       (y (+ (string-to-number y-str)
!                                             (* 100
!                                                (/ current-y 100)))))
!                                  (if (> (- y current-y) 50)
!                                      (- y 100)
!                                    (if (> (- current-y y) 50)
!                                        (+ y 100)
!                                      y)))
!                              (string-to-number y-str)))))
!                 (save-excursion
!                   (setq entry (buffer-substring-no-properties
!                                (point) (line-end-position))
!                         temp (diary-pull-attrs entry file-glob-attrs)
!                         entry (nth 0 temp)
!                         marks (nth 1 temp)))
!                 (if dd-name
!                     (mark-calendar-days-named
!                      (cdr (assoc-string
!                            dd-name
!                            (calendar-make-alist
!                             calendar-day-name-array
!                             0 nil calendar-day-abbrev-array) t)) marks)
!                   (if mm-name
!                       (setq mm
!                             (if (string-equal mm-name "*") 0
!                               (cdr (assoc-string
!                                     mm-name
!                                     (calendar-make-alist
!                                      calendar-month-name-array
!                                      1 nil calendar-month-abbrev-array) t)))))
!                   (mark-calendar-date-pattern mm dd yy marks))))
!             (setq d (cdr d))))
!         (mark-sexp-diary-entries)
!         (run-hooks 'nongregorian-diary-marking-hook
!                    'mark-diary-entries-hook)
!         (set-syntax-table old-diary-syntax-table)
          (message "Marking diary entries...done")))))
  
  (defun mark-sexp-diary-entries ()
--- 865,963 ----
    (let ((marking-diary-entries t)
          file-glob-attrs marks)
      (with-current-buffer (find-file-noselect (diary-check-diary-file) t)
!       (save-excursion
!         (setq mark-diary-entries-in-calendar t)
!         (message "Marking diary entries...")
!         (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
!         (with-syntax-table diary-syntax-table
!           (dolist (date-form diary-date-forms)
!             (if (eq (car date-form) 'backup)
!                 (setq date-form (cdr date-form))) ;; ignore 'backup directive
!             (let* ((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]+\\|\\*")
!                    (l (length date-form))
!                    (d-name-pos (- l (length (memq 'dayname date-form))))
!                    (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
!                    (m-name-pos (- l (length (memq 'monthname date-form))))
!                    (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
!                    (d-pos (- l (length (memq 'day date-form))))
!                    (d-pos (if (/= l d-pos) (+ 2 d-pos)))
!                    (m-pos (- l (length (memq 'month date-form))))
!                    (m-pos (if (/= l m-pos) (+ 2 m-pos)))
!                    (y-pos (- l (length (memq 'year date-form))))
!                    (y-pos (if (/= l y-pos) (+ 2 y-pos)))
!                    (regexp
!                     (concat
!                      "\\(\\`\\|\^M\\|\n\\)\\("
!                      (mapconcat 'eval date-form "\\)\\(")
!                      "\\)"))
!                    (case-fold-search t))
!               (goto-char (point-min))
!               (while (re-search-forward regexp nil t)
!                 (let* ((dd-name
!                         (if d-name-pos
!                             (match-string-no-properties d-name-pos)))
!                        (mm-name
!                         (if m-name-pos
!                             (match-string-no-properties m-name-pos)))
!                        (mm (string-to-number
!                             (if m-pos
!                                 (match-string-no-properties m-pos)
!                               "")))
!                        (dd (string-to-number
!                             (if d-pos
!                                 (match-string-no-properties d-pos)
!                               "")))
!                        (y-str (if y-pos
!                                   (match-string-no-properties y-pos)))
!                        (yy (if (not y-str)
!                                0
!                              (if (and (= (length y-str) 2)
!                                       abbreviated-calendar-year)
!                                  (let* ((current-y
!                                          (extract-calendar-year
!                                           (calendar-current-date)))
!                                         (y (+ (string-to-number y-str)
!                                               (* 100
!                                                  (/ current-y 100)))))
!                                    (if (> (- y current-y) 50)
!                                        (- y 100)
!                                      (if (> (- current-y y) 50)
!                                          (+ y 100)
!                                        y)))
!                                (string-to-number y-str)))))
!                   (let ((tmp (diary-pull-attrs (buffer-substring-no-properties
!                                                 (point) (line-end-position))
!                                                file-glob-attrs)))
!                     (setq entry (nth 0 tmp)
!                           marks (nth 1 tmp)))
!                   (if dd-name
!                       (mark-calendar-days-named
!                        (cdr (assoc-string
!                              dd-name
!                              (calendar-make-alist
!                               calendar-day-name-array
!                               0 nil calendar-day-abbrev-array) t)) marks)
!                     (if mm-name
!                         (setq mm
!                               (if (string-equal mm-name "*") 0
!                                 (cdr (assoc-string
!                                       mm-name
!                                       (calendar-make-alist
!                                        calendar-month-name-array
!                                        1 nil calendar-month-abbrev-array) 
t)))))
!                     (mark-calendar-date-pattern mm dd yy marks))))))
!           (mark-sexp-diary-entries)
!           (run-hooks 'nongregorian-diary-marking-hook
!                      'mark-diary-entries-hook))
          (message "Marking diary entries...done")))))
  
  (defun mark-sexp-diary-entries ()