1 |
;;; diary-lib.el --- diary functions |
;;; diary-lib.el --- diary functions |
2 |
|
|
3 |
;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995 Free Software |
;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2003 |
4 |
;; Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
7 |
;; Keywords: calendar |
;; Keywords: calendar |
38 |
|
|
39 |
(require 'calendar) |
(require 'calendar) |
40 |
|
|
41 |
|
(defun diary-check-diary-file () |
42 |
|
"Check that the file specified by `diary-file' exists and is readable. |
43 |
|
If so, return the expanded file name, otherwise signal an error." |
44 |
|
(let ((d-file (substitute-in-file-name diary-file))) |
45 |
|
(if (and d-file (file-exists-p d-file)) |
46 |
|
(if (file-readable-p d-file) |
47 |
|
d-file |
48 |
|
(error "Diary file `%s' is not readable" diary-file)) |
49 |
|
(error "Diary file `%s' does not exist" diary-file)))) |
50 |
|
|
51 |
;;;###autoload |
;;;###autoload |
52 |
(defun diary (&optional arg) |
(defun diary (&optional arg) |
53 |
"Generate the diary window for ARG days starting with the current date. |
"Generate the diary window for ARG days starting with the current date. |
55 |
by the variable `number-of-diary-entries'. This function is suitable for |
by the variable `number-of-diary-entries'. This function is suitable for |
56 |
execution in a `.emacs' file." |
execution in a `.emacs' file." |
57 |
(interactive "P") |
(interactive "P") |
58 |
(let ((d-file (substitute-in-file-name diary-file)) |
(diary-check-diary-file) |
59 |
(date (calendar-current-date))) |
(let ((date (calendar-current-date))) |
60 |
(if (and d-file (file-exists-p d-file)) |
(list-diary-entries |
61 |
(if (file-readable-p d-file) |
date |
62 |
(list-diary-entries |
(cond (arg (prefix-numeric-value arg)) |
63 |
date |
((vectorp number-of-diary-entries) |
64 |
(cond |
(aref number-of-diary-entries (calendar-day-of-week date))) |
65 |
(arg (prefix-numeric-value arg)) |
(t number-of-diary-entries))))) |
|
((vectorp number-of-diary-entries) |
|
|
(aref number-of-diary-entries (calendar-day-of-week date))) |
|
|
(t number-of-diary-entries))) |
|
|
(error "Your diary file is not readable!")) |
|
|
(error "You don't have a diary file!")))) |
|
66 |
|
|
67 |
(defun view-diary-entries (arg) |
(defun view-diary-entries (arg) |
68 |
"Prepare and display a buffer with diary entries. |
"Prepare and display a buffer with diary entries. |
70 |
match ARG days starting with the date indicated by the cursor position |
match ARG days starting with the date indicated by the cursor position |
71 |
in the displayed three-month calendar." |
in the displayed three-month calendar." |
72 |
(interactive "p") |
(interactive "p") |
73 |
(let ((d-file (substitute-in-file-name diary-file))) |
(diary-check-diary-file) |
74 |
(if (and d-file (file-exists-p d-file)) |
(list-diary-entries (calendar-cursor-to-date t) arg)) |
|
(if (file-readable-p d-file) |
|
|
(list-diary-entries (calendar-cursor-to-date t) arg) |
|
|
(error "Diary file is not readable!")) |
|
|
(error "You don't have a diary file!")))) |
|
75 |
|
|
76 |
(defun view-other-diary-entries (arg d-file) |
(defun view-other-diary-entries (arg d-file) |
77 |
"Prepare and display buffer of diary entries from an alternative diary file. |
"Prepare and display buffer of diary entries from an alternative diary file. |
78 |
Prompts for a file name and searches that file for entries that match ARG |
Searches for entries that match ARG days, starting with the date indicated |
79 |
days starting with the date indicated by the cursor position in the displayed |
by the cursor position in the displayed three-month calendar. |
80 |
three-month calendar." |
D-FILE specifies the file to use as the diary file." |
81 |
(interactive |
(interactive |
82 |
(list (cond ((null current-prefix-arg) 1) |
(list (if arg (prefix-numeric-value arg) 1) |
|
((listp current-prefix-arg) (car current-prefix-arg)) |
|
|
(t current-prefix-arg)) |
|
83 |
(read-file-name "Enter diary file name: " default-directory nil t))) |
(read-file-name "Enter diary file name: " default-directory nil t))) |
84 |
(let ((diary-file d-file)) |
(let ((diary-file d-file)) |
85 |
(view-diary-entries arg))) |
(view-diary-entries arg))) |
168 |
(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table)) |
(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table)) |
169 |
"The syntax table used when parsing dates in the diary file. |
"The syntax table used when parsing dates in the diary file. |
170 |
It is the standard syntax table used in Fundamental mode, but with the |
It is the standard syntax table used in Fundamental mode, but with the |
171 |
syntax of `*' changed to be a word constituent.") |
syntax of `*' and `:' changed to be word constituents.") |
172 |
|
|
173 |
(modify-syntax-entry ?* "w" diary-syntax-table) |
(modify-syntax-entry ?* "w" diary-syntax-table) |
174 |
(modify-syntax-entry ?: "w" diary-syntax-table) |
(modify-syntax-entry ?: "w" diary-syntax-table) |
175 |
|
|
|
(defvar diary-modified) |
|
176 |
(defvar diary-entries-list) |
(defvar diary-entries-list) |
177 |
(defvar displayed-year) |
(defvar displayed-year) |
178 |
(defvar displayed-month) |
(defvar displayed-month) |
180 |
(defvar date) |
(defvar date) |
181 |
(defvar number) |
(defvar number) |
182 |
(defvar date-string) |
(defvar date-string) |
|
(defvar d-file) |
|
183 |
(defvar original-date) |
(defvar original-date) |
184 |
|
|
185 |
(defun diary-attrtype-convert (attrvalue type) |
(defun diary-attrtype-convert (attrvalue type) |
186 |
"Convert the attrvalue from a string to the appropriate type for using |
"Convert string ATTRVALUE to TYPE appropriate for a face description. |
187 |
in a face description" |
Valid TYPEs are: string, symbol, int, stringtnil, tnil." |
188 |
(let (ret) |
(let (ret) |
189 |
(setq ret (cond ((eq type 'string) attrvalue) |
(setq ret (cond ((eq type 'string) attrvalue) |
190 |
((eq type 'symbol) (read attrvalue)) |
((eq type 'symbol) (read attrvalue)) |
198 |
((string= "nil" attrvalue) nil))))) |
((string= "nil" attrvalue) nil))))) |
199 |
; (message "(%s)[%s]=[%s]" (print type) attrvalue ret) |
; (message "(%s)[%s]=[%s]" (print type) attrvalue ret) |
200 |
ret)) |
ret)) |
201 |
|
|
202 |
|
|
203 |
(defun diary-pull-attrs (entry fileglobattrs) |
(defun diary-pull-attrs (entry fileglobattrs) |
204 |
"Pull the face-related attributes off the entry, merge with the |
"Pull the face-related attributes off the entry, merge with the |
205 |
fileglobattrs, and return the (possibly modified) entry and face |
fileglobattrs, and return the (possibly modified) entry and face |
206 |
data in a list of attrname attrvalue values. |
data in a list of attrname attrvalue values. |
207 |
The entry will be modified to drop all tags that are used for face matching. |
The entry will be modified to drop all tags that are used for face matching. |
208 |
If entry is nil, then the fileglobattrs are being searched for, |
If entry is nil, then the fileglobattrs are being searched for, |
209 |
the fileglobattrs variable is ignored, and |
the fileglobattrs variable is ignored, and |
210 |
diary-glob-file-regexp-prefix is prepended to the regexps before each |
diary-glob-file-regexp-prefix is prepended to the regexps before each |
211 |
search." |
search." |
212 |
(save-excursion |
(save-excursion |
213 |
(let (regexp regnum attrname attr-list attrname attrvalue type) |
(let (regexp regnum attrname attr-list attrname attrvalue type |
214 |
|
ret-attr attr) |
215 |
(if (null entry) |
(if (null entry) |
216 |
(progn |
(progn |
217 |
(setq ret-attr '() |
(setq ret-attr '() |
246 |
type (nth 3 attr)) |
type (nth 3 attr)) |
247 |
(setq attrvalue nil) |
(setq attrvalue nil) |
248 |
(if (string-match regexp entry) |
(if (string-match regexp entry) |
249 |
(progn |
(progn |
250 |
(setq attrvalue (substring-no-properties entry |
(setq attrvalue (substring-no-properties entry |
251 |
(match-beginning regnum) |
(match-beginning regnum) |
252 |
(match-end regnum))) |
(match-end regnum))) |
254 |
(if (and attrvalue |
(if (and attrvalue |
255 |
(setq attrvalue (diary-attrtype-convert attrvalue type))) |
(setq attrvalue (diary-attrtype-convert attrvalue type))) |
256 |
(setq ret-attr (append ret-attr (list attrname attrvalue)))) |
(setq ret-attr (append ret-attr (list attrname attrvalue)))) |
257 |
(setq attr-list (cdr attr-list))))))) |
(setq attr-list (cdr attr-list))))) |
258 |
(list entry ret-attr)) |
(list entry ret-attr)))) |
259 |
|
|
260 |
|
|
261 |
|
;; This can be removed once the kill/yank treatment of invisible text |
262 |
|
;; (see etc/TODO) is fixed. -- gm |
263 |
|
(defcustom diary-header-line-flag t |
264 |
|
"*If non-nil, `simple-diary-display' will show a header line. |
265 |
|
The format of the header is specified by `diary-header-line-format'." |
266 |
|
:group 'diary |
267 |
|
:type 'boolean |
268 |
|
:version "21.4") |
269 |
|
|
270 |
|
(defcustom diary-header-line-format |
271 |
|
'(:eval (calendar-string-spread |
272 |
|
(list (if selective-display |
273 |
|
"Selective display active - press \"s\" in calendar \ |
274 |
|
before edit/copy" |
275 |
|
"Diary")) |
276 |
|
?\ (frame-width))) |
277 |
|
"*Format of the header line displayed by `simple-diary-display'. |
278 |
|
Only used if `diary-header-line-flag' is non-nil." |
279 |
|
:group 'diary |
280 |
|
:type 'sexp |
281 |
|
:version "21.4") |
282 |
|
|
283 |
(defun list-diary-entries (date number) |
(defun list-diary-entries (date number) |
284 |
"Create and display a buffer containing the relevant lines in diary-file. |
"Create and display a buffer containing the relevant lines in diary-file. |
315 |
notification function." |
notification function." |
316 |
|
|
317 |
(if (< 0 number) |
(if (< 0 number) |
318 |
(let* ((original-date date);; save for possible use in the hooks |
(let ((original-date date);; save for possible use in the hooks |
319 |
old-diary-syntax-table |
old-diary-syntax-table |
320 |
diary-entries-list |
diary-entries-list |
321 |
file-glob-attrs |
file-glob-attrs |
322 |
(date-string (calendar-date-string date)) |
(date-string (calendar-date-string date)) |
323 |
(d-file (substitute-in-file-name diary-file))) |
(d-file (substitute-in-file-name diary-file))) |
324 |
(message "Preparing diary...") |
(message "Preparing diary...") |
325 |
(save-excursion |
(save-excursion |
326 |
(let ((diary-buffer (find-buffer-visiting d-file))) |
(let ((diary-buffer (find-buffer-visiting d-file))) |
332 |
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil ""))) |
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil ""))) |
333 |
(setq selective-display t) |
(setq selective-display t) |
334 |
(setq selective-display-ellipses nil) |
(setq selective-display-ellipses nil) |
335 |
|
(if diary-header-line-flag |
336 |
|
(setq header-line-format diary-header-line-format)) |
337 |
(setq old-diary-syntax-table (syntax-table)) |
(setq old-diary-syntax-table (syntax-table)) |
338 |
(set-syntax-table diary-syntax-table) |
(set-syntax-table diary-syntax-table) |
339 |
(unwind-protect |
(unwind-protect |
364 |
(car d))) |
(car d))) |
365 |
(backup (equal (car (car d)) 'backup)) |
(backup (equal (car (car d)) 'backup)) |
366 |
(dayname |
(dayname |
367 |
(concat |
(format "%s\\|%s\\.?" |
368 |
(calendar-day-name date) "\\|" |
(calendar-day-name date) |
369 |
(substring (calendar-day-name date) 0 3) ".?")) |
(calendar-day-name date 'abbrev))) |
370 |
(monthname |
(monthname |
371 |
(concat |
(format "\\*\\|%s\\|%s\\.?" |
372 |
"\\*\\|" |
(calendar-month-name month) |
373 |
(calendar-month-name month) "\\|" |
(calendar-month-name month 'abbrev))) |
|
(substring (calendar-month-name month) 0 3) ".?")) |
|
374 |
(month (concat "\\*\\|0*" (int-to-string month))) |
(month (concat "\\*\\|0*" (int-to-string month))) |
375 |
(day (concat "\\*\\|0*" (int-to-string day))) |
(day (concat "\\*\\|0*" (int-to-string day))) |
376 |
(year |
(year |
397 |
;; add it to the list. |
;; add it to the list. |
398 |
(setq entry-found t) |
(setq entry-found t) |
399 |
(let ((entry-start (point)) |
(let ((entry-start (point)) |
400 |
(date-start)) |
date-start temp) |
401 |
(re-search-backward "\^M\\|\n\\|\\`") |
(re-search-backward "\^M\\|\n\\|\\`") |
402 |
(setq date-start (point)) |
(setq date-start (point)) |
403 |
(re-search-forward "\^M\\|\n" nil t 2) |
(re-search-forward "\^M\\|\n" nil t 2) |
408 |
(point) ?\^M ?\n t) |
(point) ?\^M ?\n t) |
409 |
(setq entry (buffer-substring entry-start (point)) |
(setq entry (buffer-substring entry-start (point)) |
410 |
temp (diary-pull-attrs entry file-glob-attrs) |
temp (diary-pull-attrs entry file-glob-attrs) |
411 |
entry (nth 0 temp) |
entry (nth 0 temp)) |
|
marks (nth 1 temp)) |
|
412 |
(add-to-diary-list |
(add-to-diary-list |
413 |
date |
date |
414 |
entry |
entry |
415 |
(buffer-substring |
(buffer-substring |
416 |
(1+ date-start) (1- entry-start)) |
(1+ date-start) (1- entry-start)) |
417 |
(copy-marker entry-start) marks))))) |
(copy-marker entry-start) (nth 1 temp)))))) |
418 |
(setq d (cdr d))) |
(setq d (cdr d))) |
419 |
(or entry-found |
(or entry-found |
420 |
(not diary-list-include-blanks) |
(not diary-list-include-blanks) |
488 |
"Display the diary buffer if there are any relevant entries or holidays." |
"Display the diary buffer if there are any relevant entries or holidays." |
489 |
(let* ((holiday-list (if holidays-in-diary-buffer |
(let* ((holiday-list (if holidays-in-diary-buffer |
490 |
(check-calendar-holidays original-date))) |
(check-calendar-holidays original-date))) |
491 |
(msg (format "No diary entries for %s %s" |
(hol-string (format "%s%s%s" |
492 |
(concat date-string (if holiday-list ":" "")) |
date-string |
493 |
(mapconcat 'identity holiday-list "; ")))) |
(if holiday-list ": " "") |
494 |
(calendar-set-mode-line |
(mapconcat 'identity holiday-list "; "))) |
495 |
(concat "Diary for " date-string |
(msg (format "No diary entries for %s" hol-string)) |
496 |
(if holiday-list ": " "") |
;; If selected window is dedicated (to the calendar), |
497 |
(mapconcat 'identity holiday-list "; "))) |
;; need a new one to display the diary. |
498 |
|
(pop-up-frames (window-dedicated-p (selected-window)))) |
499 |
|
(calendar-set-mode-line (format "Diary for %s" hol-string)) |
500 |
(if (or (not diary-entries-list) |
(if (or (not diary-entries-list) |
501 |
(and (not (cdr diary-entries-list)) |
(and (not (cdr diary-entries-list)) |
502 |
(string-equal (car (cdr (car diary-entries-list))) ""))) |
(string-equal (car (cdr (car diary-entries-list))) ""))) |
503 |
(if (<= (length msg) (frame-width)) |
(if (< (length msg) (frame-width)) |
504 |
(message "%s" msg) |
(message "%s" msg) |
505 |
(set-buffer (get-buffer-create holiday-buffer)) |
(set-buffer (get-buffer-create holiday-buffer)) |
506 |
(setq buffer-read-only nil) |
(setq buffer-read-only nil) |
512 |
(setq buffer-read-only t) |
(setq buffer-read-only t) |
513 |
(display-buffer holiday-buffer) |
(display-buffer holiday-buffer) |
514 |
(message "No diary entries for %s" date-string)) |
(message "No diary entries for %s" date-string)) |
515 |
(display-buffer (find-buffer-visiting d-file)) |
(display-buffer (find-buffer-visiting |
516 |
|
(substitute-in-file-name diary-file))) |
517 |
(message "Preparing diary...done")))) |
(message "Preparing diary...done")))) |
518 |
|
|
519 |
(defface diary-button-face '((((type pc) (class color)) |
(defface diary-button-face '((((type pc) (class color)) |
626 |
:type 'diary-entry) |
:type 'diary-entry) |
627 |
(insert entry ?\n)) |
(insert entry ?\n)) |
628 |
(save-excursion |
(save-excursion |
629 |
(setq marks (nth 4 (car entry-list))) |
(let* ((marks (nth 4 (car entry-list))) |
630 |
(setq temp-face (make-symbol (apply 'concat "temp-face-" (mapcar '(lambda (sym) (if (not (stringp sym)) (symbol-name sym) sym)) marks)))) |
(temp-face (make-symbol |
631 |
(make-face temp-face) |
(apply |
632 |
;; Remove :face info from the marks, copy the face info into temp-face |
'concat "temp-face-" |
633 |
(setq faceinfo marks) |
(mapcar '(lambda (sym) |
634 |
(while (setq faceinfo (memq :face faceinfo)) |
(if (stringp sym) |
635 |
(copy-face (read (nth 1 faceinfo)) temp-face) |
sym |
636 |
(setcar faceinfo nil) |
(symbol-name sym))) |
637 |
(setcar (cdr faceinfo) nil)) |
marks)))) |
638 |
(setq marks (delq nil marks)) |
faceinfo) |
639 |
|
;; Remove :face info from the marks, |
640 |
|
;; copy the face info into temp-face |
641 |
|
(setq faceinfo marks) |
642 |
|
(while (setq faceinfo (memq :face faceinfo)) |
643 |
|
(copy-face (read (nth 1 faceinfo)) temp-face) |
644 |
|
(setcar faceinfo nil) |
645 |
|
(setcar (cdr faceinfo) nil)) |
646 |
|
(setq marks (delq nil marks)) |
647 |
;; Apply the font aspects |
;; Apply the font aspects |
648 |
(apply 'set-face-attribute temp-face nil marks) |
(apply 'set-face-attribute temp-face nil marks) |
649 |
(search-backward entry) |
(search-backward entry) |
650 |
(overlay-put |
(overlay-put |
651 |
(make-overlay (match-beginning 0) (match-end 0)) 'face temp-face)) |
(make-overlay (match-beginning 0) (match-end 0)) |
652 |
)) |
'face temp-face))))) |
653 |
(setq entry-list (cdr entry-list)))) |
(setq entry-list (cdr entry-list)))) |
654 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |
655 |
(goto-char (point-min)) |
(goto-char (point-min)) |
663 |
(save-excursion |
(save-excursion |
664 |
(set-buffer (get-buffer-create fancy-diary-buffer)) |
(set-buffer (get-buffer-create fancy-diary-buffer)) |
665 |
(setq buffer-read-only nil) |
(setq buffer-read-only nil) |
|
(make-local-variable 'mode-line-format) |
|
666 |
(calendar-set-mode-line "Diary Entries") |
(calendar-set-mode-line "Diary Entries") |
667 |
(erase-buffer) |
(erase-buffer) |
668 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |
715 |
all entries, not just some, are visible. If there is no diary buffer, one |
all entries, not just some, are visible. If there is no diary buffer, one |
716 |
is created." |
is created." |
717 |
(interactive) |
(interactive) |
718 |
(let ((d-file (substitute-in-file-name diary-file))) |
(let ((d-file (diary-check-diary-file))) |
719 |
(if (and d-file (file-exists-p d-file)) |
(save-excursion |
720 |
(if (file-readable-p d-file) |
(set-buffer (or (find-buffer-visiting d-file) |
721 |
(save-excursion |
(find-file-noselect d-file t))) |
722 |
(let ((diary-buffer (find-buffer-visiting d-file))) |
(let ((buffer-read-only nil) |
723 |
(set-buffer (if diary-buffer |
(diary-modified (buffer-modified-p))) |
724 |
diary-buffer |
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t) |
725 |
(find-file-noselect d-file t))) |
(setq selective-display nil |
726 |
(let ((buffer-read-only nil) |
mode-line-format default-mode-line-format) |
727 |
(diary-modified (buffer-modified-p))) |
(display-buffer (current-buffer)) |
728 |
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t) |
(set-buffer-modified-p diary-modified))))) |
|
(setq selective-display nil) |
|
|
(make-local-variable 'mode-line-format) |
|
|
(setq mode-line-format default-mode-line-format) |
|
|
(display-buffer (current-buffer)) |
|
|
(set-buffer-modified-p diary-modified)))) |
|
|
(error "Your diary file is not readable!")) |
|
|
(error "You don't have a diary file!")))) |
|
|
|
|
|
|
|
729 |
|
|
730 |
(defcustom diary-mail-addr |
(defcustom diary-mail-addr |
731 |
(if (boundp 'user-mail-address) user-mail-address nil) |
(if (boundp 'user-mail-address) user-mail-address "") |
732 |
"*Email address that `diary-mail-entries' will send email to." |
"*Email address that `diary-mail-entries' will send email to." |
733 |
:group 'diary |
:group 'diary |
734 |
:type '(choice string (const nil)) |
:type 'string |
735 |
:version "20.3") |
:version "20.3") |
736 |
|
|
737 |
(defcustom diary-mail-days 7 |
(defcustom diary-mail-days 7 |
738 |
"*Number of days for `diary-mail-entries' to check." |
"*Default number of days for `diary-mail-entries' to check." |
739 |
:group 'diary |
:group 'diary |
740 |
:type 'integer |
:type 'integer |
741 |
:version "20.3") |
:version "20.3") |
744 |
(defun diary-mail-entries (&optional ndays) |
(defun diary-mail-entries (&optional ndays) |
745 |
"Send a mail message showing diary entries for next NDAYS days. |
"Send a mail message showing diary entries for next NDAYS days. |
746 |
If no prefix argument is given, NDAYS is set to `diary-mail-days'. |
If no prefix argument is given, NDAYS is set to `diary-mail-days'. |
747 |
|
Mail is sent to the address specified by `diary-mail-addr'. |
748 |
|
|
749 |
You can call `diary-mail-entries' every night using an at/cron job. |
You can call `diary-mail-entries' every night using an at/cron job. |
750 |
For example, this script will run the program at 2am daily. Since |
For example, this script will run the program at 2am daily. Since |
755 |
# diary-rem.sh -- repeatedly run the Emacs diary-reminder |
# diary-rem.sh -- repeatedly run the Emacs diary-reminder |
756 |
emacs -batch \\ |
emacs -batch \\ |
757 |
-eval \"(setq diary-mail-days 3 \\ |
-eval \"(setq diary-mail-days 3 \\ |
758 |
|
diary-file \\\"/path/to/diary.file\\\" \\ |
759 |
european-calendar-style t \\ |
european-calendar-style t \\ |
760 |
diary-mail-addr \\\"user@host.name\\\" )\" \\ |
diary-mail-addr \\\"user@host.name\\\" )\" \\ |
761 |
-l diary-lib -f diary-mail-entries |
-l diary-lib -f diary-mail-entries |
766 |
0 1 * * * diary-rem.sh |
0 1 * * * diary-rem.sh |
767 |
to run it every morning at 1am." |
to run it every morning at 1am." |
768 |
(interactive "P") |
(interactive "P") |
769 |
(let* ((diary-display-hook 'fancy-diary-display) |
(if (string-equal diary-mail-addr "") |
770 |
(text (progn (list-diary-entries (calendar-current-date) |
(error "You must set `diary-mail-addr' to use this command") |
771 |
(if ndays ndays diary-mail-days)) |
(let ((diary-display-hook 'fancy-diary-display)) |
772 |
(set-buffer fancy-diary-buffer) |
(list-diary-entries (calendar-current-date) (or ndays diary-mail-days))) |
|
(buffer-substring (point-min) (point-max))))) |
|
773 |
(compose-mail diary-mail-addr |
(compose-mail diary-mail-addr |
774 |
(if (string-equal text "") |
(concat "Diary entries generated " |
775 |
"No entries found" |
(calendar-date-string (calendar-current-date)))) |
776 |
(concat "Diary entries generated " |
(insert |
777 |
(calendar-date-string (calendar-current-date))))) |
(if (get-buffer fancy-diary-buffer) |
778 |
(insert text) |
(save-excursion |
779 |
(funcall (get mail-user-agent 'sendfunc)))) |
(set-buffer fancy-diary-buffer) |
780 |
|
(buffer-substring (point-min) (point-max))) |
781 |
|
"No entries found")) |
782 |
(defun diary-name-pattern (string-array &optional fullname) |
(call-interactively (get mail-user-agent 'sendfunc)))) |
783 |
"Convert a STRING-ARRAY, an array of strings to a pattern. |
|
784 |
The pattern will match any of the strings, either entirely or abbreviated |
(defun diary-name-pattern (string-array &optional abbrev-array paren) |
785 |
to three characters. An abbreviated form will match with or without a period; |
"Return a regexp matching the strings in the array STRING-ARRAY. |
786 |
If the optional FULLNAME is t, abbreviations will not match, just the full |
If the optional argument ABBREV-ARRAY is present, then the function |
787 |
name." |
`calendar-abbrev-construct' is used to construct abbreviations from the |
788 |
(let ((pattern "")) |
two supplied arrays. The returned regexp will then also match these |
789 |
(calendar-for-loop i from 0 to (1- (length string-array)) do |
abbreviations, with or without final `.' characters. If the optional |
790 |
(setq pattern |
argument PAREN is non-nil, the regexp is surrounded by parentheses." |
791 |
(concat |
(regexp-opt (append string-array |
792 |
pattern |
(if abbrev-array |
793 |
(if (string-equal pattern "") "" "\\|") |
(calendar-abbrev-construct abbrev-array |
794 |
(aref string-array i) |
string-array)) |
795 |
(if fullname |
(if abbrev-array |
796 |
"" |
(calendar-abbrev-construct abbrev-array |
797 |
(concat |
string-array |
798 |
"\\|" |
'period)) |
799 |
(substring (aref string-array i) 0 3) ".?"))))) |
nil) |
800 |
pattern)) |
paren)) |
801 |
|
|
802 |
(defvar marking-diary-entries nil |
(defvar marking-diary-entries nil |
803 |
"True during the marking of diary entries, nil otherwise.") |
"True during the marking of diary entries, nil otherwise.") |
812 |
`mark-diary-entries-hook' are run." |
`mark-diary-entries-hook' are run." |
813 |
(interactive) |
(interactive) |
814 |
(setq mark-diary-entries-in-calendar t) |
(setq mark-diary-entries-in-calendar t) |
815 |
(let (file-glob-attrs |
(let ((marking-diary-entries t) |
816 |
marks |
file-glob-attrs marks) |
817 |
(d-file (substitute-in-file-name diary-file)) |
(save-excursion |
818 |
(marking-diary-entries t)) |
(set-buffer (find-file-noselect (diary-check-diary-file) t)) |
819 |
(if (and d-file (file-exists-p d-file)) |
(message "Marking diary entries...") |
820 |
(if (file-readable-p d-file) |
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
821 |
(save-excursion |
(let ((d diary-date-forms) |
822 |
(message "Marking diary entries...") |
(old-diary-syntax-table (syntax-table)) |
823 |
(set-buffer (find-file-noselect d-file t)) |
temp) |
824 |
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
(set-syntax-table diary-syntax-table) |
825 |
(let ((d diary-date-forms) |
(while d |
826 |
(old-diary-syntax-table)) |
(let* ((date-form (if (equal (car (car d)) 'backup) |
827 |
(setq old-diary-syntax-table (syntax-table)) |
(cdr (car d)) |
828 |
(set-syntax-table diary-syntax-table) |
(car d)));; ignore 'backup directive |
829 |
(while d |
(dayname |
830 |
(let* |
(diary-name-pattern calendar-day-name-array |
831 |
((date-form (if (equal (car (car d)) 'backup) |
calendar-day-abbrev-array)) |
832 |
(cdr (car d)) |
(monthname |
833 |
(car d)));; ignore 'backup directive |
(format "%s\\|\\*" |
834 |
(dayname (diary-name-pattern calendar-day-name-array)) |
(diary-name-pattern calendar-month-name-array |
835 |
(monthname |
calendar-month-abbrev-array))) |
836 |
(concat |
(month "[0-9]+\\|\\*") |
837 |
(diary-name-pattern calendar-month-name-array) |
(day "[0-9]+\\|\\*") |
838 |
"\\|\\*")) |
(year "[0-9]+\\|\\*") |
839 |
(month "[0-9]+\\|\\*") |
(l (length date-form)) |
840 |
(day "[0-9]+\\|\\*") |
(d-name-pos (- l (length (memq 'dayname date-form)))) |
841 |
(year "[0-9]+\\|\\*") |
(d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) |
842 |
(l (length date-form)) |
(m-name-pos (- l (length (memq 'monthname date-form)))) |
843 |
(d-name-pos (- l (length (memq 'dayname date-form)))) |
(m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) |
844 |
(d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) |
(d-pos (- l (length (memq 'day date-form)))) |
845 |
(m-name-pos (- l (length (memq 'monthname date-form)))) |
(d-pos (if (/= l d-pos) (+ 2 d-pos))) |
846 |
(m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) |
(m-pos (- l (length (memq 'month date-form)))) |
847 |
(d-pos (- l (length (memq 'day date-form)))) |
(m-pos (if (/= l m-pos) (+ 2 m-pos))) |
848 |
(d-pos (if (/= l d-pos) (+ 2 d-pos))) |
(y-pos (- l (length (memq 'year date-form)))) |
849 |
(m-pos (- l (length (memq 'month date-form)))) |
(y-pos (if (/= l y-pos) (+ 2 y-pos))) |
850 |
(m-pos (if (/= l m-pos) (+ 2 m-pos))) |
(regexp |
851 |
(y-pos (- l (length (memq 'year date-form)))) |
(concat |
852 |
(y-pos (if (/= l y-pos) (+ 2 y-pos))) |
"\\(\\`\\|\^M\\|\n\\)\\(" |
853 |
(regexp |
(mapconcat 'eval date-form "\\)\\(") |
854 |
(concat |
"\\)")) |
855 |
"\\(\\`\\|\^M\\|\n\\)\\(" |
(case-fold-search t)) |
856 |
(mapconcat 'eval date-form "\\)\\(") |
(goto-char (point-min)) |
857 |
"\\)")) |
(while (re-search-forward regexp nil t) |
858 |
(case-fold-search t)) |
(let* ((dd-name |
859 |
(goto-char (point-min)) |
(if d-name-pos |
860 |
(while (re-search-forward regexp nil t) |
(buffer-substring-no-properties |
861 |
(let* ((dd-name |
(match-beginning d-name-pos) |
862 |
(if d-name-pos |
(match-end d-name-pos)))) |
863 |
(buffer-substring-no-properties |
(mm-name |
864 |
(match-beginning d-name-pos) |
(if m-name-pos |
865 |
(match-end d-name-pos)))) |
(buffer-substring-no-properties |
866 |
(mm-name |
(match-beginning m-name-pos) |
867 |
(if m-name-pos |
(match-end m-name-pos)))) |
868 |
(buffer-substring-no-properties |
(mm (string-to-int |
869 |
(match-beginning m-name-pos) |
(if m-pos |
870 |
(match-end m-name-pos)))) |
(buffer-substring-no-properties |
871 |
(mm (string-to-int |
(match-beginning m-pos) |
872 |
(if m-pos |
(match-end m-pos)) |
873 |
(buffer-substring-no-properties |
""))) |
874 |
(match-beginning m-pos) |
(dd (string-to-int |
875 |
(match-end m-pos)) |
(if d-pos |
876 |
""))) |
(buffer-substring-no-properties |
877 |
(dd (string-to-int |
(match-beginning d-pos) |
878 |
(if d-pos |
(match-end d-pos)) |
879 |
(buffer-substring-no-properties |
""))) |
880 |
(match-beginning d-pos) |
(y-str (if y-pos |
881 |
(match-end d-pos)) |
(buffer-substring-no-properties |
882 |
""))) |
(match-beginning y-pos) |
883 |
(y-str (if y-pos |
(match-end y-pos)))) |
884 |
(buffer-substring-no-properties |
(yy (if (not y-str) |
885 |
(match-beginning y-pos) |
0 |
886 |
(match-end y-pos)))) |
(if (and (= (length y-str) 2) |
887 |
(yy (if (not y-str) |
abbreviated-calendar-year) |
888 |
0 |
(let* ((current-y |
889 |
(if (and (= (length y-str) 2) |
(extract-calendar-year |
890 |
abbreviated-calendar-year) |
(calendar-current-date))) |
891 |
(let* ((current-y |
(y (+ (string-to-int y-str) |
892 |
(extract-calendar-year |
(* 100 |
893 |
(calendar-current-date))) |
(/ current-y 100))))) |
894 |
(y (+ (string-to-int y-str) |
(if (> (- y current-y) 50) |
895 |
(* 100 |
(- y 100) |
896 |
(/ current-y 100))))) |
(if (> (- current-y y) 50) |
897 |
(if (> (- y current-y) 50) |
(+ y 100) |
898 |
(- y 100) |
y))) |
899 |
(if (> (- current-y y) 50) |
(string-to-int y-str)))) |
900 |
(+ y 100) |
(save-excursion |
901 |
y))) |
(setq entry (buffer-substring-no-properties |
902 |
(string-to-int y-str)))) |
(point) (line-end-position)) |
903 |
(save-excursion |
temp (diary-pull-attrs entry file-glob-attrs) |
904 |
(setq entry (buffer-substring-no-properties (point) (line-end-position)) |
entry (nth 0 temp) |
905 |
temp (diary-pull-attrs entry file-glob-attrs) |
marks (nth 1 temp)))) |
906 |
entry (nth 0 temp) |
(if dd-name |
907 |
marks (nth 1 temp)))) |
(mark-calendar-days-named |
908 |
(if dd-name |
(cdr (assoc-ignore-case |
909 |
(mark-calendar-days-named |
dd-name |
910 |
(cdr (assoc-ignore-case |
(calendar-make-alist |
911 |
(substring dd-name 0 3) |
calendar-day-name-array |
912 |
(calendar-make-alist |
0 nil calendar-day-abbrev-array))) marks) |
913 |
calendar-day-name-array |
(if mm-name |
914 |
0 |
(setq mm |
915 |
(lambda (x) (substring x 0 3))))) marks) |
(if (string-equal mm-name "*") 0 |
916 |
(if mm-name |
(cdr (assoc-ignore-case |
917 |
(if (string-equal mm-name "*") |
mm-name |
918 |
(setq mm 0) |
(calendar-make-alist |
919 |
(setq mm |
calendar-month-name-array |
920 |
(cdr (assoc-ignore-case |
1 nil calendar-month-abbrev-array)))))) |
921 |
(substring mm-name 0 3) |
(mark-calendar-date-pattern mm dd yy marks)))) |
922 |
(calendar-make-alist |
(setq d (cdr d)))) |
923 |
calendar-month-name-array |
(mark-sexp-diary-entries) |
924 |
1 |
(run-hooks 'nongregorian-diary-marking-hook |
925 |
(lambda (x) (substring x 0 3))) |
'mark-diary-entries-hook) |
926 |
))))) |
(set-syntax-table old-diary-syntax-table) |
927 |
(mark-calendar-date-pattern mm dd yy marks)))) |
(message "Marking diary entries...done"))))) |
|
(setq d (cdr d)))) |
|
|
(mark-sexp-diary-entries) |
|
|
(run-hooks 'nongregorian-diary-marking-hook |
|
|
'mark-diary-entries-hook) |
|
|
(set-syntax-table old-diary-syntax-table) |
|
|
(message "Marking diary entries...done"))) |
|
|
(error "Your diary file is not readable!")) |
|
|
(error "You don't have a diary file!")))) |
|
928 |
|
|
929 |
(defun mark-sexp-diary-entries () |
(defun mark-sexp-diary-entries () |
930 |
"Mark days in the calendar window that have sexp diary entries. |
"Mark days in the calendar window that have sexp diary entries. |
932 |
is marked. See the documentation for the function `list-sexp-diary-entries'." |
is marked. See the documentation for the function `list-sexp-diary-entries'." |
933 |
(let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol)) |
(let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol)) |
934 |
(s-entry (concat "\\(\\`\\|\^M\\|\n\\)\\(" |
(s-entry (concat "\\(\\`\\|\^M\\|\n\\)\\(" |
935 |
(regexp-quote sexp-mark) "(\\)\\|\\(" |
sexp-mark "(\\)\\|\\(" |
936 |
(regexp-quote diary-nonmarking-symbol) |
(regexp-quote diary-nonmarking-symbol) |
937 |
(regexp-quote sexp-mark) "(diary-remind\\)")) |
sexp-mark "(diary-remind\\)")) |
938 |
(m) |
(file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
939 |
(y) |
m y first-date last-date mark file-glob-attrs) |
|
(first-date) |
|
|
(last-date) |
|
|
(mark) |
|
|
file-glob-attrs) |
|
|
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
|
940 |
(save-excursion |
(save-excursion |
941 |
(set-buffer calendar-buffer) |
(set-buffer calendar-buffer) |
942 |
(setq m displayed-month) |
(setq m displayed-month) |
950 |
(list m (calendar-last-day-of-month m y) y))) |
(list m (calendar-last-day-of-month m y) y))) |
951 |
(goto-char (point-min)) |
(goto-char (point-min)) |
952 |
(while (re-search-forward s-entry nil t) |
(while (re-search-forward s-entry nil t) |
953 |
(if (char-equal (preceding-char) ?\() |
(setq marking-diary-entry (char-equal (preceding-char) ?\()) |
|
(setq marking-diary-entry t) |
|
|
(setq marking-diary-entry nil)) |
|
954 |
(re-search-backward "(") |
(re-search-backward "(") |
955 |
(let ((sexp-start (point)) |
(let ((sexp-start (point)) |
956 |
(sexp) |
sexp entry entry-start line-start marks) |
|
(entry) |
|
|
(entry-start) |
|
|
(line-start)) |
|
957 |
(forward-sexp) |
(forward-sexp) |
958 |
(setq sexp (buffer-substring-no-properties sexp-start (point))) |
(setq sexp (buffer-substring-no-properties sexp-start (point))) |
959 |
(save-excursion |
(save-excursion |
983 |
(calendar-gregorian-from-absolute date))) |
(calendar-gregorian-from-absolute date))) |
984 |
(progn |
(progn |
985 |
(setq marks (diary-pull-attrs entry file-glob-attrs) |
(setq marks (diary-pull-attrs entry file-glob-attrs) |
986 |
temp (diary-pull-attrs entry file-glob-attrs) |
marks (nth 1 (diary-pull-attrs entry file-glob-attrs))) |
|
marks (nth 1 temp)) |
|
987 |
(mark-visible-calendar-date |
(mark-visible-calendar-date |
988 |
(calendar-gregorian-from-absolute date) |
(calendar-gregorian-from-absolute date) |
989 |
(if (< 0 (length marks)) |
(if (< 0 (length marks)) |
990 |
marks |
marks |
991 |
(if (consp mark) |
(if (consp mark) |
1286 |
|
|
1287 |
Marking these entries is *extremely* time consuming, so these entries are |
Marking these entries is *extremely* time consuming, so these entries are |
1288 |
best if they are nonmarking." |
best if they are nonmarking." |
1289 |
(let* ((mark (regexp-quote diary-nonmarking-symbol)) |
(let ((s-entry (concat "\\(\\`\\|\^M\\|\n\\)" |
1290 |
(sexp-mark (regexp-quote sexp-diary-entry-symbol)) |
(regexp-quote diary-nonmarking-symbol) |
1291 |
(s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) |
"?" |
1292 |
(entry-found) |
(regexp-quote sexp-diary-entry-symbol) |
1293 |
(file-glob-attrs) |
"(")) |
1294 |
(marks)) |
entry-found file-glob-attrs marks) |
1295 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1296 |
(save-excursion |
(save-excursion |
1297 |
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))) |
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))) |
1298 |
(while (re-search-forward s-entry nil t) |
(while (re-search-forward s-entry nil t) |
1299 |
(backward-char 1) |
(backward-char 1) |
1300 |
(let ((sexp-start (point)) |
(let ((sexp-start (point)) |
1301 |
(sexp) |
sexp entry specifier entry-start line-start) |
|
(entry) |
|
|
(specifier) |
|
|
(entry-start) |
|
|
(line-start)) |
|
1302 |
(forward-sexp) |
(forward-sexp) |
1303 |
(setq sexp (buffer-substring-no-properties sexp-start (point))) |
(setq sexp (buffer-substring-no-properties sexp-start (point))) |
1304 |
(save-excursion |
(save-excursion |
1322 |
(setq entry (buffer-substring-no-properties entry-start (point))) |
(setq entry (buffer-substring-no-properties entry-start (point))) |
1323 |
(while (string-match "[\^M]" entry) |
(while (string-match "[\^M]" entry) |
1324 |
(aset entry (match-beginning 0) ?\n ))) |
(aset entry (match-beginning 0) ?\n ))) |
1325 |
(let ((diary-entry (diary-sexp-entry sexp entry date))) |
(let ((diary-entry (diary-sexp-entry sexp entry date)) |
1326 |
|
temp) |
1327 |
(setq entry (if (consp diary-entry) |
(setq entry (if (consp diary-entry) |
1328 |
(cdr diary-entry) |
(cdr diary-entry) |
1329 |
diary-entry)) |
diary-entry)) |
1338 |
entry |
entry |
1339 |
specifier |
specifier |
1340 |
(if entry-start (copy-marker entry-start) |
(if entry-start (copy-marker entry-start) |
1341 |
nil) |
nil) |
1342 |
marks) |
marks) |
1343 |
(setq entry-found (or entry-found diary-entry))))) |
(setq entry-found (or entry-found diary-entry))))) |
1344 |
entry-found)) |
entry-found)) |
1378 |
|
|
1379 |
An optional parameter MARK specifies a face or single-character string to |
An optional parameter MARK specifies a face or single-character string to |
1380 |
use when highlighting the day in the calendar." |
use when highlighting the day in the calendar." |
1381 |
(let* ((dd (if european-calendar-style |
(let ((dd (if european-calendar-style |
1382 |
month |
month |
1383 |
day)) |
day)) |
1384 |
(mm (if european-calendar-style |
(mm (if european-calendar-style |
1385 |
day |
day |
1386 |
month)) |
month)) |
1387 |
(m (extract-calendar-month date)) |
(m (extract-calendar-month date)) |
1388 |
(y (extract-calendar-year date)) |
(y (extract-calendar-year date)) |
1389 |
(d (extract-calendar-day date))) |
(d (extract-calendar-day date))) |
1390 |
(if (and |
(if (and |
1391 |
(or (and (listp dd) (memq d dd)) |
(or (and (listp dd) (memq d dd)) |
1392 |
(equal d dd) |
(equal d dd) |
1600 |
(defun add-to-diary-list (date string specifier marker &optional globcolor) |
(defun add-to-diary-list (date string specifier marker &optional globcolor) |
1601 |
"Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'. |
"Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'. |
1602 |
Do nothing if DATE or STRING is nil." |
Do nothing if DATE or STRING is nil." |
1603 |
(and date string |
(when (and date string) |
1604 |
(if (and diary-file-name-prefix |
(if diary-file-name-prefix |
1605 |
(setq prefix (concat "[" (funcall diary-file-name-prefix-function (buffer-file-name)) "] ")) |
(let ((prefix (funcall diary-file-name-prefix-function |
1606 |
(not (string= prefix "[] "))) |
(buffer-file-name)))) |
1607 |
(setq string (concat prefix string)) |
(or (string= prefix "") |
1608 |
t) |
(setq string (format "[%s] %s" prefix string))))) |
1609 |
(setq diary-entries-list |
(setq diary-entries-list |
1610 |
(append diary-entries-list |
(append diary-entries-list |
1611 |
(list (list date string specifier marker globcolor)))))) |
(list (list date string specifier marker globcolor)))))) |
1612 |
|
|
1613 |
(defun make-diary-entry (string &optional nonmarking file) |
(defun make-diary-entry (string &optional nonmarking file) |
1614 |
"Insert a diary entry STRING which may be NONMARKING in FILE. |
"Insert a diary entry STRING which may be NONMARKING in FILE. |
1615 |
If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." |
If omitted, NONMARKING defaults to nil and FILE defaults to `diary-file'." |
1616 |
(find-file-other-window |
(let ((pop-up-frames (window-dedicated-p (selected-window)))) |
1617 |
(substitute-in-file-name (if file file diary-file))) |
(find-file-other-window (substitute-in-file-name (or file diary-file)))) |
1618 |
(widen) |
(widen) |
1619 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1620 |
(when (let ((case-fold-search t)) |
(when (let ((case-fold-search t)) |
1647 |
"Insert a monthly diary entry for the day of the month indicated by point. |
"Insert a monthly diary entry for the day of the month indicated by point. |
1648 |
Prefix arg will make the entry nonmarking." |
Prefix arg will make the entry nonmarking." |
1649 |
(interactive "P") |
(interactive "P") |
1650 |
(let* ((calendar-date-display-form |
(let ((calendar-date-display-form |
1651 |
(if european-calendar-style |
(if european-calendar-style |
1652 |
'(day " * ") |
'(day " * ") |
1653 |
'("* " day)))) |
'("* " day)))) |
1654 |
(make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t) |
(make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t) |
1655 |
arg))) |
arg))) |
1656 |
|
|
1658 |
"Insert an annual diary entry for the day of the year indicated by point. |
"Insert an annual diary entry for the day of the year indicated by point. |
1659 |
Prefix arg will make the entry nonmarking." |
Prefix arg will make the entry nonmarking." |
1660 |
(interactive "P") |
(interactive "P") |
1661 |
(let* ((calendar-date-display-form |
(let ((calendar-date-display-form |
1662 |
(if european-calendar-style |
(if european-calendar-style |
1663 |
'(day " " monthname) |
'(day " " monthname) |
1664 |
'(monthname " " day)))) |
'(monthname " " day)))) |
1665 |
(make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t) |
(make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t) |
1666 |
arg))) |
arg))) |
1667 |
|
|
1669 |
"Insert an anniversary diary entry for the date given by point. |
"Insert an anniversary diary entry for the date given by point. |
1670 |
Prefix arg will make the entry nonmarking." |
Prefix arg will make the entry nonmarking." |
1671 |
(interactive "P") |
(interactive "P") |
1672 |
(let* ((calendar-date-display-form |
(let ((calendar-date-display-form |
1673 |
(if european-calendar-style |
(if european-calendar-style |
1674 |
'(day " " month " " year) |
'(day " " month " " year) |
1675 |
'(month " " day " " year)))) |
'(month " " day " " year)))) |
1676 |
(make-diary-entry |
(make-diary-entry |
1677 |
(format "%s(diary-anniversary %s)" |
(format "%s(diary-anniversary %s)" |
1678 |
sexp-diary-entry-symbol |
sexp-diary-entry-symbol |
1683 |
"Insert a block diary entry for the days between the point and marked date. |
"Insert a block diary entry for the days between the point and marked date. |
1684 |
Prefix arg will make the entry nonmarking." |
Prefix arg will make the entry nonmarking." |
1685 |
(interactive "P") |
(interactive "P") |
1686 |
(let* ((calendar-date-display-form |
(let ((calendar-date-display-form |
1687 |
(if european-calendar-style |
(if european-calendar-style |
1688 |
'(day " " month " " year) |
'(day " " month " " year) |
1689 |
'(month " " day " " year))) |
'(month " " day " " year))) |
1690 |
(cursor (calendar-cursor-to-date t)) |
(cursor (calendar-cursor-to-date t)) |
1691 |
(mark (or (car calendar-mark-ring) |
(mark (or (car calendar-mark-ring) |
1692 |
(error "No mark set in this buffer"))) |
(error "No mark set in this buffer"))) |
1693 |
(start) |
start end) |
|
(end)) |
|
1694 |
(if (< (calendar-absolute-from-gregorian mark) |
(if (< (calendar-absolute-from-gregorian mark) |
1695 |
(calendar-absolute-from-gregorian cursor)) |
(calendar-absolute-from-gregorian cursor)) |
1696 |
(setq start mark |
(setq start mark |
1708 |
"Insert a cyclic diary entry starting at the date given by point. |
"Insert a cyclic diary entry starting at the date given by point. |
1709 |
Prefix arg will make the entry nonmarking." |
Prefix arg will make the entry nonmarking." |
1710 |
(interactive "P") |
(interactive "P") |
1711 |
(let* ((calendar-date-display-form |
(let ((calendar-date-display-form |
1712 |
(if european-calendar-style |
(if european-calendar-style |
1713 |
'(day " " month " " year) |
'(day " " month " " year) |
1714 |
'(month " " day " " year)))) |
'(month " " day " " year)))) |
1715 |
(make-diary-entry |
(make-diary-entry |
1716 |
(format "%s(diary-cyclic %d %s)" |
(format "%s(diary-cyclic %d %s)" |
1717 |
sexp-diary-entry-symbol |
sexp-diary-entry-symbol |
1731 |
"Diary" |
"Diary" |
1732 |
"Major mode used while displaying diary entries using Fancy Display." |
"Major mode used while displaying diary entries using Fancy Display." |
1733 |
(set (make-local-variable 'font-lock-defaults) |
(set (make-local-variable 'font-lock-defaults) |
1734 |
'(fancy-diary-font-lock-keywords t))) |
'(fancy-diary-font-lock-keywords t)) |
1735 |
|
(define-key (current-local-map) "q" 'quit-window)) |
1736 |
|
|
1737 |
|
|
1738 |
(defvar fancy-diary-font-lock-keywords |
(defvar fancy-diary-font-lock-keywords |
1739 |
(list |
(list |
1740 |
(cons |
(cons |
1741 |
(concat |
(concat |
1742 |
(let ((dayname |
(let ((dayname (diary-name-pattern calendar-day-name-array nil t)) |
1743 |
(concat "\\(" |
(monthname (diary-name-pattern calendar-month-name-array nil t)) |
|
(diary-name-pattern calendar-day-name-array t) |
|
|
"\\)")) |
|
|
(monthname |
|
|
(concat "\\(" |
|
|
(diary-name-pattern calendar-month-name-array t) |
|
|
"\\)")) |
|
1744 |
(day "[0-9]+") |
(day "[0-9]+") |
1745 |
(month "[0-9]+") |
(month "[0-9]+") |
1746 |
(year "-?[0-9]+")) |
(year "-?[0-9]+")) |
1773 |
t)) |
t)) |
1774 |
(error t)))) |
(error t)))) |
1775 |
|
|
1776 |
(defun font-lock-diary-date-forms (month-list &optional symbol noabbrev) |
(defun font-lock-diary-date-forms (month-array &optional symbol abbrev-array) |
1777 |
"Create a list of font-lock patterns for `diary-date-forms' with MONTH-LIST. |
"Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. |
1778 |
If given, optional SYMBOL must be a prefix to entries. |
If given, optional SYMBOL must be a prefix to entries. |
1779 |
If optional NOABBREV is t, do not allow abbreviations in names." |
If optional ABBREV-ARRAY is present, the abbreviations constructed |
1780 |
(let* ((dayname |
from this array by the function `calendar-abbrev-construct' are |
1781 |
(concat "\\(" (diary-name-pattern calendar-day-name-array) "\\)")) |
matched (with or without a final `.'), in addition to the full month |
1782 |
(monthname (concat "\\(" |
names." |
1783 |
(diary-name-pattern month-list noabbrev) |
(let ((dayname (diary-name-pattern calendar-day-name-array |
1784 |
"\\|\\*\\)")) |
calendar-day-abbrev-array t)) |
1785 |
(month "\\([0-9]+\\|\\*\\)") |
(monthname (format "\\(%s\\|\\*\\)" |
1786 |
(day "\\([0-9]+\\|\\*\\)") |
(diary-name-pattern month-array abbrev-array))) |
1787 |
(year "-?\\([0-9]+\\|\\*\\)")) |
(month "\\([0-9]+\\|\\*\\)") |
1788 |
|
(day "\\([0-9]+\\|\\*\\)") |
1789 |
|
(year "-?\\([0-9]+\\|\\*\\)")) |
1790 |
(mapcar '(lambda (x) |
(mapcar '(lambda (x) |
1791 |
(cons |
(cons |
1792 |
(concat "^" (regexp-quote diary-nonmarking-symbol) "?" |
(concat "^" (regexp-quote diary-nonmarking-symbol) "?" |
1805 |
'(1 diary-face))) |
'(1 diary-face))) |
1806 |
diary-date-forms))) |
diary-date-forms))) |
1807 |
|
|
1808 |
|
(eval-when-compile (require 'cal-hebrew) |
1809 |
|
(require 'cal-islam)) |
1810 |
|
|
1811 |
(defvar diary-font-lock-keywords |
(defvar diary-font-lock-keywords |
1812 |
(append |
(append |
1813 |
(font-lock-diary-date-forms calendar-month-name-array) |
(font-lock-diary-date-forms calendar-month-name-array |
1814 |
(if (or (memq 'mark-hebrew-diary-entries |
nil calendar-month-abbrev-array) |
1815 |
nongregorian-diary-marking-hook) |
(when (or (memq 'mark-hebrew-diary-entries |
1816 |
(memq 'list-hebrew-diary-entries |
nongregorian-diary-marking-hook) |
1817 |
nongregorian-diary-listing-hook)) |
(memq 'list-hebrew-diary-entries |
1818 |
(progn |
nongregorian-diary-listing-hook)) |
1819 |
(require 'cal-hebrew) |
(require 'cal-hebrew) |
1820 |
(font-lock-diary-date-forms |
(font-lock-diary-date-forms |
1821 |
calendar-hebrew-month-name-array-leap-year |
calendar-hebrew-month-name-array-leap-year |
1822 |
hebrew-diary-entry-symbol t))) |
hebrew-diary-entry-symbol)) |
1823 |
(if (or (memq 'mark-islamic-diary-entries |
(when (or (memq 'mark-islamic-diary-entries |
1824 |
nongregorian-diary-marking-hook) |
nongregorian-diary-marking-hook) |
1825 |
(memq 'list-islamic-diary-entries |
(memq 'list-islamic-diary-entries |
1826 |
nongregorian-diary-listing-hook)) |
nongregorian-diary-listing-hook)) |
1827 |
(progn |
(require 'cal-islam) |
1828 |
(require 'cal-islamic) |
(font-lock-diary-date-forms |
1829 |
(font-lock-diary-date-forms |
calendar-islamic-month-name-array |
1830 |
calendar-islamic-month-name-array-leap-year |
islamic-diary-entry-symbol)) |
|
islamic-diary-entry-symbol t))) |
|
1831 |
(list |
(list |
1832 |
(cons |
(cons |
1833 |
(concat "^" (regexp-quote diary-include-string) ".*$") |
(concat "^" (regexp-quote diary-include-string) ".*$") |
1855 |
|
|
1856 |
(provide 'diary-lib) |
(provide 'diary-lib) |
1857 |
|
|
1858 |
|
;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010 |
1859 |
;;; diary-lib.el ends here |
;;; diary-lib.el ends here |