Commit f52e8e86 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(mark-diary-entries): Don't move point. Use with-syntax-table and dolist.

parent 23006f3e
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> 2005-09-16 Carsten Dominik <dominik@science.uva.nl>
   
* textmodes/reftex-auc.el: * textmodes/reftex-auc.el:
......
...@@ -865,105 +865,99 @@ diary entries." ...@@ -865,105 +865,99 @@ diary entries."
(let ((marking-diary-entries t) (let ((marking-diary-entries t)
file-glob-attrs marks) file-glob-attrs marks)
(with-current-buffer (find-file-noselect (diary-check-diary-file) t) (with-current-buffer (find-file-noselect (diary-check-diary-file) t)
(setq mark-diary-entries-in-calendar t) (save-excursion
(message "Marking diary entries...") (setq mark-diary-entries-in-calendar t)
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) (message "Marking diary entries...")
(let ((d diary-date-forms) (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(old-diary-syntax-table (syntax-table)) (with-syntax-table diary-syntax-table
temp) (dolist (date-form diary-date-forms)
(set-syntax-table diary-syntax-table) (if (eq (car date-form) 'backup)
(while d (setq date-form (cdr date-form))) ;; ignore 'backup directive
(let* ((date-form (if (equal (car (car d)) 'backup) (let* ((dayname
(cdr (car d)) (diary-name-pattern calendar-day-name-array
(car d)));; ignore 'backup directive calendar-day-abbrev-array))
(dayname (monthname
(diary-name-pattern calendar-day-name-array (format "%s\\|\\*"
calendar-day-abbrev-array)) (diary-name-pattern calendar-month-name-array
(monthname calendar-month-abbrev-array)))
(format "%s\\|\\*" (month "[0-9]+\\|\\*")
(diary-name-pattern calendar-month-name-array (day "[0-9]+\\|\\*")
calendar-month-abbrev-array))) (year "[0-9]+\\|\\*")
(month "[0-9]+\\|\\*") (l (length date-form))
(day "[0-9]+\\|\\*") (d-name-pos (- l (length (memq 'dayname date-form))))
(year "[0-9]+\\|\\*") (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
(l (length date-form)) (m-name-pos (- l (length (memq 'monthname date-form))))
(d-name-pos (- l (length (memq 'dayname date-form)))) (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
(d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) (d-pos (- l (length (memq 'day date-form))))
(m-name-pos (- l (length (memq 'monthname date-form)))) (d-pos (if (/= l d-pos) (+ 2 d-pos)))
(m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) (m-pos (- l (length (memq 'month date-form))))
(d-pos (- l (length (memq 'day date-form)))) (m-pos (if (/= l m-pos) (+ 2 m-pos)))
(d-pos (if (/= l d-pos) (+ 2 d-pos))) (y-pos (- l (length (memq 'year date-form))))
(m-pos (- l (length (memq 'month date-form)))) (y-pos (if (/= l y-pos) (+ 2 y-pos)))
(m-pos (if (/= l m-pos) (+ 2 m-pos))) (regexp
(y-pos (- l (length (memq 'year date-form)))) (concat
(y-pos (if (/= l y-pos) (+ 2 y-pos))) "\\(\\`\\|\^M\\|\n\\)\\("
(regexp (mapconcat 'eval date-form "\\)\\(")
(concat "\\)"))
"\\(\\`\\|\^M\\|\n\\)\\(" (case-fold-search t))
(mapconcat 'eval date-form "\\)\\(") (goto-char (point-min))
"\\)")) (while (re-search-forward regexp nil t)
(case-fold-search t)) (let* ((dd-name
(goto-char (point-min)) (if d-name-pos
(while (re-search-forward regexp nil t) (match-string-no-properties d-name-pos)))
(let* ((dd-name (mm-name
(if d-name-pos (if m-name-pos
(match-string-no-properties d-name-pos))) (match-string-no-properties m-name-pos)))
(mm-name (mm (string-to-number
(if m-name-pos (if m-pos
(match-string-no-properties m-name-pos))) (match-string-no-properties m-pos)
(mm (string-to-number "")))
(if m-pos (dd (string-to-number
(match-string-no-properties m-pos) (if d-pos
""))) (match-string-no-properties d-pos)
(dd (string-to-number "")))
(if d-pos (y-str (if y-pos
(match-string-no-properties d-pos) (match-string-no-properties y-pos)))
""))) (yy (if (not y-str)
(y-str (if y-pos 0
(match-string-no-properties y-pos))) (if (and (= (length y-str) 2)
(yy (if (not y-str) abbreviated-calendar-year)
0 (let* ((current-y
(if (and (= (length y-str) 2) (extract-calendar-year
abbreviated-calendar-year) (calendar-current-date)))
(let* ((current-y (y (+ (string-to-number y-str)
(extract-calendar-year (* 100
(calendar-current-date))) (/ current-y 100)))))
(y (+ (string-to-number y-str) (if (> (- y current-y) 50)
(* 100 (- y 100)
(/ current-y 100))))) (if (> (- current-y y) 50)
(if (> (- y current-y) 50) (+ y 100)
(- y 100) y)))
(if (> (- current-y y) 50) (string-to-number y-str)))))
(+ y 100) (let ((tmp (diary-pull-attrs (buffer-substring-no-properties
y))) (point) (line-end-position))
(string-to-number y-str))))) file-glob-attrs)))
(save-excursion (setq entry (nth 0 tmp)
(setq entry (buffer-substring-no-properties marks (nth 1 tmp)))
(point) (line-end-position)) (if dd-name
temp (diary-pull-attrs entry file-glob-attrs) (mark-calendar-days-named
entry (nth 0 temp) (cdr (assoc-string
marks (nth 1 temp))) dd-name
(if dd-name (calendar-make-alist
(mark-calendar-days-named calendar-day-name-array
(cdr (assoc-string 0 nil calendar-day-abbrev-array) t)) marks)
dd-name (if mm-name
(calendar-make-alist (setq mm
calendar-day-name-array (if (string-equal mm-name "*") 0
0 nil calendar-day-abbrev-array) t)) marks) (cdr (assoc-string
(if mm-name mm-name
(setq mm (calendar-make-alist
(if (string-equal mm-name "*") 0 calendar-month-name-array
(cdr (assoc-string 1 nil calendar-month-abbrev-array) t)))))
mm-name (mark-calendar-date-pattern mm dd yy marks))))))
(calendar-make-alist (mark-sexp-diary-entries)
calendar-month-name-array (run-hooks 'nongregorian-diary-marking-hook
1 nil calendar-month-abbrev-array) t))))) 'mark-diary-entries-hook))
(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"))))) (message "Marking diary entries...done")))))
(defun mark-sexp-diary-entries () (defun mark-sexp-diary-entries ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment