88 |
(autoload 'check-calendar-holidays "holidays" |
(autoload 'check-calendar-holidays "holidays" |
89 |
"Check the list of holidays for any that occur on DATE. |
"Check the list of holidays for any that occur on DATE. |
90 |
The value returned is a list of strings of relevant holiday descriptions. |
The value returned is a list of strings of relevant holiday descriptions. |
91 |
The holidays are those in the list `calendar-holidays'." |
The holidays are those in the list `calendar-holidays'.") |
|
t) |
|
92 |
|
|
93 |
(autoload 'calendar-holiday-list "holidays" |
(autoload 'calendar-holiday-list "holidays" |
94 |
"Form the list of holidays that occur on dates in the calendar window. |
"Form the list of holidays that occur on dates in the calendar window. |
95 |
The holidays are those in the list `calendar-holidays'." |
The holidays are those in the list `calendar-holidays'.") |
|
t) |
|
96 |
|
|
97 |
(autoload 'diary-french-date "cal-french" |
(autoload 'diary-french-date "cal-french" |
98 |
"French calendar equivalent of date diary entry." |
"French calendar equivalent of date diary entry.") |
|
t) |
|
99 |
|
|
100 |
(autoload 'diary-mayan-date "cal-mayan" |
(autoload 'diary-mayan-date "cal-mayan" |
101 |
"Mayan calendar equivalent of date diary entry." |
"Mayan calendar equivalent of date diary entry.") |
|
t) |
|
102 |
|
|
103 |
(autoload 'diary-iso-date "cal-iso" |
(autoload 'diary-iso-date "cal-iso" |
104 |
"ISO calendar equivalent of date diary entry." |
"ISO calendar equivalent of date diary entry.") |
|
t) |
|
105 |
|
|
106 |
(autoload 'diary-julian-date "cal-julian" |
(autoload 'diary-julian-date "cal-julian" |
107 |
"Julian calendar equivalent of date diary entry." |
"Julian calendar equivalent of date diary entry.") |
|
t) |
|
108 |
|
|
109 |
(autoload 'diary-astro-day-number "cal-julian" |
(autoload 'diary-astro-day-number "cal-julian" |
110 |
"Astronomical (Julian) day number diary entry." |
"Astronomical (Julian) day number diary entry.") |
|
t) |
|
111 |
|
|
112 |
(autoload 'diary-chinese-date "cal-china" |
(autoload 'diary-chinese-date "cal-china" |
113 |
"Chinese calendar equivalent of date diary entry." |
"Chinese calendar equivalent of date diary entry.") |
|
t) |
|
114 |
|
|
115 |
(autoload 'diary-islamic-date "cal-islam" |
(autoload 'diary-islamic-date "cal-islam" |
116 |
"Islamic calendar equivalent of date diary entry." |
"Islamic calendar equivalent of date diary entry.") |
|
t) |
|
117 |
|
|
118 |
(autoload 'list-islamic-diary-entries "cal-islam" |
(autoload 'list-islamic-diary-entries "cal-islam" |
119 |
"Add any Islamic date entries from the diary file to `diary-entries-list'." |
"Add any Islamic date entries from the diary file to `diary-entries-list'.") |
|
t) |
|
120 |
|
|
121 |
(autoload 'mark-islamic-diary-entries "cal-islam" |
(autoload 'mark-islamic-diary-entries "cal-islam" |
122 |
"Mark days in the calendar window that have Islamic date diary entries." |
"Mark days in the calendar window that have Islamic date diary entries.") |
|
t) |
|
123 |
|
|
124 |
(autoload 'mark-islamic-calendar-date-pattern "cal-islam" |
(autoload 'mark-islamic-calendar-date-pattern "cal-islam" |
125 |
"Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR." |
"Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.") |
|
t) |
|
126 |
|
|
127 |
(autoload 'diary-hebrew-date "cal-hebrew" |
(autoload 'diary-hebrew-date "cal-hebrew" |
128 |
"Hebrew calendar equivalent of date diary entry." |
"Hebrew calendar equivalent of date diary entry.") |
|
t) |
|
129 |
|
|
130 |
(autoload 'diary-omer "cal-hebrew" |
(autoload 'diary-omer "cal-hebrew" |
131 |
"Omer count diary entry." |
"Omer count diary entry.") |
|
t) |
|
132 |
|
|
133 |
(autoload 'diary-yahrzeit "cal-hebrew" |
(autoload 'diary-yahrzeit "cal-hebrew" |
134 |
"Yahrzeit diary entry--entry applies if date is yahrzeit or the day before." |
"Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.") |
|
t) |
|
135 |
|
|
136 |
(autoload 'diary-parasha "cal-hebrew" |
(autoload 'diary-parasha "cal-hebrew" |
137 |
"Parasha diary entry--entry applies if date is a Saturday." |
"Parasha diary entry--entry applies if date is a Saturday.") |
|
t) |
|
138 |
|
|
139 |
(autoload 'diary-rosh-hodesh "cal-hebrew" |
(autoload 'diary-rosh-hodesh "cal-hebrew" |
140 |
"Rosh Hodesh diary entry." |
"Rosh Hodesh diary entry.") |
|
t) |
|
141 |
|
|
142 |
(autoload 'list-hebrew-diary-entries "cal-hebrew" |
(autoload 'list-hebrew-diary-entries "cal-hebrew" |
143 |
"Add any Hebrew date entries from the diary file to `diary-entries-list'." |
"Add any Hebrew date entries from the diary file to `diary-entries-list'.") |
|
t) |
|
144 |
|
|
145 |
(autoload 'mark-hebrew-diary-entries "cal-hebrew" |
(autoload 'mark-hebrew-diary-entries "cal-hebrew" |
146 |
"Mark days in the calendar window that have Hebrew date diary entries." |
"Mark days in the calendar window that have Hebrew date diary entries.") |
|
t) |
|
147 |
|
|
148 |
(autoload 'mark-hebrew-calendar-date-pattern "cal-hebrew" |
(autoload 'mark-hebrew-calendar-date-pattern "cal-hebrew" |
149 |
"Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR." |
"Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.") |
|
t) |
|
150 |
|
|
151 |
(autoload 'diary-coptic-date "cal-coptic" |
(autoload 'diary-coptic-date "cal-coptic" |
152 |
"Coptic calendar equivalent of date diary entry." |
"Coptic calendar equivalent of date diary entry.") |
|
t) |
|
153 |
|
|
154 |
(autoload 'diary-ethiopic-date "cal-coptic" |
(autoload 'diary-ethiopic-date "cal-coptic" |
155 |
"Ethiopic calendar equivalent of date diary entry." |
"Ethiopic calendar equivalent of date diary entry.") |
|
t) |
|
156 |
|
|
157 |
(autoload 'diary-persian-date "cal-persia" |
(autoload 'diary-persian-date "cal-persia" |
158 |
"Persian calendar equivalent of date diary entry." |
"Persian calendar equivalent of date diary entry.") |
|
t) |
|
159 |
|
|
160 |
(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry." t) |
(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry.") |
161 |
|
|
162 |
(autoload 'diary-sunrise-sunset "solar" |
(autoload 'diary-sunrise-sunset "solar" |
163 |
"Local time of sunrise and sunset as a diary entry." |
"Local time of sunrise and sunset as a diary entry.") |
|
t) |
|
164 |
|
|
165 |
(autoload 'diary-sabbath-candles "solar" |
(autoload 'diary-sabbath-candles "solar" |
166 |
"Local time of candle lighting diary entry--applies if date is a Friday. |
"Local time of candle lighting diary entry--applies if date is a Friday. |
167 |
No diary entry if there is no sunset on that date." |
No diary entry if there is no sunset on that date.") |
|
t) |
|
168 |
|
|
169 |
(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table)) |
(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table)) |
170 |
"The syntax table used when parsing dates in the diary file. |
"The syntax table used when parsing dates in the diary file. |
174 |
(modify-syntax-entry ?* "w" diary-syntax-table) |
(modify-syntax-entry ?* "w" diary-syntax-table) |
175 |
(modify-syntax-entry ?: "w" diary-syntax-table) |
(modify-syntax-entry ?: "w" diary-syntax-table) |
176 |
|
|
177 |
|
(defvar diary-modified) |
178 |
|
(defvar diary-entries-list) |
179 |
|
(defvar displayed-year) |
180 |
|
(defvar displayed-month) |
181 |
|
(defvar entry) |
182 |
|
(defvar date) |
183 |
|
(defvar number) |
184 |
|
(defvar date-string) |
185 |
|
(defvar d-file) |
186 |
|
(defvar original-date) |
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 |
|
|
264 |
(defun list-diary-entries (date number) |
(defun list-diary-entries (date number) |
265 |
"Create and display a buffer containing the relevant lines in diary-file. |
"Create and display a buffer containing the relevant lines in diary-file. |
266 |
The arguments are DATE and NUMBER; the entries selected are those |
The arguments are DATE and NUMBER; the entries selected are those |
297 |
|
|
298 |
(if (< 0 number) |
(if (< 0 number) |
299 |
(let* ((original-date date);; save for possible use in the hooks |
(let* ((original-date date);; save for possible use in the hooks |
300 |
(old-diary-syntax-table) |
old-diary-syntax-table |
301 |
(diary-entries-list) |
diary-entries-list |
302 |
|
file-glob-attrs |
303 |
(date-string (calendar-date-string date)) |
(date-string (calendar-date-string date)) |
304 |
(d-file (substitute-in-file-name diary-file))) |
(d-file (substitute-in-file-name diary-file))) |
305 |
(message "Preparing diary...") |
(message "Preparing diary...") |
310 |
(set-buffer diary-buffer) |
(set-buffer diary-buffer) |
311 |
(or (verify-visited-file-modtime diary-buffer) |
(or (verify-visited-file-modtime diary-buffer) |
312 |
(revert-buffer t t)))) |
(revert-buffer t t)))) |
313 |
|
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil ""))) |
314 |
(setq selective-display t) |
(setq selective-display t) |
315 |
(setq selective-display-ellipses nil) |
(setq selective-display-ellipses nil) |
316 |
(setq old-diary-syntax-table (syntax-table)) |
(setq old-diary-syntax-table (syntax-table)) |
386 |
(backward-char 1) |
(backward-char 1) |
387 |
(subst-char-in-region date-start |
(subst-char-in-region date-start |
388 |
(point) ?\^M ?\n t) |
(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)) |
393 |
(add-to-diary-list |
(add-to-diary-list |
394 |
date |
date |
395 |
|
entry |
396 |
(buffer-substring |
(buffer-substring |
397 |
entry-start (point)) |
(1+ date-start) (1- entry-start)) |
398 |
(buffer-substring |
(copy-marker entry-start) marks))))) |
|
(1+ date-start) (1- entry-start))))))) |
|
399 |
(setq d (cdr d))) |
(setq d (cdr d))) |
400 |
(or entry-found |
(or entry-found |
401 |
(not diary-list-include-blanks) |
(not diary-list-include-blanks) |
402 |
(setq diary-entries-list |
(setq diary-entries-list |
403 |
(append diary-entries-list |
(append diary-entries-list |
404 |
(list (list date "" ""))))) |
(list (list date "" "" "" ""))))) |
405 |
(setq date |
(setq date |
406 |
(calendar-gregorian-from-absolute |
(calendar-gregorian-from-absolute |
407 |
(1+ (calendar-absolute-from-gregorian date)))) |
(1+ (calendar-absolute-from-gregorian date)))) |
494 |
(display-buffer (find-buffer-visiting d-file)) |
(display-buffer (find-buffer-visiting d-file)) |
495 |
(message "Preparing diary...done")))) |
(message "Preparing diary...done")))) |
496 |
|
|
497 |
|
(defface diary-button-face '((((type pc) (class color)) |
498 |
|
(:foreground "lightblue"))) |
499 |
|
"Default face used for buttons." |
500 |
|
:version "21.4" |
501 |
|
:group 'diary) |
502 |
|
|
503 |
|
(define-button-type 'diary-entry |
504 |
|
'action #'diary-goto-entry |
505 |
|
'face #'diary-button-face) |
506 |
|
|
507 |
|
(defun diary-goto-entry (button) |
508 |
|
(let ((marker (button-get button 'marker))) |
509 |
|
(when marker |
510 |
|
(pop-to-buffer (marker-buffer marker)) |
511 |
|
(goto-char (marker-position marker))))) |
512 |
|
|
513 |
(defun fancy-diary-display () |
(defun fancy-diary-display () |
514 |
"Prepare a diary buffer with relevant entries in a fancy, noneditable form. |
"Prepare a diary buffer with relevant entries in a fancy, noneditable form. |
515 |
This function is provided for optional use as the `diary-display-hook'." |
This function is provided for optional use as the `diary-display-hook'." |
594 |
date-holiday-list |
date-holiday-list |
595 |
(concat "\n" (make-string l ? )))) |
(concat "\n" (make-string l ? )))) |
596 |
(insert ?\n (make-string (+ l longest) ?=) ?\n))))) |
(insert ?\n (make-string (+ l longest) ?=) ?\n))))) |
597 |
(if (< 0 (length (car (cdr (car entry-list))))) |
|
598 |
(insert (car (cdr (car entry-list))) ?\n)) |
(setq entry (car (cdr (car entry-list)))) |
599 |
(setq entry-list (cdr entry-list)))) |
(if (< 0 (length entry)) |
600 |
|
(progn |
601 |
|
(if (nth 3 (car entry-list)) |
602 |
|
(insert-button (concat entry "\n") |
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)))) |
624 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |
625 |
(goto-char (point-min)) |
(goto-char (point-min)) |
626 |
(setq buffer-read-only t) |
(setq buffer-read-only t) |
627 |
(display-buffer fancy-diary-buffer) |
(display-buffer fancy-diary-buffer) |
628 |
|
(fancy-diary-display-mode) |
629 |
(message "Preparing diary...done")))) |
(message "Preparing diary...done")))) |
630 |
|
|
631 |
(defun make-fancy-diary-buffer () |
(defun make-fancy-diary-buffer () |
745 |
to run it every morning at 1am." |
to run it every morning at 1am." |
746 |
(interactive "P") |
(interactive "P") |
747 |
(let* ((diary-display-hook 'fancy-diary-display) |
(let* ((diary-display-hook 'fancy-diary-display) |
|
(diary-list-include-blanks t) |
|
748 |
(text (progn (list-diary-entries (calendar-current-date) |
(text (progn (list-diary-entries (calendar-current-date) |
749 |
(if ndays ndays diary-mail-days)) |
(if ndays ndays diary-mail-days)) |
750 |
(set-buffer fancy-diary-buffer) |
(set-buffer fancy-diary-buffer) |
751 |
(buffer-substring (point-min) (point-max))))) |
(buffer-substring (point-min) (point-max))))) |
752 |
(mail) |
(compose-mail diary-mail-addr |
753 |
(mail-to) (insert diary-mail-addr) |
(if (string-equal text "") |
754 |
(mail-subject) (insert "Diary entries generated " |
"No entries found" |
755 |
(calendar-date-string (calendar-current-date))) |
(concat "Diary entries generated " |
756 |
(mail-text) (insert text) |
(calendar-date-string (calendar-current-date))))) |
757 |
(mail-send-and-exit nil))) |
(insert text) |
758 |
|
(funcall (get mail-user-agent 'sendfunc)))) |
759 |
|
|
760 |
|
|
761 |
(defun diary-name-pattern (string-array &optional fullname) |
(defun diary-name-pattern (string-array &optional fullname) |
762 |
"Convert an STRING-ARRAY, an array of strings to a pattern. |
"Convert a STRING-ARRAY, an array of strings to a pattern. |
763 |
The pattern will match any of the strings, either entirely or abbreviated |
The pattern will match any of the strings, either entirely or abbreviated |
764 |
to three characters. An abbreviated form will match with or without a period; |
to three characters. An abbreviated form will match with or without a period; |
765 |
If the optional FULLNAME is t, abbreviations will not match, just the full |
If the optional FULLNAME is t, abbreviations will not match, just the full |
791 |
`mark-diary-entries-hook' are run." |
`mark-diary-entries-hook' are run." |
792 |
(interactive) |
(interactive) |
793 |
(setq mark-diary-entries-in-calendar t) |
(setq mark-diary-entries-in-calendar t) |
794 |
(let ((d-file (substitute-in-file-name diary-file)) |
(let (file-glob-attrs |
795 |
|
marks |
796 |
|
(d-file (substitute-in-file-name diary-file)) |
797 |
(marking-diary-entries t)) |
(marking-diary-entries t)) |
798 |
(if (and d-file (file-exists-p d-file)) |
(if (and d-file (file-exists-p d-file)) |
799 |
(if (file-readable-p d-file) |
(if (file-readable-p d-file) |
800 |
(save-excursion |
(save-excursion |
801 |
(message "Marking diary entries...") |
(message "Marking diary entries...") |
802 |
(set-buffer (find-file-noselect d-file t)) |
(set-buffer (find-file-noselect d-file t)) |
803 |
|
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
804 |
(let ((d diary-date-forms) |
(let ((d diary-date-forms) |
805 |
(old-diary-syntax-table)) |
(old-diary-syntax-table)) |
806 |
(setq old-diary-syntax-table (syntax-table)) |
(setq old-diary-syntax-table (syntax-table)) |
878 |
(if (> (- current-y y) 50) |
(if (> (- current-y y) 50) |
879 |
(+ y 100) |
(+ y 100) |
880 |
y))) |
y))) |
881 |
(string-to-int y-str))))) |
(string-to-int y-str)))) |
882 |
(if dd-name |
(save-excursion |
883 |
(mark-calendar-days-named |
(setq entry (buffer-substring-no-properties (point) (line-end-position)) |
884 |
(cdr (assoc-ignore-case |
temp (diary-pull-attrs entry file-glob-attrs) |
885 |
(substring dd-name 0 3) |
entry (nth 0 temp) |
886 |
(calendar-make-alist |
marks (nth 1 temp)))) |
887 |
calendar-day-name-array |
(if dd-name |
888 |
0 |
(mark-calendar-days-named |
889 |
(lambda (x) (substring x 0 3)))))) |
(cdr (assoc-ignore-case |
890 |
(if mm-name |
(substring dd-name 0 3) |
891 |
(if (string-equal mm-name "*") |
(calendar-make-alist |
892 |
(setq mm 0) |
calendar-day-name-array |
893 |
(setq mm |
0 |
894 |
(cdr (assoc-ignore-case |
(lambda (x) (substring x 0 3))))) marks) |
895 |
(substring mm-name 0 3) |
(if mm-name |
896 |
(calendar-make-alist |
(if (string-equal mm-name "*") |
897 |
calendar-month-name-array |
(setq mm 0) |
898 |
1 |
(setq mm |
899 |
(lambda (x) (substring x 0 3))) |
(cdr (assoc-ignore-case |
900 |
))))) |
(substring mm-name 0 3) |
901 |
(mark-calendar-date-pattern mm dd yy)))) |
(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)))) |
907 |
(setq d (cdr d)))) |
(setq d (cdr d)))) |
908 |
(mark-sexp-diary-entries) |
(mark-sexp-diary-entries) |
909 |
(run-hooks 'nongregorian-diary-marking-hook |
(run-hooks 'nongregorian-diary-marking-hook |
925 |
(m) |
(m) |
926 |
(y) |
(y) |
927 |
(first-date) |
(first-date) |
928 |
(last-date)) |
(last-date) |
929 |
|
(mark) |
930 |
|
file-glob-attrs) |
931 |
|
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
932 |
(save-excursion |
(save-excursion |
933 |
(set-buffer calendar-buffer) |
(set-buffer calendar-buffer) |
934 |
(setq m displayed-month) |
(setq m displayed-month) |
976 |
(while (string-match "[\^M]" entry) |
(while (string-match "[\^M]" entry) |
977 |
(aset entry (match-beginning 0) ?\n ))) |
(aset entry (match-beginning 0) ?\n ))) |
978 |
(calendar-for-loop date from first-date to last-date do |
(calendar-for-loop date from first-date to last-date do |
979 |
(if (diary-sexp-entry sexp entry |
(if (setq mark (diary-sexp-entry sexp entry |
980 |
(calendar-gregorian-from-absolute date)) |
(calendar-gregorian-from-absolute date))) |
981 |
(mark-visible-calendar-date |
(progn |
982 |
(calendar-gregorian-from-absolute date)))))))) |
(setq marks (diary-pull-attrs entry file-glob-attrs) |
983 |
|
temp (diary-pull-attrs entry file-glob-attrs) |
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))))))))))) |
991 |
|
|
992 |
(defun mark-included-diary-files () |
(defun mark-included-diary-files () |
993 |
"Mark the diary entries from other diary files with those of the diary file. |
"Mark the diary entries from other diary files with those of the diary file. |
1022 |
(sleep-for 2)))) |
(sleep-for 2)))) |
1023 |
(goto-char (point-min))) |
(goto-char (point-min))) |
1024 |
|
|
1025 |
(defun mark-calendar-days-named (dayname) |
(defun mark-calendar-days-named (dayname &optional color) |
1026 |
"Mark all dates in the calendar window that are day DAYNAME of the week. |
"Mark all dates in the calendar window that are day DAYNAME of the week. |
1027 |
0 means all Sundays, 1 means all Mondays, and so on." |
0 means all Sundays, 1 means all Mondays, and so on." |
1028 |
(save-excursion |
(save-excursion |
1040 |
(setq last-day (calendar-absolute-from-gregorian |
(setq last-day (calendar-absolute-from-gregorian |
1041 |
(calendar-nth-named-day -1 dayname succ-month succ-year))) |
(calendar-nth-named-day -1 dayname succ-month succ-year))) |
1042 |
(while (<= day last-day) |
(while (<= day last-day) |
1043 |
(mark-visible-calendar-date (calendar-gregorian-from-absolute day)) |
(mark-visible-calendar-date (calendar-gregorian-from-absolute day) color) |
1044 |
(setq day (+ day 7)))))) |
(setq day (+ day 7)))))) |
1045 |
|
|
1046 |
(defun mark-calendar-date-pattern (month day year) |
(defun mark-calendar-date-pattern (month day year &optional color) |
1047 |
"Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. |
"Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. |
1048 |
A value of 0 in any position is a wildcard." |
A value of 0 in any position is a wildcard." |
1049 |
(save-excursion |
(save-excursion |
1052 |
(y displayed-year)) |
(y displayed-year)) |
1053 |
(increment-calendar-month m y -1) |
(increment-calendar-month m y -1) |
1054 |
(calendar-for-loop i from 0 to 2 do |
(calendar-for-loop i from 0 to 2 do |
1055 |
(mark-calendar-month m y month day year) |
(mark-calendar-month m y month day year color) |
1056 |
(increment-calendar-month m y 1))))) |
(increment-calendar-month m y 1))))) |
1057 |
|
|
1058 |
(defun mark-calendar-month (month year p-month p-day p-year) |
(defun mark-calendar-month (month year p-month p-day p-year &optional color) |
1059 |
"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. |
"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. |
1060 |
A value of 0 in any position of the pattern is a wildcard." |
A value of 0 in any position of the pattern is a wildcard." |
1061 |
(if (or (and (= month p-month) |
(if (or (and (= month p-month) |
1065 |
(if (= p-day 0) |
(if (= p-day 0) |
1066 |
(calendar-for-loop |
(calendar-for-loop |
1067 |
i from 1 to (calendar-last-day-of-month month year) do |
i from 1 to (calendar-last-day-of-month month year) do |
1068 |
(mark-visible-calendar-date (list month i year))) |
(mark-visible-calendar-date (list month i year) color)) |
1069 |
(mark-visible-calendar-date (list month p-day year))))) |
(mark-visible-calendar-date (list month p-day year) color)))) |
1070 |
|
|
1071 |
(defun sort-diary-entries () |
(defun sort-diary-entries () |
1072 |
"Sort the list of diary entries by time of day." |
"Sort the list of diary entries by time of day." |
1093 |
:version "20.3") |
:version "20.3") |
1094 |
|
|
1095 |
(defun diary-entry-time (s) |
(defun diary-entry-time (s) |
1096 |
"Time at the beginning of the string S in a military-style integer. For |
"Return time at the beginning of the string S as a military-style integer. |
1097 |
example, returns 1325 for 1:25pm. Returns `diary-unknown-time' (default value |
For example, returns 1325 for 1:25pm. |
1098 |
-9999) if no time is recognized. The recognized forms are XXXX, X:XX, or |
Returns `diary-unknown-time' (default value -9999) if no time is recognized. The recognized forms are XXXX, X:XX, or |
1099 |
XX:XX (military time), and XXam, XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, |
XX:XX (military time), and XXam, XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, |
1100 |
or XX:XXPM." |
or XX:XXPM." |
1101 |
(let ((case-fold-search nil)) |
(let ((case-fold-search nil)) |
1148 |
|
|
1149 |
A number of built-in functions are available for this type of diary entry: |
A number of built-in functions are available for this type of diary entry: |
1150 |
|
|
1151 |
%%(diary-date MONTH DAY YEAR) text |
%%(diary-date MONTH DAY YEAR &optional MARK) text |
1152 |
Entry applies if date is MONTH, DAY, YEAR if |
Entry applies if date is MONTH, DAY, YEAR if |
1153 |
`european-calendar-style' is nil, and DAY, MONTH, YEAR if |
`european-calendar-style' is nil, and DAY, MONTH, YEAR if |
1154 |
`european-calendar-style' is t. DAY, MONTH, and YEAR |
`european-calendar-style' is t. DAY, MONTH, and YEAR |
1155 |
can be lists of integers, the constant t, or an integer. |
can be lists of integers, the constant t, or an integer. |
1156 |
The constant t means all values. |
The constant t means all values. An optional parameter |
1157 |
|
MARK specifies a face or single-character string to use |
1158 |
|
when highlighting the day in the calendar. |
1159 |
|
|
1160 |
%%(diary-float MONTH DAYNAME N &optional DAY) text |
%%(diary-float MONTH DAYNAME N &optional DAY MARK) text |
1161 |
Entry will appear on the Nth DAYNAME of MONTH. |
Entry will appear on the Nth DAYNAME of MONTH. |
1162 |
(DAYNAME=0 means Sunday, 1 means Monday, and so on; |
(DAYNAME=0 means Sunday, 1 means Monday, and so on; |
1163 |
if N is negative it counts backward from the end of |
if N is negative it counts backward from the end of |
1164 |
the month. MONTH can be a list of months, a single |
the month. MONTH can be a list of months, a single |
1165 |
month, or t to specify all months. Optional DAY means |
month, or t to specify all months. Optional DAY means |
1166 |
Nth DAYNAME of MONTH on or after/before DAY. DAY defaults |
Nth DAYNAME of MONTH on or after/before DAY. DAY defaults |
1167 |
to 1 if N>0 and the last day of the month if N<0. |
to 1 if N>0 and the last day of the month if N<0. An |
1168 |
|
optional parameter MARK specifies a face or single-character |
1169 |
|
string to use when highlighting the day in the calendar. |
1170 |
|
|
1171 |
%%(diary-block M1 D1 Y1 M2 D2 Y2) text |
%%(diary-block M1 D1 Y1 M2 D2 Y2 &optional MARK) text |
1172 |
Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2, |
Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2, |
1173 |
inclusive. (If `european-calendar-style' is t, the |
inclusive. (If `european-calendar-style' is t, the |
1174 |
order of the parameters should be changed to D1, M1, Y1, |
order of the parameters should be changed to D1, M1, Y1, |
1175 |
D2, M2, Y2.) |
D2, M2, Y2.) An optional parameter MARK specifies a face |
1176 |
|
or single-character string to use when highlighting the |
1177 |
|
day in the calendar. |
1178 |
|
|
1179 |
%%(diary-anniversary MONTH DAY YEAR) text |
%%(diary-anniversary MONTH DAY YEAR &optional MARK) text |
1180 |
Entry will appear on anniversary dates of MONTH DAY, YEAR. |
Entry will appear on anniversary dates of MONTH DAY, YEAR. |
1181 |
(If `european-calendar-style' is t, the order of the |
(If `european-calendar-style' is t, the order of the |
1182 |
parameters should be changed to DAY, MONTH, YEAR.) Text |
parameters should be changed to DAY, MONTH, YEAR.) Text |
1184 |
of years since the MONTH DAY, YEAR and %s will be replaced |
of years since the MONTH DAY, YEAR and %s will be replaced |
1185 |
by the ordinal ending of that number (that is, `st', `nd', |
by the ordinal ending of that number (that is, `st', `nd', |
1186 |
`rd' or `th', as appropriate. The anniversary of February |
`rd' or `th', as appropriate. The anniversary of February |
1187 |
29 is considered to be March 1 in a non-leap year. |
29 is considered to be March 1 in a non-leap year. An |
1188 |
|
optional parameter MARK specifies a face or single-character |
1189 |
|
string to use when highlighting the day in the calendar. |
1190 |
|
|
1191 |
%%(diary-cyclic N MONTH DAY YEAR) text |
%%(diary-cyclic N MONTH DAY YEAR &optional MARK) text |
1192 |
Entry will appear every N days, starting MONTH DAY, YEAR. |
Entry will appear every N days, starting MONTH DAY, YEAR. |
1193 |
(If `european-calendar-style' is t, the order of the |
(If `european-calendar-style' is t, the order of the |
1194 |
parameters should be changed to N, DAY, MONTH, YEAR.) Text |
parameters should be changed to N, DAY, MONTH, YEAR.) Text |
1195 |
can contain %d or %d%s; %d will be replaced by the number |
can contain %d or %d%s; %d will be replaced by the number |
1196 |
of repetitions since the MONTH DAY, YEAR and %s will |
of repetitions since the MONTH DAY, YEAR and %s will |
1197 |
be replaced by the ordinal ending of that number (that is, |
be replaced by the ordinal ending of that number (that is, |
1198 |
`st', `nd', `rd' or `th', as appropriate. |
`st', `nd', `rd' or `th', as appropriate. An optional |
1199 |
|
parameter MARK specifies a face or single-character string |
1200 |
|
to use when highlighting the day in the calendar. |
1201 |
|
|
1202 |
%%(diary-remind SEXP DAYS &optional MARKING) text |
%%(diary-remind SEXP DAYS &optional MARKING) text |
1203 |
Entry is a reminder for diary sexp SEXP. DAYS is either a |
Entry is a reminder for diary sexp SEXP. DAYS is either a |
1287 |
(let* ((mark (regexp-quote diary-nonmarking-symbol)) |
(let* ((mark (regexp-quote diary-nonmarking-symbol)) |
1288 |
(sexp-mark (regexp-quote sexp-diary-entry-symbol)) |
(sexp-mark (regexp-quote sexp-diary-entry-symbol)) |
1289 |
(s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) |
(s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) |
1290 |
(entry-found)) |
(entry-found) |
1291 |
|
(file-glob-attrs) |
1292 |
|
(marks)) |
1293 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1294 |
|
(save-excursion |
1295 |
|
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))) |
1296 |
(while (re-search-forward s-entry nil t) |
(while (re-search-forward s-entry nil t) |
1297 |
(backward-char 1) |
(backward-char 1) |
1298 |
(let ((sexp-start (point)) |
(let ((sexp-start (point)) |
1307 |
(re-search-backward "\^M\\|\n\\|\\`") |
(re-search-backward "\^M\\|\n\\|\\`") |
1308 |
(setq line-start (point))) |
(setq line-start (point))) |
1309 |
(setq specifier |
(setq specifier |
1310 |
(buffer-substring-no-properties (1+ line-start) (point))) |
(buffer-substring-no-properties (1+ line-start) (point)) |
1311 |
|
entry-start (1+ line-start)) |
1312 |
(forward-char 1) |
(forward-char 1) |
1313 |
(if (and (or (char-equal (preceding-char) ?\^M) |
(if (and (or (char-equal (preceding-char) ?\^M) |
1314 |
(char-equal (preceding-char) ?\n)) |
(char-equal (preceding-char) ?\n)) |
1325 |
(while (string-match "[\^M]" entry) |
(while (string-match "[\^M]" entry) |
1326 |
(aset entry (match-beginning 0) ?\n ))) |
(aset entry (match-beginning 0) ?\n ))) |
1327 |
(let ((diary-entry (diary-sexp-entry sexp entry date))) |
(let ((diary-entry (diary-sexp-entry sexp entry date))) |
1328 |
|
(setq entry (if (consp diary-entry) |
1329 |
|
(cdr diary-entry) |
1330 |
|
diary-entry)) |
1331 |
(if diary-entry |
(if diary-entry |
1332 |
(subst-char-in-region line-start (point) ?\^M ?\n t)) |
(progn |
1333 |
(add-to-diary-list date diary-entry specifier) |
(subst-char-in-region line-start (point) ?\^M ?\n t) |
1334 |
(setq entry-found (or entry-found diary-entry))))) |
(if (< 0 (length entry)) |
1335 |
|
(setq temp (diary-pull-attrs entry file-glob-attrs) |
1336 |
|
entry (nth 0 temp) |
1337 |
|
marks (nth 1 temp))))) |
1338 |
|
(add-to-diary-list date |
1339 |
|
entry |
1340 |
|
specifier |
1341 |
|
(if entry-start (copy-marker entry-start) |
1342 |
|
nil) |
1343 |
|
marks) |
1344 |
|
(setq entry-found (or entry-found diary-entry))))) |
1345 |
entry-found)) |
entry-found)) |
1346 |
|
|
1347 |
(defun diary-sexp-entry (sexp entry date) |
(defun diary-sexp-entry (sexp entry date) |
1364 |
lines))) |
lines))) |
1365 |
diary-file sexp) |
diary-file sexp) |
1366 |
(sleep-for 2)))))) |
(sleep-for 2)))))) |
1367 |
(if (stringp result) |
(cond ((stringp result) result) |
1368 |
result |
((and (consp result) |
1369 |
(if result |
(stringp (cdr result))) result) |
1370 |
entry |
(result entry) |
1371 |
nil)))) |
(t nil)))) |
1372 |
|
|
1373 |
(defun diary-date (month day year) |
(defun diary-date (month day year &optional mark) |
1374 |
"Specific date(s) diary entry. |
"Specific date(s) diary entry. |
1375 |
Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil, |
Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil, |
1376 |
and DAY, MONTH, YEAR if `european-calendar-style' is t. DAY, MONTH, and YEAR |
and DAY, MONTH, YEAR if `european-calendar-style' is t. DAY, MONTH, and YEAR |
1377 |
can be lists of integers, the constant t, or an integer. The constant t means |
can be lists of integers, the constant t, or an integer. The constant t means |
1378 |
all values." |
all values. |
1379 |
|
|
1380 |
|
An optional parameter MARK specifies a face or single-character string to |
1381 |
|
use when highlighting the day in the calendar." |
1382 |
(let* ((dd (if european-calendar-style |
(let* ((dd (if european-calendar-style |
1383 |
month |
month |
1384 |
day)) |
day)) |
1398 |
(or (and (listp year) (memq y year)) |
(or (and (listp year) (memq y year)) |
1399 |
(equal y year) |
(equal y year) |
1400 |
(eq year t))) |
(eq year t))) |
1401 |
entry))) |
(cons mark entry)))) |
1402 |
|
|
1403 |
(defun diary-block (m1 d1 y1 m2 d2 y2) |
(defun diary-block (m1 d1 y1 m2 d2 y2 &optional mark) |
1404 |
"Block diary entry. |
"Block diary entry. |
1405 |
Entry applies if date is between, or on one of, two dates. |
Entry applies if date is between, or on one of, two dates. |
1406 |
The order of the parameters is |
The order of the parameters is |
1407 |
M1, D1, Y1, M2, D2, Y2 if `european-calendar-style' is nil, and |
M1, D1, Y1, M2, D2, Y2 if `european-calendar-style' is nil, and |
1408 |
D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t." |
D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t. |
1409 |
|
|
1410 |
|
An optional parameter MARK specifies a face or single-character string to |
1411 |
|
use when highlighting the day in the calendar." |
1412 |
|
|
1413 |
(let ((date1 (calendar-absolute-from-gregorian |
(let ((date1 (calendar-absolute-from-gregorian |
1414 |
(if european-calendar-style |
(if european-calendar-style |
1415 |
(list d1 m1 y1) |
(list d1 m1 y1) |
1420 |
(list m2 d2 y2)))) |
(list m2 d2 y2)))) |
1421 |
(d (calendar-absolute-from-gregorian date))) |
(d (calendar-absolute-from-gregorian date))) |
1422 |
(if (and (<= date1 d) (<= d date2)) |
(if (and (<= date1 d) (<= d date2)) |
1423 |
entry))) |
(cons mark entry)))) |
1424 |
|
|
1425 |
(defun diary-float (month dayname n &optional day) |
(defun diary-float (month dayname n &optional day mark) |
1426 |
"Floating diary entry--entry applies if date is the nth dayname of month. |
"Floating diary entry--entry applies if date is the nth dayname of month. |
1427 |
Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, the constant |
Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, the constant |
1428 |
t, or an integer. The constant t means all months. If N is negative, count |
t, or an integer. The constant t means all months. If N is negative, count |
1429 |
backward from the end of the month. |
backward from the end of the month. |
1430 |
|
|
1431 |
An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY." |
An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY. |
1432 |
|
Optional MARK specifies a face or single-character string to use when |
1433 |
|
highlighting the day in the calendar." |
1434 |
;; This is messy because the diary entry may apply, but the date on which it |
;; This is messy because the diary entry may apply, but the date on which it |
1435 |
;; is based can be in a different month/year. For example, asking for the |
;; is based can be in a different month/year. For example, asking for the |
1436 |
;; first Monday after December 30. For large values of |n| the problem is |
;; first Monday after December 30. For large values of |n| the problem is |
1484 |
1 |
1 |
1485 |
(calendar-last-day-of-month m2 y2))) |
(calendar-last-day-of-month m2 y2))) |
1486 |
d2))))) |
d2))))) |
1487 |
entry)))) |
(cons mark entry))))) |
1488 |
|
|
1489 |
|
|
1490 |
(defun diary-anniversary (month day year) |
(defun diary-anniversary (month day year &optional mark) |
1491 |
"Anniversary diary entry. |
"Anniversary diary entry. |
1492 |
Entry applies if date is the anniversary of MONTH, DAY, YEAR if |
Entry applies if date is the anniversary of MONTH, DAY, YEAR if |
1493 |
`european-calendar-style' is nil, and DAY, MONTH, YEAR if |
`european-calendar-style' is nil, and DAY, MONTH, YEAR if |
1495 |
%d will be replaced by the number of years since the MONTH DAY, YEAR and the |
%d will be replaced by the number of years since the MONTH DAY, YEAR and the |
1496 |
%s will be replaced by the ordinal ending of that number (that is, `st', `nd', |
%s will be replaced by the ordinal ending of that number (that is, `st', `nd', |
1497 |
`rd' or `th', as appropriate. The anniversary of February 29 is considered |
`rd' or `th', as appropriate. The anniversary of February 29 is considered |
1498 |
to be March 1 in non-leap years." |
to be March 1 in non-leap years. |
1499 |
|
|
1500 |
|
An optional parameter MARK specifies a face or single-character string to |
1501 |
|
use when highlighting the day in the calendar." |
1502 |
(let* ((d (if european-calendar-style |
(let* ((d (if european-calendar-style |
1503 |
month |
month |
1504 |
day)) |
day)) |
1511 |
(setq m 3 |
(setq m 3 |
1512 |
d 1)) |
d 1)) |
1513 |
(if (and (> diff 0) (calendar-date-equal (list m d y) date)) |
(if (and (> diff 0) (calendar-date-equal (list m d y) date)) |
1514 |
(format entry diff (diary-ordinal-suffix diff))))) |
(cons mark (format entry diff (diary-ordinal-suffix diff)))))) |
1515 |
|
|
1516 |
(defun diary-cyclic (n month day year) |
(defun diary-cyclic (n month day year &optional mark) |
1517 |
"Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR. |
"Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR. |
1518 |
If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR. |
If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR. |
1519 |
ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of |
ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of |
1520 |
repetitions since the MONTH DAY, YEAR and %s will be replaced by the |
repetitions since the MONTH DAY, YEAR and %s will be replaced by the |
1521 |
ordinal ending of that number (that is, `st', `nd', `rd' or `th', as |
ordinal ending of that number (that is, `st', `nd', `rd' or `th', as |
1522 |
appropriate." |
appropriate. |
1523 |
|
|
1524 |
|
An optional parameter MARK specifies a face or single-character string to |
1525 |
|
use when highlighting the day in the calendar." |
1526 |
(let* ((d (if european-calendar-style |
(let* ((d (if european-calendar-style |
1527 |
month |
month |
1528 |
day)) |
day)) |
1534 |
(list m d year)))) |
(list m d year)))) |
1535 |
(cycle (/ diff n))) |
(cycle (/ diff n))) |
1536 |
(if (and (>= diff 0) (zerop (% diff n))) |
(if (and (>= diff 0) (zerop (% diff n))) |
1537 |
(format entry cycle (diary-ordinal-suffix cycle))))) |
(cons mark (format entry cycle (diary-ordinal-suffix cycle)))))) |
1538 |
|
|
1539 |
(defun diary-ordinal-suffix (n) |
(defun diary-ordinal-suffix (n) |
1540 |
"Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)" |
"Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)" |
1598 |
(or (diary-remind sexp (car days) marking) |
(or (diary-remind sexp (car days) marking) |
1599 |
(diary-remind sexp (cdr days) marking)))))) |
(diary-remind sexp (cdr days) marking)))))) |
1600 |
|
|
1601 |
(defun add-to-diary-list (date string specifier) |
(defun add-to-diary-list (date string specifier marker &optional globcolor) |
1602 |
"Add the entry (DATE STRING SPECIFIER) to `diary-entries-list'. |
"Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'. |
1603 |
Do nothing if DATE or STRING is nil." |
Do nothing if DATE or STRING is nil." |
1604 |
(and date string |
(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) |
1610 |
(setq diary-entries-list |
(setq diary-entries-list |
1611 |
(append diary-entries-list (list (list date string specifier)))))) |
(append diary-entries-list |
1612 |
|
(list (list date string specifier marker globcolor)))))) |
1613 |
|
|
1614 |
(defun make-diary-entry (string &optional nonmarking file) |
(defun make-diary-entry (string &optional nonmarking file) |
1615 |
"Insert a diary entry STRING which may be NONMARKING in FILE. |
"Insert a diary entry STRING which may be NONMARKING in FILE. |
1616 |
If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." |
If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." |
1617 |
(find-file-other-window |
(find-file-other-window |
1618 |
(substitute-in-file-name (if file file diary-file))) |
(substitute-in-file-name (if file file diary-file))) |
1619 |
|
(widen) |
1620 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1621 |
|
(when (let ((case-fold-search t)) |
1622 |
|
(search-backward "Local Variables:" |
1623 |
|
(max (- (point-max) 3000) (point-min)) |
1624 |
|
t)) |
1625 |
|
(beginning-of-line) |
1626 |
|
(insert "\n") |
1627 |
|
(previous-line 1)) |
1628 |
(insert |
(insert |
1629 |
(if (bolp) "" "\n") |
(if (bolp) "" "\n") |
1630 |
(if nonmarking diary-nonmarking-symbol "") |
(if nonmarking diary-nonmarking-symbol "") |
1722 |
(calendar-date-string (calendar-cursor-to-date t) nil t)) |
(calendar-date-string (calendar-cursor-to-date t) nil t)) |
1723 |
arg))) |
arg))) |
1724 |
|
|
1725 |
|
;;;###autoload |
1726 |
|
(define-derived-mode diary-mode text-mode |
1727 |
|
"Diary" |
1728 |
|
"Major mode for editing the diary file." |
1729 |
|
(set (make-local-variable 'font-lock-defaults) |
1730 |
|
'(diary-font-lock-keywords t))) |
1731 |
|
|
1732 |
|
(define-derived-mode fancy-diary-display-mode text-mode |
1733 |
|
"Diary" |
1734 |
|
"Major mode used while displaying diary entries using Fancy Display." |
1735 |
|
(set (make-local-variable 'font-lock-defaults) |
1736 |
|
'(fancy-diary-font-lock-keywords t))) |
1737 |
|
|
1738 |
|
|
1739 |
|
(defvar fancy-diary-font-lock-keywords |
1740 |
|
(list |
1741 |
|
(cons |
1742 |
|
(concat |
1743 |
|
(let ((dayname |
1744 |
|
(concat "\\(" |
1745 |
|
(diary-name-pattern calendar-day-name-array t) |
1746 |
|
"\\)")) |
1747 |
|
(monthname |
1748 |
|
(concat "\\(" |
1749 |
|
(diary-name-pattern calendar-month-name-array t) |
1750 |
|
"\\)")) |
1751 |
|
(day "[0-9]+") |
1752 |
|
(month "[0-9]+") |
1753 |
|
(year "-?[0-9]+")) |
1754 |
|
(mapconcat 'eval calendar-date-display-form "")) |
1755 |
|
"\\(\\(: .*\\)\\|\\(\n +.*\\)\\)*\n=+$") |
1756 |
|
'diary-face) |
1757 |
|
'("^.*anniversary.*$" . font-lock-keyword-face) |
1758 |
|
'("^.*birthday.*$" . font-lock-keyword-face) |
1759 |
|
'("^.*Yahrzeit.*$" . font-lock-reference-face) |
1760 |
|
'("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face) |
1761 |
|
'("^Day.*omer.*$" . font-lock-builtin-face) |
1762 |
|
'("^Parashat.*$" . font-lock-comment-face) |
1763 |
|
'("^[ \t]*[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\(-[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\)?" |
1764 |
|
. font-lock-variable-name-face)) |
1765 |
|
"Keywords to highlight in fancy diary display") |
1766 |
|
|
1767 |
|
|
1768 |
|
(defun font-lock-diary-sexps (limit) |
1769 |
|
"Recognize sexp diary entry for font-locking." |
1770 |
|
(if (re-search-forward |
1771 |
|
(concat "^" (regexp-quote diary-nonmarking-symbol) |
1772 |
|
"?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)") |
1773 |
|
limit t) |
1774 |
|
(condition-case nil |
1775 |
|
(save-restriction |
1776 |
|
(narrow-to-region (point-min) limit) |
1777 |
|
(let ((start (point))) |
1778 |
|
(forward-sexp 1) |
1779 |
|
(store-match-data (list start (point))) |
1780 |
|
t)) |
1781 |
|
(error t)))) |
1782 |
|
|
1783 |
|
(defun font-lock-diary-date-forms (month-list &optional symbol noabbrev) |
1784 |
|
"Create a list of font-lock patterns for `diary-date-forms' with MONTH-LIST. |
1785 |
|
If given, optional SYMBOL must be a prefix to entries. |
1786 |
|
If optional NOABBREV is t, do not allow abbreviations in names." |
1787 |
|
(let* ((dayname |
1788 |
|
(concat "\\(" (diary-name-pattern calendar-day-name-array) "\\)")) |
1789 |
|
(monthname (concat "\\(" |
1790 |
|
(diary-name-pattern month-list noabbrev) |
1791 |
|
"\\|\\*\\)")) |
1792 |
|
(month "\\([0-9]+\\|\\*\\)") |
1793 |
|
(day "\\([0-9]+\\|\\*\\)") |
1794 |
|
(year "-?\\([0-9]+\\|\\*\\)")) |
1795 |
|
(mapcar '(lambda (x) |
1796 |
|
(cons |
1797 |
|
(concat "^" (regexp-quote diary-nonmarking-symbol) "?" |
1798 |
|
(if symbol (regexp-quote symbol) "") "\\(" |
1799 |
|
(mapconcat 'eval |
1800 |
|
;; If backup, omit first item (backup) |
1801 |
|
;; and last item (not part of date) |
1802 |
|
(if (equal (car x) 'backup) |
1803 |
|
(reverse (cdr (reverse (cdr x)))) |
1804 |
|
x) |
1805 |
|
"") |
1806 |
|
;; With backup, last item is not part of date |
1807 |
|
(if (equal (car x) 'backup) |
1808 |
|
(concat "\\)" (eval (car (reverse x)))) |
1809 |
|
"\\)")) |
1810 |
|
'(1 diary-face))) |
1811 |
|
diary-date-forms))) |
1812 |
|
|
1813 |
|
(defvar diary-font-lock-keywords |
1814 |
|
(append |
1815 |
|
(font-lock-diary-date-forms calendar-month-name-array) |
1816 |
|
(if (or (memq 'mark-hebrew-diary-entries |
1817 |
|
nongregorian-diary-marking-hook) |
1818 |
|
(memq 'list-hebrew-diary-entries |
1819 |
|
nongregorian-diary-listing-hook)) |
1820 |
|
(progn |
1821 |
|
(require 'cal-hebrew) |
1822 |
|
(font-lock-diary-date-forms |
1823 |
|
calendar-hebrew-month-name-array-leap-year |
1824 |
|
hebrew-diary-entry-symbol t))) |
1825 |
|
(if (or (memq 'mark-islamic-diary-entries |
1826 |
|
nongregorian-diary-marking-hook) |
1827 |
|
(memq 'list-islamic-diary-entries |
1828 |
|
nongregorian-diary-listing-hook)) |
1829 |
|
(progn |
1830 |
|
(require 'cal-islamic) |
1831 |
|
(font-lock-diary-date-forms |
1832 |
|
calendar-islamic-month-name-array-leap-year |
1833 |
|
islamic-diary-entry-symbol t))) |
1834 |
|
(list |
1835 |
|
(cons |
1836 |
|
(concat "^" (regexp-quote diary-include-string) ".*$") |
1837 |
|
'font-lock-keyword-face) |
1838 |
|
(cons |
1839 |
|
(concat "^" (regexp-quote diary-nonmarking-symbol) |
1840 |
|
"?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)") |
1841 |
|
'(1 font-lock-reference-face)) |
1842 |
|
(cons |
1843 |
|
(concat "^" (regexp-quote diary-nonmarking-symbol)) |
1844 |
|
'font-lock-reference-face) |
1845 |
|
(cons |
1846 |
|
(concat "^" (regexp-quote diary-nonmarking-symbol) |
1847 |
|
"?\\(" (regexp-quote hebrew-diary-entry-symbol) "\\)") |
1848 |
|
'(1 font-lock-reference-face)) |
1849 |
|
(cons |
1850 |
|
(concat "^" (regexp-quote diary-nonmarking-symbol) |
1851 |
|
"?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") |
1852 |
|
'(1 font-lock-reference-face)) |
1853 |
|
'(font-lock-diary-sexps . font-lock-keyword-face) |
1854 |
|
'("[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?" |
1855 |
|
. font-lock-function-name-face))) |
1856 |
|
"Forms to highlight in diary-mode") |
1857 |
|
|
1858 |
|
|
1859 |
(provide 'diary-lib) |
(provide 'diary-lib) |
1860 |
|
|
1861 |
;;; diary-lib.el ends here |
;;; diary-lib.el ends here |