*** diary-lib.el 2002-12-10 09:16:11.000000000 -0800 --- /usr/local/emacs/share/emacs/21.2.50/lisp/calendar/diary-lib.el 2002-08-28 08:16:15.000000000 -0700 *************** *** 246,261 **** (set-buffer (find-file-noselect d-file t)) (set-buffer diary-buffer) (or (verify-visited-file-modtime diary-buffer) (revert-buffer t t)))) - ;; AMI -- Figure out the file-glob-color - (setq file-glob-color "") - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^#[ \t]*\\[color:\\([a-z]+\\)\\]$" (point-max) t) - (setq file-glob-color (buffer-substring-no-properties - (match-beginning 1) - (match-end 1))))) (setq selective-display t) (setq selective-display-ellipses nil) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) --- 246,253 ---- *************** *** 334,349 **** date (buffer-substring entry-start (point)) (buffer-substring ! (1+ date-start) (1- entry-start)) file-glob-color))))) (setq d (cdr d))) (or entry-found (not diary-list-include-blanks) (setq diary-entries-list (append diary-entries-list ! ;; AMI -- added a fourth element to a diary-entries-list element ! (list (list date "" "" ""))))) (setq date (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian date)))) (setq entry-found nil))) --- 326,340 ---- date (buffer-substring entry-start (point)) (buffer-substring ! (1+ date-start) (1- 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)))) (setq entry-found nil))) *************** *** 518,548 **** x) 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 ! (insert entry ?\n) ! ;; AMI -- pick off the color that was the global file color for this entry when it was read in ! (setq file-glob-color (fourth (car entry-list))) ! ;; AMI - find color for this diary entry if one is present ! (setq color file-glob-color) ! (save-excursion ! (if (string-match "\\[color:\\([a-z]+\\)\\]$" entry) ! (setq color (substring-no-properties entry ! (match-beginning 1) ! (match-end 1)))) ! (if (not (string= color "")) ! (progn ! (search-backward entry) ! (setq temp-face (make-symbol (concat "cal-col-face-" color))) ! (make-face temp-face) ! (set-face-foreground temp-face color) ! (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) (display-buffer fancy-diary-buffer) --- 509,519 ---- x) date-holiday-list (concat "\n" (make-string l ? )))) (insert ?\n (make-string (+ l longest) ?=) ?\n))))) ! (if (< 0 (length (car (cdr (car entry-list))))) ! (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) (display-buffer fancy-diary-buffer) *************** *** 664,674 **** 0 1 * * * diary-rem.sh to run it every morning at 1am." (interactive "P") (let* ((diary-display-hook 'fancy-diary-display) ! ; AMI ! ; Do this so that I have a chance to NOT include blanks in the email ! ; (diary-list-include-blanks t) (text (progn (list-diary-entries (calendar-current-date) (if ndays ndays diary-mail-days)) (set-buffer fancy-diary-buffer) (buffer-substring (point-min) (point-max))))) --- 635,643 ---- 0 1 * * * diary-rem.sh to run it every morning at 1am." (interactive "P") (let* ((diary-display-hook 'fancy-diary-display) ! (diary-list-include-blanks t) (text (progn (list-diary-entries (calendar-current-date) (if ndays ndays diary-mail-days)) (set-buffer fancy-diary-buffer) (buffer-substring (point-min) (point-max))))) *************** *** 719,734 **** (if (file-readable-p d-file) (save-excursion (message "Marking diary entries...") (set-buffer (find-file-noselect d-file t)) - ;; AMI - find global color for this file - (setq file-glob-color "") - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^#[ \t]*\\[color:\\([a-z]+\\)\\]$" (point-max) t) - (setq file-glob-color (buffer-substring-no-properties - (match-beginning 1) - (match-end 1))))) (let ((d diary-date-forms) (old-diary-syntax-table)) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) --- 688,695 ---- *************** *** 805,827 **** (if (> (- current-y y) 50) (+ y 100) y))) (string-to-int y-str))))) - ;; AMI - find color for this diary entry - (setq color file-glob-color) - (save-excursion - (if (re-search-forward "\\[color:\\([a-z]+\\)\\]$" (line-end-position) t) - (setq color (buffer-substring-no-properties - (match-beginning 1) - (match-end 1))))) (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))))) color) (if mm-name (if (string-equal mm-name "*") (setq mm 0) (setq mm --- 766,781 ---- (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 *************** *** 831,839 **** calendar-month-name-array 1 (lambda (x) (substring x 0 3))) ))))) ! (mark-calendar-date-pattern mm dd yy color)))) (setq d (cdr d)))) (mark-sexp-diary-entries) (run-hooks 'nongregorian-diary-marking-hook 'mark-diary-entries-hook) --- 785,793 ---- 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 'mark-diary-entries-hook) *************** *** 887,895 **** (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) (progn;; Diary entry consists only of the sexp (backward-char 1) ! (setq entry "" color nil)) (setq entry-start (point)) ;; Find end of entry (re-search-forward "\^M\\|\n" nil t) (while (looking-at " \\|\^I") --- 841,849 ---- (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) (progn;; Diary entry consists only of the sexp (backward-char 1) ! (setq entry "")) (setq entry-start (point)) ;; Find end of entry (re-search-forward "\^M\\|\n" nil t) (while (looking-at " \\|\^I") *************** *** 903,920 **** (aset entry (match-beginning 0) ?\n ))) (calendar-for-loop date from first-date to last-date do (if (diary-sexp-entry sexp entry (calendar-gregorian-from-absolute date)) ! ;; AMI - find color for this diary entry ! (progn ! (setq color "") ! (save-excursion ! (if (string-match "\\[color:\\([a-z]+\\)\\]$" entry) ! (setq color (substring-no-properties entry ! (match-beginning 1) ! (match-end 1))))) ! (mark-visible-calendar-date ! (calendar-gregorian-from-absolute date) color)))))))) (defun mark-included-diary-files () "Mark the diary entries from other diary files with those of the diary file. This function is suitable for use as the `mark-diary-entries-hook'; it enables --- 857,866 ---- (aset entry (match-beginning 0) ?\n ))) (calendar-for-loop date from first-date to last-date do (if (diary-sexp-entry sexp entry (calendar-gregorian-from-absolute date)) ! (mark-visible-calendar-date ! (calendar-gregorian-from-absolute date)))))))) (defun mark-included-diary-files () "Mark the diary entries from other diary files with those of the diary file. This function is suitable for use as the `mark-diary-entries-hook'; it enables *************** *** 947,955 **** (message "Can't find included diary file %s" diary-file) (sleep-for 2)))) (goto-char (point-min))) ! (defun mark-calendar-days-named (dayname 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 (set-buffer calendar-buffer) --- 893,901 ---- (message "Can't find included diary file %s" diary-file) (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 (set-buffer calendar-buffer) *************** *** 965,989 **** (calendar-nth-named-day 1 dayname prev-month prev-year))) (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 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 (set-buffer calendar-buffer) (let ((m displayed-month) (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 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) (or (= p-year 0) (= year p-year))) --- 911,934 ---- (calendar-nth-named-day 1 dayname prev-month prev-year))) (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 (set-buffer calendar-buffer) (let ((m displayed-month) (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) (or (= p-year 0) (= year p-year))) *************** *** 991,1000 **** (or (= p-year 0) (= year p-year)))) (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." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) --- 936,945 ---- (or (= p-year 0) (= year p-year)))) (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." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) *************** *** 1205,1217 **** (sexp-mark (regexp-quote sexp-diary-entry-symbol)) (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) (entry-found)) (goto-char (point-min)) - (save-excursion - (if (re-search-forward "^#[ \t]*\\[color:\\([a-z]+\\)\\]$" (point-max) t) - (setq file-glob-color (buffer-substring-no-properties - (match-beginning 1) - (match-end 1))))) (while (re-search-forward s-entry nil t) (backward-char 1) (let ((sexp-start (point)) (sexp) --- 1150,1157 ---- *************** *** 1243,1251 **** (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 diary-entry specifier file-glob-color) (setq entry-found (or entry-found diary-entry))))) entry-found)) (defun diary-sexp-entry (sexp entry date) --- 1183,1191 ---- (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 diary-entry specifier) (setq entry-found (or entry-found diary-entry))))) entry-found)) (defun diary-sexp-entry (sexp entry date) *************** *** 1486,1499 **** ((and (listp days) days) (or (diary-remind sexp (car days) marking) (diary-remind sexp (cdr days) marking)))))) ! (defun add-to-diary-list (date string specifier globcolor) ! "Add the entry (DATE STRING SPECIFIER GLOBCOLOR) 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 globcolor)))))) (defun make-diary-entry (string &optional nonmarking file) "Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." --- 1426,1439 ---- ((and (listp days) days) (or (diary-remind sexp (car days) marking) (diary-remind sexp (cdr days) marking)))))) ! (defun add-to-diary-list (date string specifier) ! "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)))))) (defun make-diary-entry (string &optional nonmarking file) "Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."