58 |
(interactive "P") |
(interactive "P") |
59 |
(diary-check-diary-file) |
(diary-check-diary-file) |
60 |
(let ((date (calendar-current-date))) |
(let ((date (calendar-current-date))) |
61 |
(list-diary-entries |
(diary-list-entries date (if arg (prefix-numeric-value arg))))) |
|
date |
|
|
(cond (arg (prefix-numeric-value arg)) |
|
|
((vectorp number-of-diary-entries) |
|
|
(aref number-of-diary-entries (calendar-day-of-week date))) |
|
|
(t number-of-diary-entries))))) |
|
62 |
|
|
63 |
(defun view-diary-entries (arg) |
(define-obsolete-function-alias 'view-diary-entries 'diary-view-entries) |
64 |
|
(defun diary-view-entries (&optional arg) |
65 |
"Prepare and display a buffer with diary entries. |
"Prepare and display a buffer with diary entries. |
66 |
Searches the file named in `diary-file' for entries that |
Searches the file named in `diary-file' for entries that |
67 |
match ARG days starting with the date indicated by the cursor position |
match ARG days starting with the date indicated by the cursor position |
68 |
in the displayed three-month calendar." |
in the displayed three-month calendar." |
69 |
(interactive "p") |
(interactive "p") |
70 |
(diary-check-diary-file) |
(diary-check-diary-file) |
71 |
(list-diary-entries (calendar-cursor-to-date t) arg)) |
(diary-list-entries (calendar-cursor-to-date t) arg)) |
72 |
|
|
73 |
(defun view-other-diary-entries (arg d-file) |
(defun view-other-diary-entries (arg d-file) |
74 |
"Prepare and display buffer of diary entries from an alternative diary file. |
"Prepare and display buffer of diary entries from an alternative diary file. |
178 |
"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. |
179 |
No diary entry if there is no sunset on that date.") |
No diary entry if there is no sunset on that date.") |
180 |
|
|
181 |
(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table)) |
(defvar diary-syntax-table |
182 |
|
(let ((st (copy-syntax-table (standard-syntax-table)))) |
183 |
|
(modify-syntax-entry ?* "w" st) |
184 |
|
(modify-syntax-entry ?: "w" st) |
185 |
|
st) |
186 |
"The syntax table used when parsing dates in the diary file. |
"The syntax table used when parsing dates in the diary file. |
187 |
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 |
188 |
syntax of `*' and `:' changed to be word constituents.") |
syntax of `*' and `:' changed to be word constituents.") |
189 |
|
|
|
(modify-syntax-entry ?* "w" diary-syntax-table) |
|
|
(modify-syntax-entry ?: "w" diary-syntax-table) |
|
|
|
|
190 |
(defvar diary-entries-list) |
(defvar diary-entries-list) |
191 |
(defvar displayed-year) |
(defvar displayed-year) |
192 |
(defvar displayed-month) |
(defvar displayed-month) |
240 |
regexp (concat diary-glob-file-regexp-prefix regexp)) |
regexp (concat diary-glob-file-regexp-prefix regexp)) |
241 |
(setq attrvalue nil) |
(setq attrvalue nil) |
242 |
(if (re-search-forward regexp (point-max) t) |
(if (re-search-forward regexp (point-max) t) |
243 |
(setq attrvalue (buffer-substring-no-properties |
(setq attrvalue (match-string-no-properties regnum))) |
|
(match-beginning regnum) |
|
|
(match-end regnum)))) |
|
244 |
(if (and attrvalue |
(if (and attrvalue |
245 |
(setq attrvalue (diary-attrtype-convert attrvalue type))) |
(setq attrvalue (diary-attrtype-convert attrvalue type))) |
246 |
(setq ret-attr (append ret-attr (list attrname attrvalue)))) |
(setq ret-attr (append ret-attr (list attrname attrvalue)))) |
259 |
(setq attrvalue nil) |
(setq attrvalue nil) |
260 |
(if (string-match regexp entry) |
(if (string-match regexp entry) |
261 |
(progn |
(progn |
262 |
(setq attrvalue (substring-no-properties entry |
(setq attrvalue (match-string-no-properties regnum entry)) |
|
(match-beginning regnum) |
|
|
(match-end regnum))) |
|
263 |
(setq entry (replace-match "" t t entry)))) |
(setq entry (replace-match "" t t entry)))) |
264 |
(if (and attrvalue |
(if (and attrvalue |
265 |
(setq attrvalue (diary-attrtype-convert attrvalue type))) |
(setq attrvalue (diary-attrtype-convert attrvalue type))) |
292 |
|
|
293 |
(defvar diary-saved-point) ; internal |
(defvar diary-saved-point) ; internal |
294 |
|
|
295 |
(defun list-diary-entries (date number) |
|
296 |
"Create and display a buffer containing the relevant lines in diary-file. |
(defcustom number-of-diary-entries 1 |
297 |
|
"Specifies how many days of diary entries are to be displayed initially. |
298 |
|
This variable affects the diary display when the command \\[diary] is used, |
299 |
|
or if the value of the variable `view-diary-entries-initially' is t. For |
300 |
|
example, if the default value 1 is used, then only the current day's diary |
301 |
|
entries will be displayed. If the value 2 is used, then both the current |
302 |
|
day's and the next day's entries will be displayed. |
303 |
|
|
304 |
|
The value can also be a vector such as [0 2 2 2 2 4 1]; this value |
305 |
|
says to display no diary entries on Sunday, the display the entries |
306 |
|
for the current date and the day after on Monday through Thursday, |
307 |
|
display Friday through Monday's entries on Friday, and display only |
308 |
|
Saturday's entries on Saturday. |
309 |
|
|
310 |
|
This variable does not affect the diary display with the `d' command |
311 |
|
from the calendar; in that case, the prefix argument controls the |
312 |
|
number of days of diary entries displayed." |
313 |
|
:type '(choice (integer :tag "Entries") |
314 |
|
(vector :value [0 0 0 0 0 0 0] |
315 |
|
(integer :tag "Sunday") |
316 |
|
(integer :tag "Monday") |
317 |
|
(integer :tag "Tuesday") |
318 |
|
(integer :tag "Wednesday") |
319 |
|
(integer :tag "Thursday") |
320 |
|
(integer :tag "Friday") |
321 |
|
(integer :tag "Saturday"))) |
322 |
|
:group 'diary) |
323 |
|
|
324 |
|
(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) |
325 |
|
(defun diary-list-entries (date number) |
326 |
|
"Create and display a buffer containing the relevant lines in `diary-file'. |
327 |
The arguments are DATE and NUMBER; the entries selected are those |
The arguments are DATE and NUMBER; the entries selected are those |
328 |
for NUMBER days starting with date DATE. The other entries are hidden |
for NUMBER days starting with date DATE. The other entries are hidden |
329 |
using selective display. If NUMBER is less than 1, this function does nothing. |
using selective display. If NUMBER is less than 1, this function does nothing. |
355 |
|
|
356 |
`diary-hook' is run last. This can be used for an appointment |
`diary-hook' is run last. This can be used for an appointment |
357 |
notification function." |
notification function." |
358 |
|
(unless number |
359 |
|
(setq number (if (vectorp number-of-diary-entries) |
360 |
|
(aref number-of-diary-entries (calendar-day-of-week date)) |
361 |
|
number-of-diary-entries))) |
362 |
(when (> number 0) |
(when (> number 0) |
363 |
(let ((original-date date);; save for possible use in the hooks |
(let ((original-date date);; save for possible use in the hooks |
|
old-diary-syntax-table |
|
364 |
diary-entries-list |
diary-entries-list |
365 |
file-glob-attrs |
file-glob-attrs |
366 |
(date-string (calendar-date-string date)) |
(date-string (calendar-date-string date)) |
381 |
(setq selective-display-ellipses nil) |
(setq selective-display-ellipses nil) |
382 |
(if diary-header-line-flag |
(if diary-header-line-flag |
383 |
(setq header-line-format diary-header-line-format)) |
(setq header-line-format diary-header-line-format)) |
384 |
(setq old-diary-syntax-table (syntax-table)) |
(with-syntax-table diary-syntax-table |
385 |
(set-syntax-table diary-syntax-table) |
(let ((buffer-read-only nil) |
386 |
(unwind-protect |
(diary-modified (buffer-modified-p)) |
387 |
(let ((buffer-read-only nil) |
(mark (regexp-quote diary-nonmarking-symbol))) |
388 |
(diary-modified (buffer-modified-p)) |
;; First and last characters must be ^M or \n for |
389 |
(mark (regexp-quote diary-nonmarking-symbol))) |
;; selective display to work properly |
390 |
;; First and last characters must be ^M or \n for |
(goto-char (1- (point-max))) |
391 |
;; selective display to work properly |
(if (not (looking-at "\^M\\|\n")) |
392 |
(goto-char (1- (point-max))) |
(progn |
393 |
(if (not (looking-at "\^M\\|\n")) |
(goto-char (point-max)) |
394 |
(progn |
(insert "\^M"))) |
395 |
(goto-char (point-max)) |
(goto-char (point-min)) |
396 |
(insert "\^M"))) |
(if (not (looking-at "\^M\\|\n")) |
397 |
(goto-char (point-min)) |
(insert "\^M")) |
398 |
(if (not (looking-at "\^M\\|\n")) |
(subst-char-in-region (point-min) (point-max) ?\n ?\^M t) |
399 |
(insert "\^M")) |
(calendar-for-loop |
400 |
(subst-char-in-region (point-min) (point-max) ?\n ?\^M t) |
i from 1 to number do |
401 |
(calendar-for-loop |
(let ((month (extract-calendar-month date)) |
402 |
i from 1 to number do |
(day (extract-calendar-day date)) |
403 |
(let ((d diary-date-forms) |
(year (extract-calendar-year date)) |
404 |
(month (extract-calendar-month date)) |
(entry-found (list-sexp-diary-entries date))) |
405 |
(day (extract-calendar-day date)) |
(dolist (date-form diary-date-forms) |
406 |
(year (extract-calendar-year date)) |
(let* |
407 |
(entry-found (list-sexp-diary-entries date))) |
((backup (when (eq (car date-form) 'backup) |
408 |
(while d |
(setq date-form (cdr date-form)) |
409 |
(let* |
t)) |
410 |
((date-form (if (equal (car (car d)) 'backup) |
(dayname |
411 |
(cdr (car d)) |
(format "%s\\|%s\\.?" |
412 |
(car d))) |
(calendar-day-name date) |
413 |
(backup (equal (car (car d)) 'backup)) |
(calendar-day-name date 'abbrev))) |
414 |
(dayname |
(monthname |
415 |
(format "%s\\|%s\\.?" |
(format "\\*\\|%s\\|%s\\.?" |
416 |
(calendar-day-name date) |
(calendar-month-name month) |
417 |
(calendar-day-name date 'abbrev))) |
(calendar-month-name month 'abbrev))) |
418 |
(monthname |
(month (concat "\\*\\|0*" (int-to-string month))) |
419 |
(format "\\*\\|%s\\|%s\\.?" |
(day (concat "\\*\\|0*" (int-to-string day))) |
420 |
(calendar-month-name month) |
(year |
421 |
(calendar-month-name month 'abbrev))) |
(concat |
422 |
(month (concat "\\*\\|0*" (int-to-string month))) |
"\\*\\|0*" (int-to-string year) |
423 |
(day (concat "\\*\\|0*" (int-to-string day))) |
(if abbreviated-calendar-year |
424 |
(year |
(concat "\\|" (format "%02d" (% year 100))) |
425 |
(concat |
""))) |
426 |
"\\*\\|0*" (int-to-string year) |
(regexp |
427 |
(if abbreviated-calendar-year |
(concat |
428 |
(concat "\\|" (format "%02d" (% year 100))) |
"\\(\\`\\|\^M\\|\n\\)" mark "?\\(" |
429 |
""))) |
(mapconcat 'eval date-form "\\)\\(") |
430 |
(regexp |
"\\)")) |
431 |
(concat |
(case-fold-search t)) |
432 |
"\\(\\`\\|\^M\\|\n\\)" mark "?\\(" |
(goto-char (point-min)) |
433 |
(mapconcat 'eval date-form "\\)\\(") |
(while (re-search-forward regexp nil t) |
434 |
"\\)")) |
(if backup (re-search-backward "\\<" nil t)) |
435 |
(case-fold-search t)) |
(if (and (or (char-equal (preceding-char) ?\^M) |
436 |
(goto-char (point-min)) |
(char-equal (preceding-char) ?\n)) |
437 |
(while (re-search-forward regexp nil t) |
(not (looking-at " \\|\^I"))) |
438 |
(if backup (re-search-backward "\\<" nil t)) |
;; Diary entry that consists only of date. |
439 |
(if (and (or (char-equal (preceding-char) ?\^M) |
(backward-char 1) |
440 |
(char-equal (preceding-char) ?\n)) |
;; Found a nonempty diary entry--make it |
441 |
(not (looking-at " \\|\^I"))) |
;; visible and add it to the list. |
442 |
;; Diary entry that consists only of date. |
(setq entry-found t) |
443 |
(backward-char 1) |
(let ((entry-start (point)) |
444 |
;; Found a nonempty diary entry--make it |
date-start temp) |
445 |
;; visible and add it to the list. |
(re-search-backward "\^M\\|\n\\|\\`") |
446 |
(setq entry-found t) |
(setq date-start (point)) |
447 |
(let ((entry-start (point)) |
(re-search-forward "\^M\\|\n" nil t 2) |
448 |
date-start temp) |
(while (looking-at " \\|\^I") |
449 |
(re-search-backward "\^M\\|\n\\|\\`") |
(re-search-forward "\^M\\|\n" nil t)) |
450 |
(setq date-start (point)) |
(backward-char 1) |
451 |
(re-search-forward "\^M\\|\n" nil t 2) |
(subst-char-in-region date-start |
452 |
(while (looking-at " \\|\^I") |
(point) ?\^M ?\n t) |
453 |
(re-search-forward "\^M\\|\n" nil t)) |
(setq entry (buffer-substring entry-start (point)) |
454 |
(backward-char 1) |
temp (diary-pull-attrs entry file-glob-attrs) |
455 |
(subst-char-in-region date-start |
entry (nth 0 temp)) |
456 |
(point) ?\^M ?\n t) |
(add-to-diary-list |
457 |
(setq entry (buffer-substring entry-start (point)) |
date |
458 |
temp (diary-pull-attrs entry file-glob-attrs) |
entry |
459 |
entry (nth 0 temp)) |
(buffer-substring |
460 |
(add-to-diary-list |
(1+ date-start) (1- entry-start)) |
461 |
date |
(copy-marker entry-start) (nth 1 temp))))))) |
462 |
entry |
(or entry-found |
463 |
(buffer-substring |
(not diary-list-include-blanks) |
464 |
(1+ date-start) (1- entry-start)) |
(setq diary-entries-list |
465 |
(copy-marker entry-start) (nth 1 temp)))))) |
(append diary-entries-list |
466 |
(setq d (cdr d))) |
(list (list date "" "" "" ""))))) |
467 |
(or entry-found |
(setq date |
468 |
(not diary-list-include-blanks) |
(calendar-gregorian-from-absolute |
469 |
(setq diary-entries-list |
(1+ (calendar-absolute-from-gregorian date)))) |
470 |
(append diary-entries-list |
(setq entry-found nil))) |
471 |
(list (list date "" "" "" ""))))) |
(set-buffer-modified-p diary-modified))) |
|
(setq date |
|
|
(calendar-gregorian-from-absolute |
|
|
(1+ (calendar-absolute-from-gregorian date)))) |
|
|
(setq entry-found nil))) |
|
|
(set-buffer-modified-p diary-modified)) |
|
|
(set-syntax-table old-diary-syntax-table)) |
|
472 |
(goto-char (point-min)) |
(goto-char (point-min)) |
473 |
(run-hooks 'nongregorian-diary-listing-hook |
(run-hooks 'nongregorian-diary-listing-hook |
474 |
'list-diary-entries-hook) |
'list-diary-entries-hook) |
478 |
(run-hooks 'diary-hook) |
(run-hooks 'diary-hook) |
479 |
diary-entries-list)))))) |
diary-entries-list)))))) |
480 |
|
|
481 |
|
(defun diary-unhide-everything () |
482 |
|
(setq selective-display nil) |
483 |
|
(let ((inhibit-read-only t) |
484 |
|
(modified (buffer-modified-p))) |
485 |
|
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t) |
486 |
|
(set-buffer-modified-p modified)) |
487 |
|
(kill-local-variable 'mode-line-format)) |
488 |
|
|
489 |
(defun include-other-diary-files () |
(defun include-other-diary-files () |
490 |
"Include the diary entries from other diary files with those of diary-file. |
"Include the diary entries from other diary files with those of diary-file. |
491 |
This function is suitable for use in `list-diary-entries-hook'; |
This function is suitable for use in `list-diary-entries-hook'; |
498 |
(goto-char (point-min)) |
(goto-char (point-min)) |
499 |
(while (re-search-forward |
(while (re-search-forward |
500 |
(concat |
(concat |
501 |
"\\(\\`\\|\^M\\|\n\\)" |
"\\(?:\\`\\|\^M\\|\n\\)" |
502 |
(regexp-quote diary-include-string) |
(regexp-quote diary-include-string) |
503 |
" \"\\([^\"]*\\)\"") |
" \"\\([^\"]*\\)\"") |
504 |
nil t) |
nil t) |
505 |
(let* ((diary-file (substitute-in-file-name |
(let* ((diary-file (substitute-in-file-name |
506 |
(buffer-substring-no-properties |
(match-string-no-properties 1))) |
|
(match-beginning 2) (match-end 2)))) |
|
507 |
(diary-list-include-blanks nil) |
(diary-list-include-blanks nil) |
508 |
(list-diary-entries-hook 'include-other-diary-files) |
(list-diary-entries-hook 'include-other-diary-files) |
509 |
(diary-display-hook 'ignore) |
(diary-display-hook 'ignore) |
510 |
(diary-hook nil) |
(diary-hook nil)) |
|
(d-buffer (find-buffer-visiting diary-file)) |
|
|
(diary-modified (if d-buffer |
|
|
(save-excursion |
|
|
(set-buffer d-buffer) |
|
|
(buffer-modified-p))))) |
|
511 |
(if (file-exists-p diary-file) |
(if (file-exists-p diary-file) |
512 |
(if (file-readable-p diary-file) |
(if (file-readable-p diary-file) |
513 |
(unwind-protect |
(unwind-protect |
514 |
(setq diary-entries-list |
(setq diary-entries-list |
515 |
(append diary-entries-list |
(append diary-entries-list |
516 |
(list-diary-entries original-date number))) |
(list-diary-entries original-date number))) |
517 |
(save-excursion |
(with-current-buffer (find-buffer-visiting diary-file) |
518 |
(set-buffer (find-buffer-visiting diary-file)) |
(diary-unhide-everything))) |
|
(let ((inhibit-read-only t)) |
|
|
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)) |
|
|
(setq selective-display nil) |
|
|
(set-buffer-modified-p diary-modified))) |
|
519 |
(beep) |
(beep) |
520 |
(message "Can't read included diary file %s" diary-file) |
(message "Can't read included diary file %s" diary-file) |
521 |
(sleep-for 2)) |
(sleep-for 2)) |
581 |
(defun fancy-diary-display () |
(defun fancy-diary-display () |
582 |
"Prepare a diary buffer with relevant entries in a fancy, noneditable form. |
"Prepare a diary buffer with relevant entries in a fancy, noneditable form. |
583 |
This function is provided for optional use as the `diary-display-hook'." |
This function is provided for optional use as the `diary-display-hook'." |
584 |
(save-excursion;; Turn off selective-display in the diary file's buffer. |
(with-current-buffer ;; Turn off selective-display in the diary file's buffer. |
585 |
(set-buffer (find-buffer-visiting (substitute-in-file-name diary-file))) |
(find-buffer-visiting (substitute-in-file-name diary-file)) |
586 |
(let ((diary-modified (buffer-modified-p))) |
(diary-unhide-everything)) |
|
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t) |
|
|
(setq selective-display nil) |
|
|
(kill-local-variable 'mode-line-format) |
|
|
(set-buffer-modified-p diary-modified))) |
|
587 |
(if (or (not diary-entries-list) |
(if (or (not diary-entries-list) |
588 |
(and (not (cdr diary-entries-list)) |
(and (not (cdr diary-entries-list)) |
589 |
(string-equal (car (cdr (car diary-entries-list))) ""))) |
(string-equal (car (cdr (car diary-entries-list))) ""))) |
753 |
(kill-buffer temp-buffer))) |
(kill-buffer temp-buffer))) |
754 |
(error "You don't have a diary buffer!"))))) |
(error "You don't have a diary buffer!"))))) |
755 |
|
|
756 |
(defun show-all-diary-entries () |
(define-obsolete-function-alias 'show-all-diary-entries 'diary-show-all-entries) |
757 |
|
(defun diary-show-all-entries () |
758 |
"Show all of the diary entries in the diary file. |
"Show all of the diary entries in the diary file. |
759 |
This function gets rid of the selective display of the diary file so that |
This function gets rid of the selective display of the diary file so that |
760 |
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 |
762 |
(interactive) |
(interactive) |
763 |
(let ((d-file (diary-check-diary-file)) |
(let ((d-file (diary-check-diary-file)) |
764 |
(pop-up-frames (window-dedicated-p (selected-window)))) |
(pop-up-frames (window-dedicated-p (selected-window)))) |
765 |
(save-excursion |
(with-current-buffer (or (find-buffer-visiting d-file) |
766 |
(set-buffer (or (find-buffer-visiting d-file) |
(find-file-noselect d-file t)) |
767 |
(find-file-noselect d-file t))) |
(diary-unhide-everything)))) |
|
(let ((buffer-read-only nil) |
|
|
(diary-modified (buffer-modified-p))) |
|
|
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t) |
|
|
(setq selective-display nil |
|
|
mode-line-format default-mode-line-format) |
|
|
(display-buffer (current-buffer)) |
|
|
(set-buffer-modified-p diary-modified))))) |
|
768 |
|
|
769 |
(defcustom diary-mail-addr |
(defcustom diary-mail-addr |
770 |
(if (boundp 'user-mail-address) user-mail-address "") |
(if (boundp 'user-mail-address) user-mail-address "") |
814 |
(calendar-date-string (calendar-current-date)))) |
(calendar-date-string (calendar-current-date)))) |
815 |
(insert |
(insert |
816 |
(if (get-buffer fancy-diary-buffer) |
(if (get-buffer fancy-diary-buffer) |
817 |
(save-excursion |
(with-current-buffer fancy-diary-buffer (buffer-string)) |
|
(set-buffer fancy-diary-buffer) |
|
|
(buffer-substring (point-min) (point-max))) |
|
818 |
"No entries found")) |
"No entries found")) |
819 |
(call-interactively (get mail-user-agent 'sendfunc)))) |
(call-interactively (get mail-user-agent 'sendfunc)))) |
820 |
|
|
849 |
`nongregorian-diary-marking-hook' and `mark-diary-entries-hook' |
`nongregorian-diary-marking-hook' and `mark-diary-entries-hook' |
850 |
are run. If the optional argument REDRAW is non-nil (which is |
are run. If the optional argument REDRAW is non-nil (which is |
851 |
the case interactively, for example) then any existing diary |
the case interactively, for example) then any existing diary |
852 |
marks are first removed. This is intended to deal with deleted |
marks are first removed. This is intended to deal with deleted |
853 |
diary entries." |
diary entries." |
854 |
(interactive "p") |
(interactive "p") |
855 |
;; To remove any deleted diary entries. Do not redraw when: |
;; To remove any deleted diary entries. Do not redraw when: |
863 |
(redraw-calendar)) |
(redraw-calendar)) |
864 |
(let ((marking-diary-entries t) |
(let ((marking-diary-entries t) |
865 |
file-glob-attrs marks) |
file-glob-attrs marks) |
866 |
(save-excursion |
(with-current-buffer (find-file-noselect (diary-check-diary-file) t) |
|
(set-buffer (find-file-noselect (diary-check-diary-file) t)) |
|
867 |
(setq mark-diary-entries-in-calendar t) |
(setq mark-diary-entries-in-calendar t) |
868 |
(message "Marking diary entries...") |
(message "Marking diary entries...") |
869 |
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
906 |
(while (re-search-forward regexp nil t) |
(while (re-search-forward regexp nil t) |
907 |
(let* ((dd-name |
(let* ((dd-name |
908 |
(if d-name-pos |
(if d-name-pos |
909 |
(buffer-substring-no-properties |
(match-string-no-properties d-name-pos))) |
|
(match-beginning d-name-pos) |
|
|
(match-end d-name-pos)))) |
|
910 |
(mm-name |
(mm-name |
911 |
(if m-name-pos |
(if m-name-pos |
912 |
(buffer-substring-no-properties |
(match-string-no-properties m-name-pos))) |
|
(match-beginning m-name-pos) |
|
|
(match-end m-name-pos)))) |
|
913 |
(mm (string-to-number |
(mm (string-to-number |
914 |
(if m-pos |
(if m-pos |
915 |
(buffer-substring-no-properties |
(match-string-no-properties m-pos) |
|
(match-beginning m-pos) |
|
|
(match-end m-pos)) |
|
916 |
""))) |
""))) |
917 |
(dd (string-to-number |
(dd (string-to-number |
918 |
(if d-pos |
(if d-pos |
919 |
(buffer-substring-no-properties |
(match-string-no-properties d-pos) |
|
(match-beginning d-pos) |
|
|
(match-end d-pos)) |
|
920 |
""))) |
""))) |
921 |
(y-str (if y-pos |
(y-str (if y-pos |
922 |
(buffer-substring-no-properties |
(match-string-no-properties y-pos))) |
|
(match-beginning y-pos) |
|
|
(match-end y-pos)))) |
|
923 |
(yy (if (not y-str) |
(yy (if (not y-str) |
924 |
0 |
0 |
925 |
(if (and (= (length y-str) 2) |
(if (and (= (length y-str) 2) |
935 |
(if (> (- current-y y) 50) |
(if (> (- current-y y) 50) |
936 |
(+ y 100) |
(+ y 100) |
937 |
y))) |
y))) |
938 |
(string-to-number y-str)))) |
(string-to-number y-str))))) |
939 |
(save-excursion |
(save-excursion |
940 |
(setq entry (buffer-substring-no-properties |
(setq entry (buffer-substring-no-properties |
941 |
(point) (line-end-position)) |
(point) (line-end-position)) |
942 |
temp (diary-pull-attrs entry file-glob-attrs) |
temp (diary-pull-attrs entry file-glob-attrs) |
943 |
entry (nth 0 temp) |
entry (nth 0 temp) |
944 |
marks (nth 1 temp)))) |
marks (nth 1 temp))) |
945 |
(if dd-name |
(if dd-name |
946 |
(mark-calendar-days-named |
(mark-calendar-days-named |
947 |
(cdr (assoc-string |
(cdr (assoc-string |
976 |
sexp-mark "(diary-remind\\)")) |
sexp-mark "(diary-remind\\)")) |
977 |
(file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
(file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
978 |
m y first-date last-date mark file-glob-attrs) |
m y first-date last-date mark file-glob-attrs) |
979 |
(save-excursion |
(with-current-buffer calendar-buffer |
|
(set-buffer calendar-buffer) |
|
980 |
(setq m displayed-month) |
(setq m displayed-month) |
981 |
(setq y displayed-year)) |
(setq y displayed-year)) |
982 |
(increment-calendar-month m y -1) |
(increment-calendar-month m y -1) |
1041 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1042 |
(while (re-search-forward |
(while (re-search-forward |
1043 |
(concat |
(concat |
1044 |
"\\(\\`\\|\^M\\|\n\\)" |
"\\(?:\\`\\|\^M\\|\n\\)" |
1045 |
(regexp-quote diary-include-string) |
(regexp-quote diary-include-string) |
1046 |
" \"\\([^\"]*\\)\"") |
" \"\\([^\"]*\\)\"") |
1047 |
nil t) |
nil t) |
1048 |
(let* ((diary-file (substitute-in-file-name |
(let* ((diary-file (substitute-in-file-name |
1049 |
(match-string-no-properties 2))) |
(match-string-no-properties 1))) |
1050 |
(mark-diary-entries-hook 'mark-included-diary-files) |
(mark-diary-entries-hook 'mark-included-diary-files) |
1051 |
(dbuff (find-buffer-visiting diary-file))) |
(dbuff (find-buffer-visiting diary-file))) |
1052 |
(if (file-exists-p diary-file) |
(if (file-exists-p diary-file) |
1066 |
(defun mark-calendar-days-named (dayname &optional color) |
(defun mark-calendar-days-named (dayname &optional color) |
1067 |
"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. |
1068 |
0 means all Sundays, 1 means all Mondays, and so on." |
0 means all Sundays, 1 means all Mondays, and so on." |
1069 |
(save-excursion |
(with-current-buffer calendar-buffer |
|
(set-buffer calendar-buffer) |
|
1070 |
(let ((prev-month displayed-month) |
(let ((prev-month displayed-month) |
1071 |
(prev-year displayed-year) |
(prev-year displayed-year) |
1072 |
(succ-month displayed-month) |
(succ-month displayed-month) |
1086 |
(defun mark-calendar-date-pattern (month day year &optional color) |
(defun mark-calendar-date-pattern (month day year &optional color) |
1087 |
"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. |
1088 |
A value of 0 in any position is a wildcard." |
A value of 0 in any position is a wildcard." |
1089 |
(save-excursion |
(with-current-buffer calendar-buffer |
|
(set-buffer calendar-buffer) |
|
1090 |
(let ((m displayed-month) |
(let ((m displayed-month) |
1091 |
(y displayed-year)) |
(y displayed-year)) |
1092 |
(increment-calendar-month m y -1) |
(increment-calendar-month m y -1) |
1143 |
(cond ((string-match ; Military time |
(cond ((string-match ; Military time |
1144 |
"\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" |
"\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" |
1145 |
s) |
s) |
1146 |
(+ (* 100 (string-to-number |
(+ (* 100 (string-to-number (match-string 1 s))) |
1147 |
(substring s (match-beginning 1) (match-end 1)))) |
(string-to-number (match-string 2 s)))) |
|
(string-to-number (substring s (match-beginning 2) (match-end 2))))) |
|
1148 |
((string-match ; Hour only XXam or XXpm |
((string-match ; Hour only XXam or XXpm |
1149 |
"\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) |
"\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) |
1150 |
(+ (* 100 (% (string-to-number |
(+ (* 100 (% (string-to-number (match-string 1 s)) 12)) |
|
(substring s (match-beginning 1) (match-end 1))) |
|
|
12)) |
|
1151 |
(if (equal ?a (downcase (aref s (match-beginning 2)))) |
(if (equal ?a (downcase (aref s (match-beginning 2)))) |
1152 |
0 1200))) |
0 1200))) |
1153 |
((string-match ; Hour and minute XX:XXam or XX:XXpm |
((string-match ; Hour and minute XX:XXam or XX:XXpm |
1154 |
"\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) |
"\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) |
1155 |
(+ (* 100 (% (string-to-number |
(+ (* 100 (% (string-to-number (match-string 1 s)) 12)) |
1156 |
(substring s (match-beginning 1) (match-end 1))) |
(string-to-number (match-string 2 s)) |
|
12)) |
|
|
(string-to-number (substring s (match-beginning 2) (match-end 2))) |
|
1157 |
(if (equal ?a (downcase (aref s (match-beginning 3)))) |
(if (equal ?a (downcase (aref s (match-beginning 3)))) |
1158 |
0 1200))) |
0 1200))) |
1159 |
(t diary-unknown-time)))) ; Unrecognizable |
(t diary-unknown-time)))) ; Unrecognizable |
1390 |
(error |
(error |
1391 |
(beep) |
(beep) |
1392 |
(message "Bad sexp at line %d in %s: %s" |
(message "Bad sexp at line %d in %s: %s" |
1393 |
(save-excursion |
(count-lines (point-min) (point)) |
|
(save-restriction |
|
|
(narrow-to-region 1 (point)) |
|
|
(goto-char (point-min)) |
|
|
(let ((lines 1)) |
|
|
(while (re-search-forward "\n\\|\^M" nil t) |
|
|
(setq lines (1+ lines))) |
|
|
lines))) |
|
1394 |
diary-file sexp) |
diary-file sexp) |
1395 |
(sleep-for 2)))))) |
(sleep-for 2)))))) |
1396 |
(cond ((stringp result) result) |
(cond ((stringp result) result) |
1667 |
redrawn with the new entry marked, if necessary." |
redrawn with the new entry marked, if necessary." |
1668 |
(let ((pop-up-frames (window-dedicated-p (selected-window)))) |
(let ((pop-up-frames (window-dedicated-p (selected-window)))) |
1669 |
(find-file-other-window (substitute-in-file-name (or file diary-file)))) |
(find-file-other-window (substitute-in-file-name (or file diary-file)))) |
1670 |
(add-hook 'write-contents-functions 'diary-redraw-calendar nil t) |
(add-hook 'after-save-hook 'diary-redraw-calendar nil t) |
|
(when selective-display |
|
|
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t) |
|
|
(setq selective-display nil) |
|
|
(kill-local-variable 'mode-line-format)) |
|
1671 |
(widen) |
(widen) |
1672 |
|
(diary-unhide-everything) |
1673 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1674 |
(when (let ((case-fold-search t)) |
(when (let ((case-fold-search t)) |
1675 |
(search-backward "Local Variables:" |
(search-backward "Local Variables:" |
1677 |
t)) |
t)) |
1678 |
(beginning-of-line) |
(beginning-of-line) |
1679 |
(insert "\n") |
(insert "\n") |
1680 |
(previous-line 1)) |
(forward-line -1)) |
1681 |
(insert |
(insert |
1682 |
(if (bolp) "" "\n") |
(if (bolp) "" "\n") |
1683 |
(if nonmarking diary-nonmarking-symbol "") |
(if nonmarking diary-nonmarking-symbol "") |
1774 |
(calendar-date-string (calendar-cursor-to-date t) nil t)) |
(calendar-date-string (calendar-cursor-to-date t) nil t)) |
1775 |
arg))) |
arg))) |
1776 |
|
|
1777 |
|
(defvar diary-mode-map |
1778 |
|
(let ((map (make-sparse-keymap))) |
1779 |
|
(define-key map "\C-c\C-s" 'diary-show-all-entries) |
1780 |
|
(define-key map "\C-c\C-q" 'quit-window) |
1781 |
|
map) |
1782 |
|
"Keymap for `diary-mode'.") |
1783 |
|
|
1784 |
;;;###autoload |
;;;###autoload |
1785 |
(define-derived-mode diary-mode fundamental-mode |
(define-derived-mode diary-mode fundamental-mode "Diary" |
|
"Diary" |
|
1786 |
"Major mode for editing the diary file." |
"Major mode for editing the diary file." |
1787 |
(set (make-local-variable 'font-lock-defaults) |
(set (make-local-variable 'font-lock-defaults) |
1788 |
'(diary-font-lock-keywords t))) |
'(diary-font-lock-keywords t)) |
1789 |
|
(add-to-invisibility-spec '(diary . nil)) |
1790 |
|
(add-hook 'after-save-hook 'diary-redraw-calendar nil t) |
1791 |
|
(if diary-header-line-flag |
1792 |
|
(setq header-line-format diary-header-line-format))) |
1793 |
|
|
1794 |
(define-derived-mode fancy-diary-display-mode fundamental-mode |
(define-derived-mode fancy-diary-display-mode fundamental-mode |
1795 |
"Diary" |
"Diary" |
1796 |
"Major mode used while displaying diary entries using Fancy Display." |
"Major mode used while displaying diary entries using Fancy Display." |
1797 |
(set (make-local-variable 'font-lock-defaults) |
(set (make-local-variable 'font-lock-defaults) |
1798 |
'(fancy-diary-font-lock-keywords t)) |
'(fancy-diary-font-lock-keywords t)) |
1799 |
(define-key (current-local-map) "q" 'quit-window)) |
(local-set-key "q" 'quit-window)) |
1800 |
|
|
1801 |
|
|
1802 |
(defvar fancy-diary-font-lock-keywords |
(defvar fancy-diary-font-lock-keywords |
1822 |
"Keywords to highlight in fancy diary display") |
"Keywords to highlight in fancy diary display") |
1823 |
|
|
1824 |
|
|
1825 |
(defun font-lock-diary-sexps (limit) |
(defun diary-font-lock-sexps (limit) |
1826 |
"Recognize sexp diary entry for font-locking." |
"Recognize sexp diary entry for font-locking." |
1827 |
(if (re-search-forward |
(if (re-search-forward |
1828 |
(concat "^" (regexp-quote diary-nonmarking-symbol) |
(concat "^" (regexp-quote diary-nonmarking-symbol) |
1837 |
t)) |
t)) |
1838 |
(error t)))) |
(error t)))) |
1839 |
|
|
1840 |
(defun font-lock-diary-date-forms (month-array &optional symbol abbrev-array) |
(defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array) |
1841 |
"Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. |
"Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. |
1842 |
If given, optional SYMBOL must be a prefix to entries. |
If given, optional SYMBOL must be a prefix to entries. |
1843 |
If optional ABBREV-ARRAY is present, the abbreviations constructed |
If optional ABBREV-ARRAY is present, the abbreviations constructed |
1851 |
(month "\\([0-9]+\\|\\*\\)") |
(month "\\([0-9]+\\|\\*\\)") |
1852 |
(day "\\([0-9]+\\|\\*\\)") |
(day "\\([0-9]+\\|\\*\\)") |
1853 |
(year "-?\\([0-9]+\\|\\*\\)")) |
(year "-?\\([0-9]+\\|\\*\\)")) |
1854 |
(mapcar '(lambda (x) |
(mapcar (lambda (x) |
1855 |
(cons |
(cons |
1856 |
(concat "^" (regexp-quote diary-nonmarking-symbol) "?" |
(concat "^" (regexp-quote diary-nonmarking-symbol) "?" |
1857 |
(if symbol (regexp-quote symbol) "") "\\(" |
(if symbol (regexp-quote symbol) "") "\\(" |
1859 |
;; If backup, omit first item (backup) |
;; If backup, omit first item (backup) |
1860 |
;; and last item (not part of date) |
;; and last item (not part of date) |
1861 |
(if (equal (car x) 'backup) |
(if (equal (car x) 'backup) |
1862 |
(reverse (cdr (reverse (cdr x)))) |
(nreverse (cdr (reverse (cdr x)))) |
1863 |
x) |
x) |
1864 |
"") |
"") |
1865 |
;; With backup, last item is not part of date |
;; With backup, last item is not part of date |
1874 |
|
|
1875 |
(defvar diary-font-lock-keywords |
(defvar diary-font-lock-keywords |
1876 |
(append |
(append |
1877 |
(font-lock-diary-date-forms calendar-month-name-array |
(diary-font-lock-date-forms calendar-month-name-array |
1878 |
nil calendar-month-abbrev-array) |
nil calendar-month-abbrev-array) |
1879 |
(when (or (memq 'mark-hebrew-diary-entries |
(when (or (memq 'mark-hebrew-diary-entries |
1880 |
nongregorian-diary-marking-hook) |
nongregorian-diary-marking-hook) |
1881 |
(memq 'list-hebrew-diary-entries |
(memq 'list-hebrew-diary-entries |
1882 |
nongregorian-diary-listing-hook)) |
nongregorian-diary-listing-hook)) |
1883 |
(require 'cal-hebrew) |
(require 'cal-hebrew) |
1884 |
(font-lock-diary-date-forms |
(diary-font-lock-date-forms |
1885 |
calendar-hebrew-month-name-array-leap-year |
calendar-hebrew-month-name-array-leap-year |
1886 |
hebrew-diary-entry-symbol)) |
hebrew-diary-entry-symbol)) |
1887 |
(when (or (memq 'mark-islamic-diary-entries |
(when (or (memq 'mark-islamic-diary-entries |
1889 |
(memq 'list-islamic-diary-entries |
(memq 'list-islamic-diary-entries |
1890 |
nongregorian-diary-listing-hook)) |
nongregorian-diary-listing-hook)) |
1891 |
(require 'cal-islam) |
(require 'cal-islam) |
1892 |
(font-lock-diary-date-forms |
(diary-font-lock-date-forms |
1893 |
calendar-islamic-month-name-array |
calendar-islamic-month-name-array |
1894 |
islamic-diary-entry-symbol)) |
islamic-diary-entry-symbol)) |
1895 |
(list |
(list |
1911 |
(concat "^" (regexp-quote diary-nonmarking-symbol) |
(concat "^" (regexp-quote diary-nonmarking-symbol) |
1912 |
"?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") |
"?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") |
1913 |
'(1 font-lock-reference-face)) |
'(1 font-lock-reference-face)) |
1914 |
'(font-lock-diary-sexps . font-lock-keyword-face) |
'(diary-font-lock-sexps . font-lock-keyword-face) |
1915 |
'("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?" |
'("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?" |
1916 |
. font-lock-function-name-face))) |
. font-lock-function-name-face))) |
1917 |
"Forms to highlight in diary-mode") |
"Forms to highlight in `diary-mode'.") |
1918 |
|
|
1919 |
|
|
1920 |
;; Following code from Dave Love <fx@gnu.org>. |
;; Following code from Dave Love <fx@gnu.org>. |
2073 |
|
|
2074 |
(provide 'diary-lib) |
(provide 'diary-lib) |
2075 |
|
|
2076 |
;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010 |
;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010 |
2077 |
;;; diary-lib.el ends here |
;;; diary-lib.el ends here |