[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/calendar/diary-lib.el
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/calendar/diary-lib.el |
|
Date: |
Fri, 04 Apr 2003 01:21:48 -0500 |
Index: emacs/lisp/calendar/diary-lib.el
diff -c emacs/lisp/calendar/diary-lib.el:1.63
emacs/lisp/calendar/diary-lib.el:1.64
*** emacs/lisp/calendar/diary-lib.el:1.63 Tue Feb 4 07:49:33 2003
--- emacs/lisp/calendar/diary-lib.el Tue Feb 11 18:25:15 2003
***************
*** 185,190 ****
--- 185,266 ----
(defvar d-file)
(defvar original-date)
+ (defun diary-attrtype-convert (attrvalue type)
+ "Convert the attrvalue from a string to the appropriate type for using
+ in a face description"
+ (let (ret)
+ (setq ret (cond ((eq type 'string) attrvalue)
+ ((eq type 'symbol) (read attrvalue))
+ ((eq type 'int) (string-to-int attrvalue))
+ ((eq type 'stringtnil)
+ (cond ((string= "t" attrvalue) t)
+ ((string= "nil" attrvalue) nil)
+ (t attrvalue)))
+ ((eq type 'tnil)
+ (cond ((string= "t" attrvalue) t)
+ ((string= "nil" attrvalue) nil)))))
+ ; (message "(%s)[%s]=[%s]" (print type) attrvalue ret)
+ ret))
+
+
+ (defun diary-pull-attrs (entry fileglobattrs)
+ "Pull the face-related attributes off the entry, merge with the
+ fileglobattrs, and return the (possibly modified) entry and face
+ data in a list of attrname attrvalue values.
+ The entry will be modified to drop all tags that are used for face matching.
+ If entry is nil, then the fileglobattrs are being searched for,
+ the fileglobattrs variable is ignored, and
+ diary-glob-file-regexp-prefix is prepended to the regexps before each
+ search."
+ (save-excursion
+ (let (regexp regnum attrname attr-list attrname attrvalue type)
+ (if (null entry)
+ (progn
+ (setq ret-attr '()
+ attr-list diary-face-attrs)
+ (while attr-list
+ (goto-char (point-min))
+ (setq attr (car attr-list)
+ regexp (nth 0 attr)
+ regnum (nth 1 attr)
+ attrname (nth 2 attr)
+ type (nth 3 attr)
+ regexp (concat diary-glob-file-regexp-prefix regexp))
+ (setq attrvalue nil)
+ (if (re-search-forward regexp (point-max) t)
+ (setq attrvalue (buffer-substring-no-properties
+ (match-beginning regnum)
+ (match-end regnum))))
+ (if (and attrvalue
+ (setq attrvalue (diary-attrtype-convert attrvalue type)))
+ (setq ret-attr (append ret-attr (list attrname attrvalue))))
+ (setq attr-list (cdr attr-list)))
+ (setq fileglobattrs ret-attr))
+ (progn
+ (setq ret-attr fileglobattrs
+ attr-list diary-face-attrs)
+ (while attr-list
+ (goto-char (point-min))
+ (setq attr (car attr-list)
+ regexp (nth 0 attr)
+ regnum (nth 1 attr)
+ attrname (nth 2 attr)
+ type (nth 3 attr))
+ (setq attrvalue nil)
+ (if (string-match regexp entry)
+ (progn
+ (setq attrvalue (substring-no-properties entry
+ (match-beginning
regnum)
+ (match-end regnum)))
+ (setq entry (replace-match "" t t entry))))
+ (if (and attrvalue
+ (setq attrvalue (diary-attrtype-convert attrvalue type)))
+ (setq ret-attr (append ret-attr (list attrname attrvalue))))
+ (setq attr-list (cdr attr-list)))))))
+ (list entry ret-attr))
+
+
+
(defun list-diary-entries (date number)
"Create and display a buffer containing the relevant lines in diary-file.
The arguments are DATE and NUMBER; the entries selected are those
***************
*** 223,228 ****
--- 299,305 ----
(let* ((original-date date);; save for possible use in the hooks
old-diary-syntax-table
diary-entries-list
+ file-glob-attrs
(date-string (calendar-date-string date))
(d-file (substitute-in-file-name diary-file)))
(message "Preparing diary...")
***************
*** 233,238 ****
--- 310,316 ----
(set-buffer diary-buffer)
(or (verify-visited-file-modtime diary-buffer)
(revert-buffer t t))))
+ (setq file-glob-attrs (nth 1 (diary-pull-attrs nil "")))
(setq selective-display t)
(setq selective-display-ellipses nil)
(setq old-diary-syntax-table (syntax-table))
***************
*** 308,326 ****
(backward-char 1)
(subst-char-in-region date-start
(point) ?\^M ?\n t)
(add-to-diary-list
date
! (buffer-substring
! entry-start (point))
(buffer-substring
(1+ date-start) (1- entry-start))
! (copy-marker entry-start))))))
(setq d (cdr d)))
(or entry-found
(not diary-list-include-blanks)
(setq diary-entries-list
(append diary-entries-list
! (list (list date "" "")))))
(setq date
(calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian date))))
--- 386,407 ----
(backward-char 1)
(subst-char-in-region date-start
(point) ?\^M ?\n t)
+ (setq entry (buffer-substring entry-start (point))
+ temp (diary-pull-attrs entry file-glob-attrs)
+ entry (nth 0 temp)
+ marks (nth 1 temp))
(add-to-diary-list
date
! entry
(buffer-substring
(1+ date-start) (1- entry-start))
! (copy-marker entry-start) marks)))))
(setq d (cdr d)))
(or entry-found
(not diary-list-include-blanks)
(setq diary-entries-list
(append diary-entries-list
! (list (list date "" "" "" "")))))
(setq date
(calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian date))))
***************
*** 513,525 ****
date-holiday-list
(concat "\n" (make-string l ? ))))
(insert ?\n (make-string (+ l longest) ?=) ?\n)))))
! (if (< 0 (length (car (cdr (car entry-list)))))
! (if (nth 3 (car entry-list))
! (insert-button (concat (car (cdr (car entry-list))) "\n")
! 'marker (nth 3 (car entry-list))
! :type 'diary-entry)
! (insert (car (cdr (car entry-list))) ?\n)))
! (setq entry-list (cdr entry-list))))
(set-buffer-modified-p nil)
(goto-char (point-min))
(setq buffer-read-only t)
--- 594,626 ----
date-holiday-list
(concat "\n" (make-string l ? ))))
(insert ?\n (make-string (+ l longest) ?=) ?\n)))))
!
! (setq entry (car (cdr (car entry-list))))
! (if (< 0 (length entry))
! (progn
! (if (nth 3 (car entry-list))
! (insert-button (concat entry "\n")
! 'marker (nth 3 (car entry-list))
! :type 'diary-entry)
! (insert entry ?\n))
! (save-excursion
! (setq marks (nth 4 (car entry-list)))
! (setq temp-face (make-symbol (apply 'concat "temp-face-"
(mapcar '(lambda (sym) (if (not (stringp sym)) (symbol-name sym) sym)) marks))))
! (make-face temp-face)
! ;; Remove :face info from the marks, copy the face info into
temp-face
! (setq faceinfo marks)
! (while (setq faceinfo (memq :face faceinfo))
! (copy-face (read (nth 1 faceinfo)) temp-face)
! (setcar faceinfo nil)
! (setcar (cdr faceinfo) nil))
! (setq marks (delq nil marks))
! ;; Apply the font aspects
! (apply 'set-face-attribute temp-face nil marks)
! (search-backward entry)
! (overlay-put
! (make-overlay (match-beginning 0) (match-end 0)) 'face
temp-face))
! ))
! (setq entry-list (cdr entry-list))))
(set-buffer-modified-p nil)
(goto-char (point-min))
(setq buffer-read-only t)
***************
*** 690,702 ****
`mark-diary-entries-hook' are run."
(interactive)
(setq mark-diary-entries-in-calendar t)
! (let ((d-file (substitute-in-file-name diary-file))
(marking-diary-entries t))
(if (and d-file (file-exists-p d-file))
(if (file-readable-p d-file)
(save-excursion
(message "Marking diary entries...")
(set-buffer (find-file-noselect d-file t))
(let ((d diary-date-forms)
(old-diary-syntax-table))
(setq old-diary-syntax-table (syntax-table))
--- 791,806 ----
`mark-diary-entries-hook' are run."
(interactive)
(setq mark-diary-entries-in-calendar t)
! (let (file-glob-attrs
! marks
! (d-file (substitute-in-file-name diary-file))
(marking-diary-entries t))
(if (and d-file (file-exists-p d-file))
(if (file-readable-p d-file)
(save-excursion
(message "Marking diary entries...")
(set-buffer (find-file-noselect d-file t))
+ (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(let ((d diary-date-forms)
(old-diary-syntax-table))
(setq old-diary-syntax-table (syntax-table))
***************
*** 774,800 ****
(if (> (- current-y y) 50)
(+ y 100)
y)))
! (string-to-int y-str)))))
! (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))))))
! (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))))
(setq d (cdr d))))
(mark-sexp-diary-entries)
(run-hooks 'nongregorian-diary-marking-hook
--- 878,909 ----
(if (> (- current-y y) 50)
(+ y 100)
y)))
! (string-to-int 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-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)
(run-hooks 'nongregorian-diary-marking-hook
***************
*** 817,823 ****
(y)
(first-date)
(last-date)
! (mark))
(save-excursion
(set-buffer calendar-buffer)
(setq m displayed-month)
--- 926,934 ----
(y)
(first-date)
(last-date)
! (mark)
! file-glob-attrs)
! (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(save-excursion
(set-buffer calendar-buffer)
(setq m displayed-month)
***************
*** 867,876 ****
(calendar-for-loop date from first-date to last-date do
(if (setq mark (diary-sexp-entry sexp entry
(calendar-gregorian-from-absolute date)))
! (mark-visible-calendar-date
! (calendar-gregorian-from-absolute date)
! (if (consp mark)
! (car mark)))))))))
(defun mark-included-diary-files ()
"Mark the diary entries from other diary files with those of the diary file.
--- 978,993 ----
(calendar-for-loop date from first-date to last-date do
(if (setq mark (diary-sexp-entry sexp entry
(calendar-gregorian-from-absolute date)))
! (progn
! (setq marks (diary-pull-attrs entry file-glob-attrs)
! temp (diary-pull-attrs entry file-glob-attrs)
! marks (nth 1 temp))
! (mark-visible-calendar-date
! (calendar-gregorian-from-absolute date)
! (if (< 0 (length marks))
! marks
! (if (consp mark)
! (car mark)))))))))))
(defun mark-included-diary-files ()
"Mark the diary entries from other diary files with those of the diary file.
***************
*** 905,911 ****
(sleep-for 2))))
(goto-char (point-min)))
! (defun mark-calendar-days-named (dayname)
"Mark all dates in the calendar window that are day DAYNAME of the week.
0 means all Sundays, 1 means all Mondays, and so on."
(save-excursion
--- 1022,1028 ----
(sleep-for 2))))
(goto-char (point-min)))
! (defun mark-calendar-days-named (dayname &optional color)
"Mark all dates in the calendar window that are day DAYNAME of the week.
0 means all Sundays, 1 means all Mondays, and so on."
(save-excursion
***************
*** 923,932 ****
(setq last-day (calendar-absolute-from-gregorian
(calendar-nth-named-day -1 dayname succ-month succ-year)))
(while (<= day last-day)
! (mark-visible-calendar-date (calendar-gregorian-from-absolute day))
(setq day (+ day 7))))))
! (defun mark-calendar-date-pattern (month day year)
"Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard."
(save-excursion
--- 1040,1049 ----
(setq last-day (calendar-absolute-from-gregorian
(calendar-nth-named-day -1 dayname succ-month succ-year)))
(while (<= day last-day)
! (mark-visible-calendar-date (calendar-gregorian-from-absolute day)
color)
(setq day (+ day 7))))))
! (defun mark-calendar-date-pattern (month day year &optional color)
"Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard."
(save-excursion
***************
*** 935,944 ****
(y displayed-year))
(increment-calendar-month m y -1)
(calendar-for-loop i from 0 to 2 do
! (mark-calendar-month m y month day year)
(increment-calendar-month m y 1)))))
! (defun mark-calendar-month (month year p-month p-day p-year)
"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
A value of 0 in any position of the pattern is a wildcard."
(if (or (and (= month p-month)
--- 1052,1061 ----
(y displayed-year))
(increment-calendar-month m y -1)
(calendar-for-loop i from 0 to 2 do
! (mark-calendar-month m y month day year color)
(increment-calendar-month m y 1)))))
! (defun mark-calendar-month (month year p-month p-day p-year &optional color)
"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
A value of 0 in any position of the pattern is a wildcard."
(if (or (and (= month p-month)
***************
*** 948,955 ****
(if (= p-day 0)
(calendar-for-loop
i from 1 to (calendar-last-day-of-month month year) do
! (mark-visible-calendar-date (list month i year)))
! (mark-visible-calendar-date (list month p-day year)))))
(defun sort-diary-entries ()
"Sort the list of diary entries by time of day."
--- 1065,1072 ----
(if (= p-day 0)
(calendar-for-loop
i from 1 to (calendar-last-day-of-month month year) do
! (mark-visible-calendar-date (list month i year) color))
! (mark-visible-calendar-date (list month p-day year) color))))
(defun sort-diary-entries ()
"Sort the list of diary entries by time of day."
***************
*** 1170,1177 ****
(let* ((mark (regexp-quote diary-nonmarking-symbol))
(sexp-mark (regexp-quote sexp-diary-entry-symbol))
(s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "("))
! (entry-found))
(goto-char (point-min))
(while (re-search-forward s-entry nil t)
(backward-char 1)
(let ((sexp-start (point))
--- 1287,1298 ----
(let* ((mark (regexp-quote diary-nonmarking-symbol))
(sexp-mark (regexp-quote sexp-diary-entry-symbol))
(s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "("))
! (entry-found)
! (file-glob-attrs)
! (marks))
(goto-char (point-min))
+ (save-excursion
+ (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))))
(while (re-search-forward s-entry nil t)
(backward-char 1)
(let ((sexp-start (point))
***************
*** 1204,1218 ****
(while (string-match "[\^M]" entry)
(aset entry (match-beginning 0) ?\n )))
(let ((diary-entry (diary-sexp-entry sexp entry date)))
(if diary-entry
! (subst-char-in-region line-start (point) ?\^M ?\n t))
! (add-to-diary-list date
! (if (consp diary-entry)
! (cdr diary-entry)
! diary-entry)
specifier
(if entry-start (copy-marker entry-start)
! nil))
(setq entry-found (or entry-found diary-entry)))))
entry-found))
--- 1325,1346 ----
(while (string-match "[\^M]" entry)
(aset entry (match-beginning 0) ?\n )))
(let ((diary-entry (diary-sexp-entry sexp entry date)))
+ (setq entry (if (consp diary-entry)
+ (cdr diary-entry)
+ diary-entry))
(if diary-entry
! (progn
! (subst-char-in-region line-start (point) ?\^M ?\n t)
! (if (< 0 (length entry))
! (setq temp (diary-pull-attrs entry file-glob-attrs)
! entry (nth 0 temp)
! marks (nth 1 temp)))))
! (add-to-diary-list date
! entry
specifier
(if entry-start (copy-marker entry-start)
! nil)
! marks)
(setq entry-found (or entry-found diary-entry)))))
entry-found))
***************
*** 1470,1482 ****
(or (diary-remind sexp (car days) marking)
(diary-remind sexp (cdr days) marking))))))
! (defun add-to-diary-list (date string specifier marker)
! "Add the entry (DATE STRING SPECIFIER) to `diary-entries-list'.
Do nothing if DATE or STRING is nil."
(and date string
(setq diary-entries-list
(append diary-entries-list
! (list (list date string specifier marker))))))
(defun make-diary-entry (string &optional nonmarking file)
"Insert a diary entry STRING which may be NONMARKING in FILE.
--- 1598,1615 ----
(or (diary-remind sexp (car days) marking)
(diary-remind sexp (cdr days) marking))))))
! (defun add-to-diary-list (date string specifier marker &optional globcolor)
! "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to
`diary-entries-list'.
Do nothing if DATE or STRING is nil."
(and date string
+ (if (and diary-file-name-prefix
+ (setq prefix (concat "[" (funcall
diary-file-name-prefix-function (buffer-file-name)) "] "))
+ (not (string= prefix "[] ")))
+ (setq string (concat prefix string))
+ t)
(setq diary-entries-list
(append diary-entries-list
! (list (list date string specifier marker globcolor))))))
(defun make-diary-entry (string &optional nonmarking file)
"Insert a diary entry STRING which may be NONMARKING in FILE.
- [Emacs-diffs] Changes to emacs/lisp/calendar/diary-lib.el,
Miles Bader <=