(mark-diary-entries): Don't move point. Use with-syntax-table and dolist.
This commit is contained in:
Stefan Monnier
parent
23006f3e26
commit
f52e8e862d
2 changed files with 98 additions and 99 deletions
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -865,105 +865,99 @@ diary entries."
|
|||
(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 ()
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue