Mercurial > emacs

comparison lisp/calendar/diary-lib.el @ 49737:a8a5fd61aada

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(diary-attrtype-convert): Convert an attribute value string to the desired type. (diary-pull-attrs): New function that pulls the attributes off a diary entry, merges with file-global attributes, and returns the (possibly modified) entry and a list of attribute/values using diary-attrtype-convert above. (list-diary-entries, fancy-diary-display, show-all-diary-entries) (mark-diary-entries, mark-sexp-diary-entries, list-sexp-diary-entries): Add handling of file-global attributes, add handling of entry attributes using diary-pull-attrs above. (mark-calendar-days-named, mark-calendar-days-named, mark-calendar-date-pattern) (mark-calendar-month, add-to-diary-list): Add optional paramater `color' for passing face attribute info through the callchain. Pass this parameter around.
author Juanma Barranquero <lekktu@gmail.com>
date Tue, 11 Feb 2003 23:25:15 +0000
parents 0d8b17d428b5
children fa4e7ecda348 d7ddb3e565de
comparison
equal deleted inserted replaced
49736:dd8404d4fed8 49737:a8a5fd61aada
183 (defvar number) 183 (defvar number)
184 (defvar date-string) 184 (defvar date-string)
185 (defvar d-file) 185 (defvar d-file)
186 (defvar original-date) 186 (defvar original-date)
187 187
188 (defun diary-attrtype-convert (attrvalue type)
189 "Convert the attrvalue from a string to the appropriate type for using
190 in a face description"
191 (let (ret)
192 (setq ret (cond ((eq type 'string) attrvalue)
193 ((eq type 'symbol) (read attrvalue))
194 ((eq type 'int) (string-to-int attrvalue))
195 ((eq type 'stringtnil)
196 (cond ((string= "t" attrvalue) t)
197 ((string= "nil" attrvalue) nil)
198 (t attrvalue)))
199 ((eq type 'tnil)
200 (cond ((string= "t" attrvalue) t)
201 ((string= "nil" attrvalue) nil)))))
202 ; (message "(%s)[%s]=[%s]" (print type) attrvalue ret)
203 ret))
204
205
206 (defun diary-pull-attrs (entry fileglobattrs)
207 "Pull the face-related attributes off the entry, merge with the
208 fileglobattrs, and return the (possibly modified) entry and face
209 data in a list of attrname attrvalue values.
210 The entry will be modified to drop all tags that are used for face matching.
211 If entry is nil, then the fileglobattrs are being searched for,
212 the fileglobattrs variable is ignored, and
213 diary-glob-file-regexp-prefix is prepended to the regexps before each
214 search."
215 (save-excursion
216 (let (regexp regnum attrname attr-list attrname attrvalue type)
217 (if (null entry)
218 (progn
219 (setq ret-attr '()
220 attr-list diary-face-attrs)
221 (while attr-list
222 (goto-char (point-min))
223 (setq attr (car attr-list)
224 regexp (nth 0 attr)
225 regnum (nth 1 attr)
226 attrname (nth 2 attr)
227 type (nth 3 attr)
228 regexp (concat diary-glob-file-regexp-prefix regexp))
229 (setq attrvalue nil)
230 (if (re-search-forward regexp (point-max) t)
231 (setq attrvalue (buffer-substring-no-properties
232 (match-beginning regnum)
233 (match-end regnum))))
234 (if (and attrvalue
235 (setq attrvalue (diary-attrtype-convert attrvalue type)))
236 (setq ret-attr (append ret-attr (list attrname attrvalue))))
237 (setq attr-list (cdr attr-list)))
238 (setq fileglobattrs ret-attr))
239 (progn
240 (setq ret-attr fileglobattrs
241 attr-list diary-face-attrs)
242 (while attr-list
243 (goto-char (point-min))
244 (setq attr (car attr-list)
245 regexp (nth 0 attr)
246 regnum (nth 1 attr)
247 attrname (nth 2 attr)
248 type (nth 3 attr))
249 (setq attrvalue nil)
250 (if (string-match regexp entry)
251 (progn
252 (setq attrvalue (substring-no-properties entry
253 (match-beginning regnum)
254 (match-end regnum)))
255 (setq entry (replace-match "" t t entry))))
256 (if (and attrvalue
257 (setq attrvalue (diary-attrtype-convert attrvalue type)))
258 (setq ret-attr (append ret-attr (list attrname attrvalue))))
259 (setq attr-list (cdr attr-list)))))))
260 (list entry ret-attr))
261
262
263
188 (defun list-diary-entries (date number) 264 (defun list-diary-entries (date number)
189 "Create and display a buffer containing the relevant lines in diary-file. 265 "Create and display a buffer containing the relevant lines in diary-file.
190 The arguments are DATE and NUMBER; the entries selected are those 266 The arguments are DATE and NUMBER; the entries selected are those
191 for NUMBER days starting with date DATE. The other entries are hidden 267 for NUMBER days starting with date DATE. The other entries are hidden
192 using selective display. 268 using selective display.
221 297
222 (if (< 0 number) 298 (if (< 0 number)
223 (let* ((original-date date);; save for possible use in the hooks 299 (let* ((original-date date);; save for possible use in the hooks
224 old-diary-syntax-table 300 old-diary-syntax-table
225 diary-entries-list 301 diary-entries-list
302 file-glob-attrs
226 (date-string (calendar-date-string date)) 303 (date-string (calendar-date-string date))
227 (d-file (substitute-in-file-name diary-file))) 304 (d-file (substitute-in-file-name diary-file)))
228 (message "Preparing diary...") 305 (message "Preparing diary...")
229 (save-excursion 306 (save-excursion
230 (let ((diary-buffer (find-buffer-visiting d-file))) 307 (let ((diary-buffer (find-buffer-visiting d-file)))
231 (if (not diary-buffer) 308 (if (not diary-buffer)
232 (set-buffer (find-file-noselect d-file t)) 309 (set-buffer (find-file-noselect d-file t))
233 (set-buffer diary-buffer) 310 (set-buffer diary-buffer)
234 (or (verify-visited-file-modtime diary-buffer) 311 (or (verify-visited-file-modtime diary-buffer)
235 (revert-buffer t t)))) 312 (revert-buffer t t))))
313 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil "")))
236 (setq selective-display t) 314 (setq selective-display t)
237 (setq selective-display-ellipses nil) 315 (setq selective-display-ellipses nil)
238 (setq old-diary-syntax-table (syntax-table)) 316 (setq old-diary-syntax-table (syntax-table))
239 (set-syntax-table diary-syntax-table) 317 (set-syntax-table diary-syntax-table)
240 (unwind-protect 318 (unwind-protect
306 (while (looking-at " \\|\^I") 384 (while (looking-at " \\|\^I")
307 (re-search-forward "\^M\\|\n" nil t)) 385 (re-search-forward "\^M\\|\n" nil t))
308 (backward-char 1) 386 (backward-char 1)
309 (subst-char-in-region date-start 387 (subst-char-in-region date-start
310 (point) ?\^M ?\n t) 388 (point) ?\^M ?\n t)
389 (setq entry (buffer-substring entry-start (point))
390 temp (diary-pull-attrs entry file-glob-attrs)
391 entry (nth 0 temp)
392 marks (nth 1 temp))
311 (add-to-diary-list 393 (add-to-diary-list
312 date 394 date
313 (buffer-substring 395 entry
314 entry-start (point))
315 (buffer-substring 396 (buffer-substring
316 (1+ date-start) (1- entry-start)) 397 (1+ date-start) (1- entry-start))
317 (copy-marker entry-start)))))) 398 (copy-marker entry-start) marks)))))
318 (setq d (cdr d))) 399 (setq d (cdr d)))
319 (or entry-found 400 (or entry-found
320 (not diary-list-include-blanks) 401 (not diary-list-include-blanks)
321 (setq diary-entries-list 402 (setq diary-entries-list
322 (append diary-entries-list 403 (append diary-entries-list
323 (list (list date "" ""))))) 404 (list (list date "" "" "" "")))))
324 (setq date 405 (setq date
325 (calendar-gregorian-from-absolute 406 (calendar-gregorian-from-absolute
326 (1+ (calendar-absolute-from-gregorian date)))) 407 (1+ (calendar-absolute-from-gregorian date))))
327 (setq entry-found nil))) 408 (setq entry-found nil)))
328 (set-buffer-modified-p diary-modified)) 409 (set-buffer-modified-p diary-modified))
511 (setq longest (length x))) 592 (setq longest (length x)))
512 x) 593 x)
513 date-holiday-list 594 date-holiday-list
514 (concat "\n" (make-string l ? )))) 595 (concat "\n" (make-string l ? ))))
515 (insert ?\n (make-string (+ l longest) ?=) ?\n))))) 596 (insert ?\n (make-string (+ l longest) ?=) ?\n)))))
516 (if (< 0 (length (car (cdr (car entry-list))))) 597
517 (if (nth 3 (car entry-list)) 598 (setq entry (car (cdr (car entry-list))))
518 (insert-button (concat (car (cdr (car entry-list))) "\n") 599 (if (< 0 (length entry))
519 'marker (nth 3 (car entry-list)) 600 (progn
520 :type 'diary-entry) 601 (if (nth 3 (car entry-list))
521 (insert (car (cdr (car entry-list))) ?\n))) 602 (insert-button (concat entry "\n")
522 (setq entry-list (cdr entry-list)))) 603 'marker (nth 3 (car entry-list))
604 :type 'diary-entry)
605 (insert entry ?\n))
606 (save-excursion
607 (setq marks (nth 4 (car entry-list)))
608 (setq temp-face (make-symbol (apply 'concat "temp-face-" (mapcar '(lambda (sym) (if (not (stringp sym)) (symbol-name sym) sym)) marks))))
609 (make-face temp-face)
610 ;; Remove :face info from the marks, copy the face info into temp-face
611 (setq faceinfo marks)
612 (while (setq faceinfo (memq :face faceinfo))
613 (copy-face (read (nth 1 faceinfo)) temp-face)
614 (setcar faceinfo nil)
615 (setcar (cdr faceinfo) nil))
616 (setq marks (delq nil marks))
617 ;; Apply the font aspects
618 (apply 'set-face-attribute temp-face nil marks)
619 (search-backward entry)
620 (overlay-put
621 (make-overlay (match-beginning 0) (match-end 0)) 'face temp-face))
622 ))
623 (setq entry-list (cdr entry-list))))
523 (set-buffer-modified-p nil) 624 (set-buffer-modified-p nil)
524 (goto-char (point-min)) 625 (goto-char (point-min))
525 (setq buffer-read-only t) 626 (setq buffer-read-only t)
526 (display-buffer fancy-diary-buffer) 627 (display-buffer fancy-diary-buffer)
527 (fancy-diary-display-mode) 628 (fancy-diary-display-mode)
688 Each entry in the diary file visible in the calendar window is marked. 789 Each entry in the diary file visible in the calendar window is marked.
689 After the entries are marked, the hooks `nongregorian-diary-marking-hook' and 790 After the entries are marked, the hooks `nongregorian-diary-marking-hook' and
690 `mark-diary-entries-hook' are run." 791 `mark-diary-entries-hook' are run."
691 (interactive) 792 (interactive)
692 (setq mark-diary-entries-in-calendar t) 793 (setq mark-diary-entries-in-calendar t)
693 (let ((d-file (substitute-in-file-name diary-file)) 794 (let (file-glob-attrs
795 marks
796 (d-file (substitute-in-file-name diary-file))
694 (marking-diary-entries t)) 797 (marking-diary-entries t))
695 (if (and d-file (file-exists-p d-file)) 798 (if (and d-file (file-exists-p d-file))
696 (if (file-readable-p d-file) 799 (if (file-readable-p d-file)
697 (save-excursion 800 (save-excursion
698 (message "Marking diary entries...") 801 (message "Marking diary entries...")
699 (set-buffer (find-file-noselect d-file t)) 802 (set-buffer (find-file-noselect d-file t))
803 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
700 (let ((d diary-date-forms) 804 (let ((d diary-date-forms)
701 (old-diary-syntax-table)) 805 (old-diary-syntax-table))
702 (setq old-diary-syntax-table (syntax-table)) 806 (setq old-diary-syntax-table (syntax-table))
703 (set-syntax-table diary-syntax-table) 807 (set-syntax-table diary-syntax-table)
704 (while d 808 (while d
772 (if (> (- y current-y) 50) 876 (if (> (- y current-y) 50)
773 (- y 100) 877 (- y 100)
774 (if (> (- current-y y) 50) 878 (if (> (- current-y y) 50)
775 (+ y 100) 879 (+ y 100)
776 y))) 880 y)))
777 (string-to-int y-str))))) 881 (string-to-int y-str))))
778 (if dd-name 882 (save-excursion
779 (mark-calendar-days-named 883 (setq entry (buffer-substring-no-properties (point) (line-end-position))
780 (cdr (assoc-ignore-case 884 temp (diary-pull-attrs entry file-glob-attrs)
781 (substring dd-name 0 3) 885 entry (nth 0 temp)
782 (calendar-make-alist 886 marks (nth 1 temp))))
783 calendar-day-name-array 887 (if dd-name
784 0 888 (mark-calendar-days-named
785 (lambda (x) (substring x 0 3)))))) 889 (cdr (assoc-ignore-case
786 (if mm-name 890 (substring dd-name 0 3)
787 (if (string-equal mm-name "*") 891 (calendar-make-alist
788 (setq mm 0) 892 calendar-day-name-array
789 (setq mm 893 0
790 (cdr (assoc-ignore-case 894 (lambda (x) (substring x 0 3))))) marks)
791 (substring mm-name 0 3) 895 (if mm-name
792 (calendar-make-alist 896 (if (string-equal mm-name "*")
793 calendar-month-name-array 897 (setq mm 0)
794 1 898 (setq mm
795 (lambda (x) (substring x 0 3))) 899 (cdr (assoc-ignore-case
796 ))))) 900 (substring mm-name 0 3)
797 (mark-calendar-date-pattern mm dd yy)))) 901 (calendar-make-alist
902 calendar-month-name-array
903 1
904 (lambda (x) (substring x 0 3)))
905 )))))
906 (mark-calendar-date-pattern mm dd yy marks))))
798 (setq d (cdr d)))) 907 (setq d (cdr d))))
799 (mark-sexp-diary-entries) 908 (mark-sexp-diary-entries)
800 (run-hooks 'nongregorian-diary-marking-hook 909 (run-hooks 'nongregorian-diary-marking-hook
801 'mark-diary-entries-hook) 910 'mark-diary-entries-hook)
802 (set-syntax-table old-diary-syntax-table) 911 (set-syntax-table old-diary-syntax-table)
815 (regexp-quote sexp-mark) "(diary-remind\\)")) 924 (regexp-quote sexp-mark) "(diary-remind\\)"))
816 (m) 925 (m)
817 (y) 926 (y)
818 (first-date) 927 (first-date)
819 (last-date) 928 (last-date)
820 (mark)) 929 (mark)
930 file-glob-attrs)
931 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
821 (save-excursion 932 (save-excursion
822 (set-buffer calendar-buffer) 933 (set-buffer calendar-buffer)
823 (setq m displayed-month) 934 (setq m displayed-month)
824 (setq y displayed-year)) 935 (setq y displayed-year))
825 (increment-calendar-month m y -1) 936 (increment-calendar-month m y -1)
865 (while (string-match "[\^M]" entry) 976 (while (string-match "[\^M]" entry)
866 (aset entry (match-beginning 0) ?\n ))) 977 (aset entry (match-beginning 0) ?\n )))
867 (calendar-for-loop date from first-date to last-date do 978 (calendar-for-loop date from first-date to last-date do
868 (if (setq mark (diary-sexp-entry sexp entry 979 (if (setq mark (diary-sexp-entry sexp entry
869 (calendar-gregorian-from-absolute date))) 980 (calendar-gregorian-from-absolute date)))
870 (mark-visible-calendar-date 981 (progn
871 (calendar-gregorian-from-absolute date) 982 (setq marks (diary-pull-attrs entry file-glob-attrs)
872 (if (consp mark) 983 temp (diary-pull-attrs entry file-glob-attrs)
873 (car mark))))))))) 984 marks (nth 1 temp))
985 (mark-visible-calendar-date
986 (calendar-gregorian-from-absolute date)
987 (if (< 0 (length marks))
988 marks
989 (if (consp mark)
990 (car mark)))))))))))
874 991
875 (defun mark-included-diary-files () 992 (defun mark-included-diary-files ()
876 "Mark the diary entries from other diary files with those of the diary file. 993 "Mark the diary entries from other diary files with those of the diary file.
877 This function is suitable for use as the `mark-diary-entries-hook'; it enables 994 This function is suitable for use as the `mark-diary-entries-hook'; it enables
878 you to use shared diary files together with your own. The files included are 995 you to use shared diary files together with your own. The files included are
903 (beep) 1020 (beep)
904 (message "Can't find included diary file %s" diary-file) 1021 (message "Can't find included diary file %s" diary-file)
905 (sleep-for 2)))) 1022 (sleep-for 2))))
906 (goto-char (point-min))) 1023 (goto-char (point-min)))
907 1024
908 (defun mark-calendar-days-named (dayname) 1025 (defun mark-calendar-days-named (dayname &optional color)
909 "Mark all dates in the calendar window that are day DAYNAME of the week. 1026 "Mark all dates in the calendar window that are day DAYNAME of the week.
910 0 means all Sundays, 1 means all Mondays, and so on." 1027 0 means all Sundays, 1 means all Mondays, and so on."
911 (save-excursion 1028 (save-excursion
912 (set-buffer calendar-buffer) 1029 (set-buffer calendar-buffer)
913 (let ((prev-month displayed-month) 1030 (let ((prev-month displayed-month)
921 (setq day (calendar-absolute-from-gregorian 1038 (setq day (calendar-absolute-from-gregorian
922 (calendar-nth-named-day 1 dayname prev-month prev-year))) 1039 (calendar-nth-named-day 1 dayname prev-month prev-year)))
923 (setq last-day (calendar-absolute-from-gregorian 1040 (setq last-day (calendar-absolute-from-gregorian
924 (calendar-nth-named-day -1 dayname succ-month succ-year))) 1041 (calendar-nth-named-day -1 dayname succ-month succ-year)))
925 (while (<= day last-day) 1042 (while (<= day last-day)
926 (mark-visible-calendar-date (calendar-gregorian-from-absolute day)) 1043 (mark-visible-calendar-date (calendar-gregorian-from-absolute day) color)
927 (setq day (+ day 7)))))) 1044 (setq day (+ day 7))))))
928 1045
929 (defun mark-calendar-date-pattern (month day year) 1046 (defun mark-calendar-date-pattern (month day year &optional color)
930 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. 1047 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
931 A value of 0 in any position is a wildcard." 1048 A value of 0 in any position is a wildcard."
932 (save-excursion 1049 (save-excursion
933 (set-buffer calendar-buffer) 1050 (set-buffer calendar-buffer)
934 (let ((m displayed-month) 1051 (let ((m displayed-month)
935 (y displayed-year)) 1052 (y displayed-year))
936 (increment-calendar-month m y -1) 1053 (increment-calendar-month m y -1)
937 (calendar-for-loop i from 0 to 2 do 1054 (calendar-for-loop i from 0 to 2 do
938 (mark-calendar-month m y month day year) 1055 (mark-calendar-month m y month day year color)
939 (increment-calendar-month m y 1))))) 1056 (increment-calendar-month m y 1)))))
940 1057
941 (defun mark-calendar-month (month year p-month p-day p-year) 1058 (defun mark-calendar-month (month year p-month p-day p-year &optional color)
942 "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. 1059 "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
943 A value of 0 in any position of the pattern is a wildcard." 1060 A value of 0 in any position of the pattern is a wildcard."
944 (if (or (and (= month p-month) 1061 (if (or (and (= month p-month)
945 (or (= p-year 0) (= year p-year))) 1062 (or (= p-year 0) (= year p-year)))
946 (and (= p-month 0) 1063 (and (= p-month 0)
947 (or (= p-year 0) (= year p-year)))) 1064 (or (= p-year 0) (= year p-year))))
948 (if (= p-day 0) 1065 (if (= p-day 0)
949 (calendar-for-loop 1066 (calendar-for-loop
950 i from 1 to (calendar-last-day-of-month month year) do 1067 i from 1 to (calendar-last-day-of-month month year) do
951 (mark-visible-calendar-date (list month i year))) 1068 (mark-visible-calendar-date (list month i year) color))
952 (mark-visible-calendar-date (list month p-day year))))) 1069 (mark-visible-calendar-date (list month p-day year) color))))
953 1070
954 (defun sort-diary-entries () 1071 (defun sort-diary-entries ()
955 "Sort the list of diary entries by time of day." 1072 "Sort the list of diary entries by time of day."
956 (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) 1073 (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
957 1074
1168 Marking these entries is *extremely* time consuming, so these entries are 1285 Marking these entries is *extremely* time consuming, so these entries are
1169 best if they are nonmarking." 1286 best if they are nonmarking."
1170 (let* ((mark (regexp-quote diary-nonmarking-symbol)) 1287 (let* ((mark (regexp-quote diary-nonmarking-symbol))
1171 (sexp-mark (regexp-quote sexp-diary-entry-symbol)) 1288 (sexp-mark (regexp-quote sexp-diary-entry-symbol))
1172 (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) 1289 (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "("))
1173 (entry-found)) 1290 (entry-found)
1291 (file-glob-attrs)
1292 (marks))
1174 (goto-char (point-min)) 1293 (goto-char (point-min))
1294 (save-excursion
1295 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))))
1175 (while (re-search-forward s-entry nil t) 1296 (while (re-search-forward s-entry nil t)
1176 (backward-char 1) 1297 (backward-char 1)
1177 (let ((sexp-start (point)) 1298 (let ((sexp-start (point))
1178 (sexp) 1299 (sexp)
1179 (entry) 1300 (entry)
1202 (backward-char 1) 1323 (backward-char 1)
1203 (setq entry (buffer-substring-no-properties entry-start (point))) 1324 (setq entry (buffer-substring-no-properties entry-start (point)))
1204 (while (string-match "[\^M]" entry) 1325 (while (string-match "[\^M]" entry)
1205 (aset entry (match-beginning 0) ?\n ))) 1326 (aset entry (match-beginning 0) ?\n )))
1206 (let ((diary-entry (diary-sexp-entry sexp entry date))) 1327 (let ((diary-entry (diary-sexp-entry sexp entry date)))
1328 (setq entry (if (consp diary-entry)
1329 (cdr diary-entry)
1330 diary-entry))
1207 (if diary-entry 1331 (if diary-entry
1208 (subst-char-in-region line-start (point) ?\^M ?\n t)) 1332 (progn
1209 (add-to-diary-list date 1333 (subst-char-in-region line-start (point) ?\^M ?\n t)
1210 (if (consp diary-entry) 1334 (if (< 0 (length entry))
1211 (cdr diary-entry) 1335 (setq temp (diary-pull-attrs entry file-glob-attrs)
1212 diary-entry) 1336 entry (nth 0 temp)
1337 marks (nth 1 temp)))))
1338 (add-to-diary-list date
1339 entry
1213 specifier 1340 specifier
1214 (if entry-start (copy-marker entry-start) 1341 (if entry-start (copy-marker entry-start)
1215 nil)) 1342 nil)
1343 marks)
1216 (setq entry-found (or entry-found diary-entry))))) 1344 (setq entry-found (or entry-found diary-entry)))))
1217 entry-found)) 1345 entry-found))
1218 1346
1219 (defun diary-sexp-entry (sexp entry date) 1347 (defun diary-sexp-entry (sexp entry date)
1220 "Process a SEXP diary ENTRY for DATE." 1348 "Process a SEXP diary ENTRY for DATE."
1468 ;; Diary entry may apply to one of a list of days before date 1596 ;; Diary entry may apply to one of a list of days before date
1469 ((and (listp days) days) 1597 ((and (listp days) days)
1470 (or (diary-remind sexp (car days) marking) 1598 (or (diary-remind sexp (car days) marking)
1471 (diary-remind sexp (cdr days) marking)))))) 1599 (diary-remind sexp (cdr days) marking))))))
1472 1600
1473 (defun add-to-diary-list (date string specifier marker) 1601 (defun add-to-diary-list (date string specifier marker &optional globcolor)
1474 "Add the entry (DATE STRING SPECIFIER) to `diary-entries-list'. 1602 "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'.
1475 Do nothing if DATE or STRING is nil." 1603 Do nothing if DATE or STRING is nil."
1476 (and date string 1604 (and date string
1605 (if (and diary-file-name-prefix
1606 (setq prefix (concat "[" (funcall diary-file-name-prefix-function (buffer-file-name)) "] "))
1607 (not (string= prefix "[] ")))
1608 (setq string (concat prefix string))
1609 t)
1477 (setq diary-entries-list 1610 (setq diary-entries-list
1478 (append diary-entries-list 1611 (append diary-entries-list
1479 (list (list date string specifier marker)))))) 1612 (list (list date string specifier marker globcolor))))))
1480 1613
1481 (defun make-diary-entry (string &optional nonmarking file) 1614 (defun make-diary-entry (string &optional nonmarking file)
1482 "Insert a diary entry STRING which may be NONMARKING in FILE. 1615 "Insert a diary entry STRING which may be NONMARKING in FILE.
1483 If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." 1616 If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
1484 (find-file-other-window 1617 (find-file-other-window