Mercurial > emacs
changeset 65552:2f26d67eea8d
(mark-diary-entries): Don't move point. Use with-syntax-table and dolist.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Fri, 16 Sep 2005 16:04:29 +0000 |
| parents | 9a09eaabc891 |
| children | 2c8495a2cf88 |
| files | lisp/ChangeLog lisp/calendar/diary-lib.el |
| diffstat | 2 files changed, 98 insertions(+), 99 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Fri Sep 16 10:31:15 2005 +0000 +++ b/lisp/ChangeLog Fri Sep 16 16:04:29 2005 +0000 @@ -1,3 +1,8 @@ +2005-09-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * calendar/diary-lib.el (mark-diary-entries): Don't move point. + Use with-syntax-table and dolist. + 2005-09-16 Carsten Dominik <dominik@science.uva.nl> * textmodes/reftex-auc.el:
--- a/lisp/calendar/diary-lib.el Fri Sep 16 10:31:15 2005 +0000 +++ b/lisp/calendar/diary-lib.el Fri Sep 16 16:04:29 2005 +0000 @@ -865,105 +865,99 @@ (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) + (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 ()