diff options
| author | Glenn Morris | 2008-03-10 02:44:51 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-10 02:44:51 +0000 |
| commit | 55e8cf9463d9821785fe227537e183f103d29727 (patch) | |
| tree | ed96db1a50f886bce21af1f76960861f37f760db | |
| parent | 37a68866aa6fd30bcd423b48cb8871b80027f0ba (diff) | |
| download | emacs-55e8cf9463d9821785fe227537e183f103d29727.tar.gz emacs-55e8cf9463d9821785fe227537e183f103d29727.zip | |
(diary-face-attrs): Fix custom :type.
(diary-face-attrs, diary-glob-file-regexp-prefix, diary-unknown-time)
(diary-pull-attrs, diary-header-line-flag, diary-list-entries)
(diary-unhide-everything, include-other-diary-files, diary-goto-entry)
(mark-included-diary-files, mark-calendar-days-named)
(mark-calendar-date-pattern, mark-calendar-month, diary-entry-compare)
(diary-remind, insert-diary-entry, insert-weekly-diary-entry)
(insert-monthly-diary-entry, insert-yearly-diary-entry)
(insert-anniversary-diary-entry, insert-block-diary-entry)
(insert-cyclic-diary-entry, fancy-diary-font-lock-keywords)
(diary-font-lock-sexps): Doc fixes.
(diary-remind-message, mark-calendar-month): Use zerop.
(diary-attrtype-convert, diary-pull-attrs): Simplify.
(diary-list-entries): Revert let to let* (previous change).
| -rw-r--r-- | lisp/calendar/diary-lib.el | 305 |
1 files changed, 161 insertions, 144 deletions
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index af65f4bf8bc..ec91e48078e 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el | |||
| @@ -46,11 +46,6 @@ are holidays." | |||
| 46 | :type 'boolean | 46 | :type 'boolean |
| 47 | :group 'diary) | 47 | :group 'diary) |
| 48 | 48 | ||
| 49 | (defcustom diary-glob-file-regexp-prefix "^\\#" | ||
| 50 | "Regular expression prepended to attribute-regexps for file-wide specifiers." | ||
| 51 | :type 'regexp | ||
| 52 | :group 'diary) | ||
| 53 | |||
| 54 | (defcustom diary-face 'diary | 49 | (defcustom diary-face 'diary |
| 55 | "Face name to use for diary entries." | 50 | "Face name to use for diary entries." |
| 56 | :type 'face | 51 | :type 'face |
| @@ -58,6 +53,13 @@ are holidays." | |||
| 58 | (make-obsolete-variable 'diary-face "customize the face `diary' instead." | 53 | (make-obsolete-variable 'diary-face "customize the face `diary' instead." |
| 59 | "23.1") | 54 | "23.1") |
| 60 | 55 | ||
| 56 | ;; Face markup of calendar and diary displays: Any entry line that | ||
| 57 | ;; ends with [foo:value] where foo is a face attribute (except :box | ||
| 58 | ;; :stipple) or with [face:blah] tags, will have these values applied | ||
| 59 | ;; to the calendar and fancy diary displays. These attributes "stack" | ||
| 60 | ;; on calendar displays. File-wide attributes can be defined as | ||
| 61 | ;; follows: the first line matching "^# [tag:value]" defines the value | ||
| 62 | ;; for that particular tag. | ||
| 61 | (defcustom diary-face-attrs | 63 | (defcustom diary-face-attrs |
| 62 | '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string) | 64 | '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string) |
| 63 | (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string) | 65 | (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string) |
| @@ -75,12 +77,29 @@ are holidays." | |||
| 75 | ;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box) | 77 | ;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box) |
| 76 | ;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple) | 78 | ;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple) |
| 77 | ) | 79 | ) |
| 78 | "A list of (regexp regnum attr attrtype) lists where the | 80 | "Alist of (REGEXP SUBEXP ATTRIBUTE TYPE) elements. |
| 79 | regexp says how to find the tag, the regnum says which | 81 | This is used by `diary-pull-attrs' to fontify certain diary |
| 80 | parenthetical sub-regexp this regexp looks for, and the attr says | 82 | elements. REGEXP is a regular expression to for, and SUBEXP is |
| 81 | which attribute of the face (or that this _is_ a face) is being | 83 | the numbered sub-expression to extract. `diary-glob-file-regexp-prefix' |
| 82 | modified." | 84 | is prepended to REGEXP for file-wide specifiers. ATTRIBUTE |
| 83 | :type 'sexp | 85 | specifies which face attribute (e.g. `:foreground') to modify, or |
| 86 | that this is a face (`:face') to apply. TYPE is the type of | ||
| 87 | attribute being applied. Available TYPES (see `diary-attrtype-convert') | ||
| 88 | are: `string', `symbol', `int', `tnil',`stringtnil.'" | ||
| 89 | :type '(repeat (list (string :tag "Regular expression") | ||
| 90 | (integer :tag "Sub-expression") | ||
| 91 | (symbol :tag "Attribute (e.g. :foreground)") | ||
| 92 | (choice (const string :tag "A string") | ||
| 93 | (const symbol :tag "A symbol") | ||
| 94 | (const int :tag "An integer") | ||
| 95 | (const tnil :tag "`t' or `nil'") | ||
| 96 | (const stringtnil | ||
| 97 | :tag "A string, `t', or `nil'")))) | ||
| 98 | :group 'diary) | ||
| 99 | |||
| 100 | (defcustom diary-glob-file-regexp-prefix "^\\#" | ||
| 101 | "Regular expression prepended to `diary-face-attrs' for file-wide specifiers." | ||
| 102 | :type 'regexp | ||
| 84 | :group 'diary) | 103 | :group 'diary) |
| 85 | 104 | ||
| 86 | (defcustom diary-file-name-prefix nil | 105 | (defcustom diary-file-name-prefix nil |
| @@ -182,7 +201,7 @@ instead of deleting it, or changing the function used to do the printing." | |||
| 182 | :group 'diary) | 201 | :group 'diary) |
| 183 | 202 | ||
| 184 | (defcustom diary-unknown-time -9999 | 203 | (defcustom diary-unknown-time -9999 |
| 185 | "Value returned by diary-entry-time when no time is found. | 204 | "Value returned by `diary-entry-time' when no time is found. |
| 186 | The default value -9999 causes entries with no recognizable time to be placed | 205 | The default value -9999 causes entries with no recognizable time to be placed |
| 187 | before those with times; 9999 would place entries with no recognizable time | 206 | before those with times; 9999 would place entries with no recognizable time |
| 188 | after those with times." | 207 | after those with times." |
| @@ -205,7 +224,7 @@ after those with times." | |||
| 205 | 224 | ||
| 206 | (defcustom diary-remind-message | 225 | (defcustom diary-remind-message |
| 207 | '("Reminder: Only " | 226 | '("Reminder: Only " |
| 208 | (if (= 0 (% days 7)) | 227 | (if (zerop (% days 7)) |
| 209 | (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks")) | 228 | (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks")) |
| 210 | (concat (int-to-string days) (if (= 1 days) " day" " days"))) | 229 | (concat (int-to-string days) (if (= 1 days) " day" " days"))) |
| 211 | " until " | 230 | " until " |
| @@ -410,84 +429,57 @@ No diary entry if there is no sunset on that date.") | |||
| 410 | It is the standard syntax table used in Fundamental mode, but with the | 429 | It is the standard syntax table used in Fundamental mode, but with the |
| 411 | syntax of `*' and `:' changed to be word constituents.") | 430 | syntax of `*' and `:' changed to be word constituents.") |
| 412 | 431 | ||
| 413 | (defvar diary-entries-list) | ||
| 414 | (defvar displayed-year) | ||
| 415 | (defvar displayed-month) | ||
| 416 | (defvar date) | ||
| 417 | (defvar number) | ||
| 418 | (defvar date-string) | ||
| 419 | (defvar original-date) | ||
| 420 | |||
| 421 | (defun diary-attrtype-convert (attrvalue type) | 432 | (defun diary-attrtype-convert (attrvalue type) |
| 422 | "Convert string ATTRVALUE to TYPE appropriate for a face description. | 433 | "Convert string ATTRVALUE to TYPE appropriate for a face description. |
| 423 | Valid TYPEs are: string, symbol, int, stringtnil, tnil." | 434 | Valid TYPEs are: string, symbol, int, stringtnil, tnil." |
| 424 | (let (ret) | 435 | (cond ((eq type 'string) attrvalue) |
| 425 | (setq ret (cond ((eq type 'string) attrvalue) | 436 | ((eq type 'symbol) (read attrvalue)) ; FIXME intern-soft? |
| 426 | ((eq type 'symbol) (read attrvalue)) | 437 | ((eq type 'int) (string-to-number attrvalue)) |
| 427 | ((eq type 'int) (string-to-number attrvalue)) | 438 | ((eq type 'stringtnil) |
| 428 | ((eq type 'stringtnil) | 439 | (cond ((string-equal "t" attrvalue) t) |
| 429 | (cond ((string= "t" attrvalue) t) | 440 | ((string-equal "nil" attrvalue) nil) |
| 430 | ((string= "nil" attrvalue) nil) | 441 | (t attrvalue))) |
| 431 | (t attrvalue))) | 442 | ((eq type 'tnil) (string-equal "t" attrvalue)))) |
| 432 | ((eq type 'tnil) | ||
| 433 | (cond ((string= "t" attrvalue) t) | ||
| 434 | ((string= "nil" attrvalue) nil))))) | ||
| 435 | ; (message "(%s)[%s]=[%s]" (print type) attrvalue ret) | ||
| 436 | ret)) | ||
| 437 | |||
| 438 | 443 | ||
| 439 | (defun diary-pull-attrs (entry fileglobattrs) | 444 | (defun diary-pull-attrs (entry fileglobattrs) |
| 440 | "Pull the face-related attributes off the entry, merge with the | 445 | "Search for matches for regexps from `diary-face-attrs'. |
| 441 | fileglobattrs, and return the (possibly modified) entry and face | 446 | If ENTRY is nil, searches from the start of the current buffer, and |
| 442 | data in a list of attrname attrvalue values. | 447 | prepends all regexps with `diary-glob-file-regexp-prefix'. |
| 443 | The entry will be modified to drop all tags that are used for face matching. | 448 | If ENTRY is a string, search for matches in that string, and remove them. |
| 444 | If entry is nil, then the fileglobattrs are being searched for, | 449 | Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs. |
| 445 | the fileglobattrs variable is ignored, and | 450 | When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE) |
| 446 | diary-glob-file-regexp-prefix is prepended to the regexps before each | 451 | pairs." |
| 447 | search." | 452 | (let (regexp regnum attrname attrname attrvalue type ret-attr) |
| 448 | (save-excursion | 453 | (if (null entry) |
| 449 | (let (regexp regnum attrname attr-list attrname attrvalue type | 454 | (save-excursion |
| 450 | ret-attr attr) | 455 | (dolist (attr diary-face-attrs) |
| 451 | (if (null entry) | 456 | ;; FIXME inefficient searching. |
| 452 | (progn | ||
| 453 | (setq ret-attr '() | ||
| 454 | attr-list diary-face-attrs) | ||
| 455 | (while attr-list | ||
| 456 | (goto-char (point-min)) | ||
| 457 | (setq attr (car attr-list) | ||
| 458 | regexp (nth 0 attr) | ||
| 459 | regnum (nth 1 attr) | ||
| 460 | attrname (nth 2 attr) | ||
| 461 | type (nth 3 attr) | ||
| 462 | regexp (concat diary-glob-file-regexp-prefix regexp)) | ||
| 463 | (setq attrvalue nil) | ||
| 464 | (if (re-search-forward regexp (point-max) t) | ||
| 465 | (setq attrvalue (match-string-no-properties regnum))) | ||
| 466 | (if (and attrvalue | ||
| 467 | (setq attrvalue (diary-attrtype-convert attrvalue type))) | ||
| 468 | (setq ret-attr (append ret-attr (list attrname attrvalue)))) | ||
| 469 | (setq attr-list (cdr attr-list))) | ||
| 470 | (setq fileglobattrs ret-attr)) | ||
| 471 | (progn | ||
| 472 | (setq ret-attr fileglobattrs | ||
| 473 | attr-list diary-face-attrs) | ||
| 474 | (while attr-list | ||
| 475 | (goto-char (point-min)) | 457 | (goto-char (point-min)) |
| 476 | (setq attr (car attr-list) | 458 | (setq regexp (concat diary-glob-file-regexp-prefix (car attr)) |
| 477 | regexp (nth 0 attr) | 459 | regnum (cadr attr) |
| 478 | regnum (nth 1 attr) | ||
| 479 | attrname (nth 2 attr) | 460 | attrname (nth 2 attr) |
| 480 | type (nth 3 attr)) | 461 | type (nth 3 attr) |
| 481 | (setq attrvalue nil) | 462 | attrvalue (if (re-search-forward regexp nil t) |
| 482 | (if (string-match regexp entry) | 463 | (match-string-no-properties regnum))) |
| 483 | (progn | 464 | (and attrvalue |
| 484 | (setq attrvalue (match-string-no-properties regnum entry)) | 465 | (setq attrvalue (diary-attrtype-convert attrvalue type)) |
| 485 | (setq entry (replace-match "" t t entry)))) | 466 | (setq ret-attr (append ret-attr |
| 486 | (if (and attrvalue | 467 | (list attrname attrvalue)))))) |
| 487 | (setq attrvalue (diary-attrtype-convert attrvalue type))) | 468 | (setq ret-attr fileglobattrs) |
| 488 | (setq ret-attr (append ret-attr (list attrname attrvalue)))) | 469 | (dolist (attr diary-face-attrs) |
| 489 | (setq attr-list (cdr attr-list))))) | 470 | (setq regexp (car attr) |
| 490 | (list entry ret-attr)))) | 471 | regnum (cadr attr) |
| 472 | attrname (nth 2 attr) | ||
| 473 | type (nth 3 attr) | ||
| 474 | attrvalue nil) | ||
| 475 | ;; FIXME multiple matches? | ||
| 476 | (if (string-match regexp entry) | ||
| 477 | (setq attrvalue (match-string-no-properties regnum entry) | ||
| 478 | entry (replace-match "" t t entry))) | ||
| 479 | (and attrvalue | ||
| 480 | (setq attrvalue (diary-attrtype-convert attrvalue type)) | ||
| 481 | (setq ret-attr (append ret-attr (list attrname attrvalue)))))) | ||
| 482 | (list entry ret-attr))) | ||
| 491 | 483 | ||
| 492 | (defun diary-set-maybe-redraw (symbol value) | 484 | (defun diary-set-maybe-redraw (symbol value) |
| 493 | "Set SYMBOL's value to VALUE, and redraw the diary if necessary. | 485 | "Set SYMBOL's value to VALUE, and redraw the diary if necessary. |
| @@ -503,7 +495,7 @@ just visiting the `diary-file'), and SYMBOL's value is to be changed." | |||
| 503 | ;; This can be removed once the kill/yank treatment of invisible text | 495 | ;; This can be removed once the kill/yank treatment of invisible text |
| 504 | ;; (see etc/TODO) is fixed. -- gm | 496 | ;; (see etc/TODO) is fixed. -- gm |
| 505 | (defcustom diary-header-line-flag t | 497 | (defcustom diary-header-line-flag t |
| 506 | "If non-nil, `simple-diary-display' will show a header line. | 498 | "Non-nil means `simple-diary-display' will show a header line. |
| 507 | The format of the header is specified by `diary-header-line-format'." | 499 | The format of the header is specified by `diary-header-line-format'." |
| 508 | :group 'diary | 500 | :group 'diary |
| 509 | :type 'boolean | 501 | :type 'boolean |
| @@ -530,8 +522,6 @@ Only used if `diary-header-line-flag' is non-nil." | |||
| 530 | :set 'diary-set-maybe-redraw | 522 | :set 'diary-set-maybe-redraw |
| 531 | :version "22.1") | 523 | :version "22.1") |
| 532 | 524 | ||
| 533 | (defvar diary-saved-point) ; internal | ||
| 534 | |||
| 535 | ;; The first version of this also checked for diary-selective-display | 525 | ;; The first version of this also checked for diary-selective-display |
| 536 | ;; in the non-fancy case. This was an attempt to distinguish between | 526 | ;; in the non-fancy case. This was an attempt to distinguish between |
| 537 | ;; displaying the diary and just visiting the diary file. However, | 527 | ;; displaying the diary and just visiting the diary file. However, |
| @@ -586,6 +576,8 @@ Can be used by programs integrating a diary list into other buffers (e.g. | |||
| 586 | org.el and planner.el) to modify the string or add properties to it. | 576 | org.el and planner.el) to modify the string or add properties to it. |
| 587 | The function takes a string argument and must return a string.") | 577 | The function takes a string argument and must return a string.") |
| 588 | 578 | ||
| 579 | (defvar diary-entries-list) ; bound in diary-list-entries | ||
| 580 | |||
| 589 | (defun add-to-diary-list (date string specifier &optional marker | 581 | (defun add-to-diary-list (date string specifier &optional marker |
| 590 | globcolor literal) | 582 | globcolor literal) |
| 591 | "Add an entry to `diary-entries-list'. | 583 | "Add an entry to `diary-entries-list'. |
| @@ -604,7 +596,7 @@ FILENAME being the file containing the diary entry." | |||
| 604 | (if diary-file-name-prefix | 596 | (if diary-file-name-prefix |
| 605 | (let ((prefix (funcall diary-file-name-prefix-function | 597 | (let ((prefix (funcall diary-file-name-prefix-function |
| 606 | (buffer-file-name)))) | 598 | (buffer-file-name)))) |
| 607 | (or (string= prefix "") | 599 | (or (string-equal prefix "") |
| 608 | (setq string (format "[%s] %s" prefix string))))) | 600 | (setq string (format "[%s] %s" prefix string))))) |
| 609 | (and diary-modify-entry-list-string-function | 601 | (and diary-modify-entry-list-string-function |
| 610 | (setq string (funcall diary-modify-entry-list-string-function | 602 | (setq string (funcall diary-modify-entry-list-string-function |
| @@ -643,9 +635,9 @@ These hooks have the following distinct roles: | |||
| 643 | before the display hook is run. | 635 | before the display hook is run. |
| 644 | 636 | ||
| 645 | `diary-display-hook' does the actual display of information. If this is | 637 | `diary-display-hook' does the actual display of information. If this is |
| 646 | nil, simple-diary-display will be used. Use add-hook to set this to | 638 | nil, `simple-diary-display' will be used. Use `add-hook' to use |
| 647 | fancy-diary-display, if desired. If you want no diary display, use | 639 | `fancy-diary-display', if desired. If you want no diary display, use |
| 648 | add-hook to set this to ignore. | 640 | add-hook to set this to `ignore'. |
| 649 | 641 | ||
| 650 | `diary-hook' is run last. This can be used for an appointment | 642 | `diary-hook' is run last. This can be used for an appointment |
| 651 | notification function. | 643 | notification function. |
| @@ -704,7 +696,7 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." | |||
| 704 | (year (extract-calendar-year date)) | 696 | (year (extract-calendar-year date)) |
| 705 | (entry-found (list-sexp-diary-entries date))) | 697 | (entry-found (list-sexp-diary-entries date))) |
| 706 | (dolist (date-form diary-date-forms) | 698 | (dolist (date-form diary-date-forms) |
| 707 | (let ((backup (when (eq (car date-form) 'backup) | 699 | (let* ((backup (when (eq (car date-form) 'backup) |
| 708 | (setq date-form (cdr date-form)) | 700 | (setq date-form (cdr date-form)) |
| 709 | t)) | 701 | t)) |
| 710 | (dayname | 702 | (dayname |
| @@ -726,6 +718,8 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." | |||
| 726 | (regexp | 718 | (regexp |
| 727 | (concat | 719 | (concat |
| 728 | "^" mark "?\\(" | 720 | "^" mark "?\\(" |
| 721 | ;; This must be let* so that date-form | ||
| 722 | ;; can use day etc. | ||
| 729 | (mapconcat 'eval date-form "\\)\\(?:") | 723 | (mapconcat 'eval date-form "\\)\\(?:") |
| 730 | "\\)")) | 724 | "\\)")) |
| 731 | (case-fold-search t)) | 725 | (case-fold-search t)) |
| @@ -779,15 +773,19 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." | |||
| 779 | diary-entries-list)))))) | 773 | diary-entries-list)))))) |
| 780 | 774 | ||
| 781 | (defun diary-unhide-everything () | 775 | (defun diary-unhide-everything () |
| 776 | "Show all invisible text in the diary." | ||
| 782 | (kill-local-variable 'diary-selective-display) | 777 | (kill-local-variable 'diary-selective-display) |
| 783 | (remove-overlays (point-min) (point-max) 'invisible 'diary) | 778 | (remove-overlays (point-min) (point-max) 'invisible 'diary) |
| 784 | (kill-local-variable 'mode-line-format)) | 779 | (kill-local-variable 'mode-line-format)) |
| 785 | 780 | ||
| 781 | (defvar original-date) ; bound in diary-list-entries | ||
| 782 | (defvar number) | ||
| 783 | |||
| 786 | (defun include-other-diary-files () | 784 | (defun include-other-diary-files () |
| 787 | "Include the diary entries from other diary files with those of diary-file. | 785 | "Include the diary entries from other diary files with those of `diary-file'. |
| 788 | This function is suitable for use in `list-diary-entries-hook'; | 786 | This function is suitable for use in `list-diary-entries-hook'; |
| 789 | it enables you to use shared diary files together with your own. | 787 | it enables you to use shared diary files together with your own. |
| 790 | The files included are specified in the diaryfile by lines of this form: | 788 | The files included are specified in the `diary-file' by lines of this form: |
| 791 | #include \"filename\" | 789 | #include \"filename\" |
| 792 | This is recursive; that is, #include directives in diary files thus included | 790 | This is recursive; that is, #include directives in diary files thus included |
| 793 | are obeyed. You can change the `#include' to some other string by | 791 | are obeyed. You can change the `#include' to some other string by |
| @@ -821,6 +819,10 @@ changing the variable `diary-include-string'." | |||
| 821 | (sleep-for 2)))) | 819 | (sleep-for 2)))) |
| 822 | (goto-char (point-min))) | 820 | (goto-char (point-min))) |
| 823 | 821 | ||
| 822 | ;; Bound in diary-list-entries. | ||
| 823 | (defvar date-string) | ||
| 824 | (defvar diary-saved-point) | ||
| 825 | |||
| 824 | (defun simple-diary-display () | 826 | (defun simple-diary-display () |
| 825 | "Display the diary buffer if there are any relevant entries or holidays." | 827 | "Display the diary buffer if there are any relevant entries or holidays." |
| 826 | (let* ((holiday-list (if holidays-in-diary-buffer | 828 | (let* ((holiday-list (if holidays-in-diary-buffer |
| @@ -853,7 +855,7 @@ changing the variable `diary-include-string'." | |||
| 853 | (with-current-buffer | 855 | (with-current-buffer |
| 854 | (find-buffer-visiting (substitute-in-file-name diary-file)) | 856 | (find-buffer-visiting (substitute-in-file-name diary-file)) |
| 855 | (let ((window (display-buffer (current-buffer)))) | 857 | (let ((window (display-buffer (current-buffer)))) |
| 856 | ;; d-s-p is passed from list-diary-entries. | 858 | ;; d-s-p is passed from diary-list-entries. |
| 857 | (set-window-point window diary-saved-point) | 859 | (set-window-point window diary-saved-point) |
| 858 | (set-window-start window (point-min)))) | 860 | (set-window-start window (point-min)))) |
| 859 | (message "Preparing diary...done")))) | 861 | (message "Preparing diary...done")))) |
| @@ -863,7 +865,7 @@ changing the variable `diary-include-string'." | |||
| 863 | "Default face used for buttons." | 865 | "Default face used for buttons." |
| 864 | :version "22.1" | 866 | :version "22.1" |
| 865 | :group 'diary) | 867 | :group 'diary) |
| 866 | ;; backward-compatibility alias | 868 | ;; Backward-compatibility alias. FIXME make obsolete. |
| 867 | (put 'diary-button-face 'face-alias 'diary-button) | 869 | (put 'diary-button-face 'face-alias 'diary-button) |
| 868 | 870 | ||
| 869 | (define-button-type 'diary-entry | 871 | (define-button-type 'diary-entry |
| @@ -871,6 +873,7 @@ changing the variable `diary-include-string'." | |||
| 871 | 'face 'diary-button) | 873 | 'face 'diary-button) |
| 872 | 874 | ||
| 873 | (defun diary-goto-entry (button) | 875 | (defun diary-goto-entry (button) |
| 876 | "Jump to the diary entry for the button at point." | ||
| 874 | (let* ((locator (button-get button 'locator)) | 877 | (let* ((locator (button-get button 'locator)) |
| 875 | (marker (car locator)) | 878 | (marker (car locator)) |
| 876 | markbuf file) | 879 | markbuf file) |
| @@ -896,7 +899,8 @@ changing the variable `diary-include-string'." | |||
| 896 | (defun fancy-diary-display () | 899 | (defun fancy-diary-display () |
| 897 | "Prepare a diary buffer with relevant entries in a fancy, noneditable form. | 900 | "Prepare a diary buffer with relevant entries in a fancy, noneditable form. |
| 898 | This function is provided for optional use as the `diary-display-hook'." | 901 | This function is provided for optional use as the `diary-display-hook'." |
| 899 | (with-current-buffer ;; Turn off selective-display in the diary file's buffer. | 902 | ;; Turn off selective-display in the diary file's buffer. |
| 903 | (with-current-buffer | ||
| 900 | (find-buffer-visiting (substitute-in-file-name diary-file)) | 904 | (find-buffer-visiting (substitute-in-file-name diary-file)) |
| 901 | (diary-unhide-everything)) | 905 | (diary-unhide-everything)) |
| 902 | (if (or (not diary-entries-list) | 906 | (if (or (not diary-entries-list) |
| @@ -918,7 +922,8 @@ This function is provided for optional use as the `diary-display-hook'." | |||
| 918 | (setq buffer-read-only t) | 922 | (setq buffer-read-only t) |
| 919 | (display-buffer holiday-buffer) | 923 | (display-buffer holiday-buffer) |
| 920 | (message "No diary entries for %s" date-string))) | 924 | (message "No diary entries for %s" date-string))) |
| 921 | (with-current-buffer;; Prepare the fancy diary buffer. | 925 | ;; Prepare the fancy diary buffer. |
| 926 | (with-current-buffer | ||
| 922 | (make-fancy-diary-buffer) | 927 | (make-fancy-diary-buffer) |
| 923 | (setq buffer-read-only nil) | 928 | (setq buffer-read-only nil) |
| 924 | (let ((entry-list diary-entries-list) | 929 | (let ((entry-list diary-entries-list) |
| @@ -1133,7 +1138,7 @@ to run it every morning at 1am." | |||
| 1133 | "Return a regexp matching the strings in the array STRING-ARRAY. | 1138 | "Return a regexp matching the strings in the array STRING-ARRAY. |
| 1134 | If the optional argument ABBREV-ARRAY is present, then the function | 1139 | If the optional argument ABBREV-ARRAY is present, then the function |
| 1135 | `calendar-abbrev-construct' is used to construct abbreviations from the | 1140 | `calendar-abbrev-construct' is used to construct abbreviations from the |
| 1136 | two supplied arrays. The returned regexp will then also match these | 1141 | two supplied arrays. The returned regexp will then also match these |
| 1137 | abbreviations, with or without final `.' characters. If the optional | 1142 | abbreviations, with or without final `.' characters. If the optional |
| 1138 | argument PAREN is non-nil, the regexp is surrounded by parentheses." | 1143 | argument PAREN is non-nil, the regexp is surrounded by parentheses." |
| 1139 | (regexp-opt (append string-array | 1144 | (regexp-opt (append string-array |
| @@ -1246,9 +1251,10 @@ diary entries." | |||
| 1246 | y))) | 1251 | y))) |
| 1247 | (string-to-number y-str))))) | 1252 | (string-to-number y-str))))) |
| 1248 | (setq marks (nth 1 | 1253 | (setq marks (nth 1 |
| 1249 | (diary-pull-attrs (buffer-substring-no-properties | 1254 | (diary-pull-attrs |
| 1250 | (point) (line-end-position)) | 1255 | (buffer-substring-no-properties |
| 1251 | file-glob-attrs))) | 1256 | (point) (line-end-position)) |
| 1257 | file-glob-attrs))) | ||
| 1252 | (if dd-name | 1258 | (if dd-name |
| 1253 | (mark-calendar-days-named | 1259 | (mark-calendar-days-named |
| 1254 | (cdr (assoc-string | 1260 | (cdr (assoc-string |
| @@ -1270,6 +1276,9 @@ diary entries." | |||
| 1270 | 'mark-diary-entries-hook)) | 1276 | 'mark-diary-entries-hook)) |
| 1271 | (message "Marking diary entries...done"))))) | 1277 | (message "Marking diary entries...done"))))) |
| 1272 | 1278 | ||
| 1279 | (defvar displayed-year) ; bound in generate-calendar | ||
| 1280 | (defvar displayed-month) | ||
| 1281 | |||
| 1273 | (defun mark-sexp-diary-entries () | 1282 | (defun mark-sexp-diary-entries () |
| 1274 | "Mark days in the calendar window that have sexp diary entries. | 1283 | "Mark days in the calendar window that have sexp diary entries. |
| 1275 | Each entry in the diary file (or included files) visible in the calendar window | 1284 | Each entry in the diary file (or included files) visible in the calendar window |
| @@ -1301,11 +1310,12 @@ is marked. See the documentation for the function `list-sexp-diary-entries'." | |||
| 1301 | (setq sexp (buffer-substring-no-properties sexp-start (point))) | 1310 | (setq sexp (buffer-substring-no-properties sexp-start (point))) |
| 1302 | (forward-char 1) | 1311 | (forward-char 1) |
| 1303 | (if (and (bolp) (not (looking-at "[ \t]"))) | 1312 | (if (and (bolp) (not (looking-at "[ \t]"))) |
| 1304 | (progn;; Diary entry consists only of the sexp | 1313 | ;; Diary entry consists only of the sexp. |
| 1314 | (progn | ||
| 1305 | (backward-char 1) | 1315 | (backward-char 1) |
| 1306 | (setq entry "")) | 1316 | (setq entry "")) |
| 1307 | (setq entry-start (point)) | 1317 | (setq entry-start (point)) |
| 1308 | ;; Find end of entry | 1318 | ;; Find end of entry. |
| 1309 | (forward-line 1) | 1319 | (forward-line 1) |
| 1310 | (while (looking-at "[ \t]") | 1320 | (while (looking-at "[ \t]") |
| 1311 | (forward-line 1)) | 1321 | (forward-line 1)) |
| @@ -1328,7 +1338,7 @@ is marked. See the documentation for the function `list-sexp-diary-entries'." | |||
| 1328 | "Mark the diary entries from other diary files with those of the diary file. | 1338 | "Mark the diary entries from other diary files with those of the diary file. |
| 1329 | This function is suitable for use as the `mark-diary-entries-hook'; it enables | 1339 | This function is suitable for use as the `mark-diary-entries-hook'; it enables |
| 1330 | you to use shared diary files together with your own. The files included are | 1340 | you to use shared diary files together with your own. The files included are |
| 1331 | specified in the diary-file by lines of this form: | 1341 | specified in the `diary-file' by lines of this form: |
| 1332 | #include \"filename\" | 1342 | #include \"filename\" |
| 1333 | This is recursive; that is, #include directives in diary files thus included | 1343 | This is recursive; that is, #include directives in diary files thus included |
| 1334 | are obeyed. You can change the `#include' to some other string by | 1344 | are obeyed. You can change the `#include' to some other string by |
| @@ -1360,7 +1370,8 @@ changing the variable `diary-include-string'." | |||
| 1360 | 1370 | ||
| 1361 | (defun mark-calendar-days-named (dayname &optional color) | 1371 | (defun mark-calendar-days-named (dayname &optional color) |
| 1362 | "Mark all dates in the calendar window that are day DAYNAME of the week. | 1372 | "Mark all dates in the calendar window that are day DAYNAME of the week. |
| 1363 | 0 means all Sundays, 1 means all Mondays, and so on." | 1373 | 0 means all Sundays, 1 means all Mondays, and so on. |
| 1374 | Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK." | ||
| 1364 | (with-current-buffer calendar-buffer | 1375 | (with-current-buffer calendar-buffer |
| 1365 | (let ((prev-month displayed-month) | 1376 | (let ((prev-month displayed-month) |
| 1366 | (prev-year displayed-year) | 1377 | (prev-year displayed-year) |
| @@ -1371,16 +1382,18 @@ changing the variable `diary-include-string'." | |||
| 1371 | (increment-calendar-month succ-month succ-year 1) | 1382 | (increment-calendar-month succ-month succ-year 1) |
| 1372 | (increment-calendar-month prev-month prev-year -1) | 1383 | (increment-calendar-month prev-month prev-year -1) |
| 1373 | (setq day (calendar-absolute-from-gregorian | 1384 | (setq day (calendar-absolute-from-gregorian |
| 1374 | (calendar-nth-named-day 1 dayname prev-month prev-year))) | 1385 | (calendar-nth-named-day 1 dayname prev-month prev-year)) |
| 1375 | (setq last-day (calendar-absolute-from-gregorian | 1386 | last-day (calendar-absolute-from-gregorian |
| 1376 | (calendar-nth-named-day -1 dayname succ-month succ-year))) | 1387 | (calendar-nth-named-day -1 dayname succ-month succ-year))) |
| 1377 | (while (<= day last-day) | 1388 | (while (<= day last-day) |
| 1378 | (mark-visible-calendar-date (calendar-gregorian-from-absolute day) color) | 1389 | (mark-visible-calendar-date (calendar-gregorian-from-absolute day) |
| 1390 | color) | ||
| 1379 | (setq day (+ day 7)))))) | 1391 | (setq day (+ day 7)))))) |
| 1380 | 1392 | ||
| 1381 | (defun mark-calendar-date-pattern (month day year &optional color) | 1393 | (defun mark-calendar-date-pattern (month day year &optional color) |
| 1382 | "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. | 1394 | "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. |
| 1383 | A value of 0 in any position is a wildcard." | 1395 | A value of 0 in any position is a wildcard. |
| 1396 | Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK." | ||
| 1384 | (with-current-buffer calendar-buffer | 1397 | (with-current-buffer calendar-buffer |
| 1385 | (let ((m displayed-month) | 1398 | (let ((m displayed-month) |
| 1386 | (y displayed-year)) | 1399 | (y displayed-year)) |
| @@ -1390,13 +1403,14 @@ A value of 0 in any position is a wildcard." | |||
| 1390 | (increment-calendar-month m y 1))))) | 1403 | (increment-calendar-month m y 1))))) |
| 1391 | 1404 | ||
| 1392 | (defun mark-calendar-month (month year p-month p-day p-year &optional color) | 1405 | (defun mark-calendar-month (month year p-month p-day p-year &optional color) |
| 1393 | "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. | 1406 | "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P-DAY/P-YEAR. |
| 1394 | A value of 0 in any position of the pattern is a wildcard." | 1407 | A value of 0 in any position of the pattern is a wildcard. |
| 1408 | Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK." | ||
| 1395 | (if (or (and (= month p-month) | 1409 | (if (or (and (= month p-month) |
| 1396 | (or (= p-year 0) (= year p-year))) | 1410 | (or (zerop p-year) (= year p-year))) |
| 1397 | (and (= p-month 0) | 1411 | (and (= p-month 0) |
| 1398 | (or (= p-year 0) (= year p-year)))) | 1412 | (or (zerop p-year) (= year p-year)))) |
| 1399 | (if (= p-day 0) | 1413 | (if (zerop p-day) |
| 1400 | (calendar-for-loop | 1414 | (calendar-for-loop |
| 1401 | i from 1 to (calendar-last-day-of-month month year) do | 1415 | i from 1 to (calendar-last-day-of-month month year) do |
| 1402 | (mark-visible-calendar-date (list month i year) color)) | 1416 | (mark-visible-calendar-date (list month i year) color)) |
| @@ -1407,7 +1421,7 @@ A value of 0 in any position of the pattern is a wildcard." | |||
| 1407 | (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) | 1421 | (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) |
| 1408 | 1422 | ||
| 1409 | (defun diary-entry-compare (e1 e2) | 1423 | (defun diary-entry-compare (e1 e2) |
| 1410 | "Returns t if E1 is earlier than E2." | 1424 | "Return t if E1 is earlier than E2." |
| 1411 | (or (calendar-date-compare e1 e2) | 1425 | (or (calendar-date-compare e1 e2) |
| 1412 | (and (calendar-date-equal (car e1) (car e2)) | 1426 | (and (calendar-date-equal (car e1) (car e2)) |
| 1413 | (let* ((ts1 (cadr e1)) (t1 (diary-entry-time ts1)) | 1427 | (let* ((ts1 (cadr e1)) (t1 (diary-entry-time ts1)) |
| @@ -1425,23 +1439,23 @@ The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam, | |||
| 1425 | XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can | 1439 | XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can |
| 1426 | be used instead of a colon (:) to separate the hour and minute parts." | 1440 | be used instead of a colon (:) to separate the hour and minute parts." |
| 1427 | (let ((case-fold-search nil)) | 1441 | (let ((case-fold-search nil)) |
| 1428 | (cond ((string-match ; Military time | 1442 | (cond ((string-match ; military time |
| 1429 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" | 1443 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" |
| 1430 | s) | 1444 | s) |
| 1431 | (+ (* 100 (string-to-number (match-string 1 s))) | 1445 | (+ (* 100 (string-to-number (match-string 1 s))) |
| 1432 | (string-to-number (match-string 2 s)))) | 1446 | (string-to-number (match-string 2 s)))) |
| 1433 | ((string-match ; Hour only XXam or XXpm | 1447 | ((string-match ; hour only (XXam or XXpm) |
| 1434 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) | 1448 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) |
| 1435 | (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) | 1449 | (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) |
| 1436 | (if (equal ?a (downcase (aref s (match-beginning 2)))) | 1450 | (if (equal ?a (downcase (aref s (match-beginning 2)))) |
| 1437 | 0 1200))) | 1451 | 0 1200))) |
| 1438 | ((string-match ; Hour and minute XX:XXam or XX:XXpm | 1452 | ((string-match ; hour and minute (XX:XXam or XX:XXpm) |
| 1439 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) | 1453 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) |
| 1440 | (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) | 1454 | (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) |
| 1441 | (string-to-number (match-string 2 s)) | 1455 | (string-to-number (match-string 2 s)) |
| 1442 | (if (equal ?a (downcase (aref s (match-beginning 3)))) | 1456 | (if (equal ?a (downcase (aref s (match-beginning 3)))) |
| 1443 | 0 1200))) | 1457 | 0 1200))) |
| 1444 | (t diary-unknown-time)))) ; Unrecognizable | 1458 | (t diary-unknown-time)))) ; unrecognizable |
| 1445 | 1459 | ||
| 1446 | (defun list-sexp-diary-entries (date) | 1460 | (defun list-sexp-diary-entries (date) |
| 1447 | "Add sexp entries for DATE from the diary file to `diary-entries-list'. | 1461 | "Add sexp entries for DATE from the diary file to `diary-entries-list'. |
| @@ -1484,7 +1498,7 @@ A number of built-in functions are available for this type of diary entry: | |||
| 1484 | (DAYNAME=0 means Sunday, 1 means Monday, and so on; | 1498 | (DAYNAME=0 means Sunday, 1 means Monday, and so on; |
| 1485 | if N is negative it counts backward from the end of | 1499 | if N is negative it counts backward from the end of |
| 1486 | the month. MONTH can be a list of months, a single | 1500 | the month. MONTH can be a list of months, a single |
| 1487 | month, or t to specify all months. Optional DAY means | 1501 | month, or t to specify all months. Optional DAY means |
| 1488 | Nth DAYNAME of MONTH on or after/before DAY. DAY defaults | 1502 | Nth DAYNAME of MONTH on or after/before DAY. DAY defaults |
| 1489 | to 1 if N>0 and the last day of the month if N<0. An | 1503 | to 1 if N>0 and the last day of the month if N<0. An |
| 1490 | optional parameter MARK specifies a face or single-character | 1504 | optional parameter MARK specifies a face or single-character |
| @@ -1627,7 +1641,8 @@ best if they are nonmarking." | |||
| 1627 | entry-start (1+ line-start)) | 1641 | entry-start (1+ line-start)) |
| 1628 | (forward-char 1) | 1642 | (forward-char 1) |
| 1629 | (if (and (bolp) (not (looking-at "[ \t]"))) | 1643 | (if (and (bolp) (not (looking-at "[ \t]"))) |
| 1630 | (progn;; Diary entry consists only of the sexp | 1644 | ;; Diary entry consists only of the sexp. |
| 1645 | (progn | ||
| 1631 | (backward-char 1) | 1646 | (backward-char 1) |
| 1632 | (setq entry "")) | 1647 | (setq entry "")) |
| 1633 | (setq entry-start (point)) | 1648 | (setq entry-start (point)) |
| @@ -1678,6 +1693,7 @@ best if they are nonmarking." | |||
| 1678 | (result entry) | 1693 | (result entry) |
| 1679 | (t nil)))) | 1694 | (t nil)))) |
| 1680 | 1695 | ||
| 1696 | (defvar date) | ||
| 1681 | (defvar entry) | 1697 | (defvar entry) |
| 1682 | 1698 | ||
| 1683 | ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. | 1699 | ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. |
| @@ -1752,17 +1768,18 @@ highlighting the day in the calendar." | |||
| 1752 | (let* ((m (extract-calendar-month date)) | 1768 | (let* ((m (extract-calendar-month date)) |
| 1753 | (d (extract-calendar-day date)) | 1769 | (d (extract-calendar-day date)) |
| 1754 | (y (extract-calendar-year date)) | 1770 | (y (extract-calendar-year date)) |
| 1755 | (limit; last (n>0) or first (n<0) possible base date for entry | 1771 | ;; Last (n>0) or first (n<0) possible base date for entry. |
| 1772 | (limit | ||
| 1756 | (calendar-nth-named-absday (- n) dayname m y d)) | 1773 | (calendar-nth-named-absday (- n) dayname m y d)) |
| 1757 | (last-abs (if (> n 0) limit (+ limit 6))) | 1774 | (last-abs (if (> n 0) limit (+ limit 6))) |
| 1758 | (first-abs (if (> n 0) (- limit 6) limit)) | 1775 | (first-abs (if (> n 0) (- limit 6) limit)) |
| 1759 | (last (calendar-gregorian-from-absolute last-abs)) | 1776 | (last (calendar-gregorian-from-absolute last-abs)) |
| 1760 | (first (calendar-gregorian-from-absolute first-abs)) | 1777 | (first (calendar-gregorian-from-absolute first-abs)) |
| 1761 | ; m1, d1 is first possible base date | 1778 | ;; m1, d1 is first possible base date. |
| 1762 | (m1 (extract-calendar-month first)) | 1779 | (m1 (extract-calendar-month first)) |
| 1763 | (d1 (extract-calendar-day first)) | 1780 | (d1 (extract-calendar-day first)) |
| 1764 | (y1 (extract-calendar-year first)) | 1781 | (y1 (extract-calendar-year first)) |
| 1765 | ; m2, d2 is last possible base date | 1782 | ;; m2, d2 is last possible base date. |
| 1766 | (m2 (extract-calendar-month last)) | 1783 | (m2 (extract-calendar-month last)) |
| 1767 | (d2 (extract-calendar-day last)) | 1784 | (d2 (extract-calendar-day last)) |
| 1768 | (y2 (extract-calendar-year last))) | 1785 | (y2 (extract-calendar-year last))) |
| @@ -1775,11 +1792,11 @@ highlighting the day in the calendar." | |||
| 1775 | 1 | 1792 | 1 |
| 1776 | (calendar-last-day-of-month m1 y1))))) | 1793 | (calendar-last-day-of-month m1 y1))))) |
| 1777 | (and (<= d1 d) (<= d d2)))) | 1794 | (and (<= d1 d) (<= d d2)))) |
| 1778 | ;; only possible base dates straddle two months | 1795 | ;; Only possible base dates straddle two months. |
| 1779 | (and (or (< y1 y2) | 1796 | (and (or (< y1 y2) |
| 1780 | (and (= y1 y2) (< m1 m2))) | 1797 | (and (= y1 y2) (< m1 m2))) |
| 1781 | (or | 1798 | (or |
| 1782 | ;; m1, d1 works as a base date | 1799 | ;; m1, d1 works as a base date. |
| 1783 | (and | 1800 | (and |
| 1784 | (or (eq month t) | 1801 | (or (eq month t) |
| 1785 | (if (listp month) | 1802 | (if (listp month) |
| @@ -1788,7 +1805,7 @@ highlighting the day in the calendar." | |||
| 1788 | (<= d1 (or day (if (> n 0) | 1805 | (<= d1 (or day (if (> n 0) |
| 1789 | 1 | 1806 | 1 |
| 1790 | (calendar-last-day-of-month m1 y1))))) | 1807 | (calendar-last-day-of-month m1 y1))))) |
| 1791 | ;; m2, d2 works as a base date | 1808 | ;; m2, d2 works as a base date. |
| 1792 | (and (or (eq month t) | 1809 | (and (or (eq month t) |
| 1793 | (if (listp month) | 1810 | (if (listp month) |
| 1794 | (memq m2 month) | 1811 | (memq m2 month) |
| @@ -1872,20 +1889,20 @@ returned. | |||
| 1872 | In addition to the reminders beforehand, the diary entry also appears on the | 1889 | In addition to the reminders beforehand, the diary entry also appears on the |
| 1873 | date itself. | 1890 | date itself. |
| 1874 | 1891 | ||
| 1875 | A `diary-nonmarking-symbol' at the beginning of the line of the diary-remind | 1892 | A `diary-nonmarking-symbol' at the beginning of the line of the `diary-remind' |
| 1876 | entry specifies that the diary entry (not the reminder) is non-marking. | 1893 | entry specifies that the diary entry (not the reminder) is non-marking. |
| 1877 | Marking of reminders is independent of whether the entry itself is a marking | 1894 | Marking of reminders is independent of whether the entry itself is a marking |
| 1878 | or nonmarking; if optional parameter MARKING is non-nil then the reminders are | 1895 | or nonmarking; if optional parameter MARKING is non-nil then the reminders are |
| 1879 | marked on the calendar." | 1896 | marked on the calendar." |
| 1880 | (let ((diary-entry (eval sexp))) | 1897 | (let ((diary-entry (eval sexp))) |
| 1881 | (cond | 1898 | (cond |
| 1882 | ;; Diary entry applies on date | 1899 | ;; Diary entry applies on date. |
| 1883 | ((and diary-entry | 1900 | ((and diary-entry |
| 1884 | (or (not marking-diary-entries) marking-diary-entry)) | 1901 | (or (not marking-diary-entries) marking-diary-entry)) |
| 1885 | diary-entry) | 1902 | diary-entry) |
| 1886 | ;; Diary entry may apply to `days' before date | 1903 | ;; Diary entry may apply to `days' before date. |
| 1887 | ((and (integerp days) | 1904 | ((and (integerp days) |
| 1888 | (not diary-entry); Diary entry does not apply to date | 1905 | (not diary-entry) ; diary entry does not apply to date |
| 1889 | (or (not marking-diary-entries) marking)) | 1906 | (or (not marking-diary-entries) marking)) |
| 1890 | (let ((date (calendar-gregorian-from-absolute | 1907 | (let ((date (calendar-gregorian-from-absolute |
| 1891 | (+ (calendar-absolute-from-gregorian date) days)))) | 1908 | (+ (calendar-absolute-from-gregorian date) days)))) |
| @@ -1893,7 +1910,7 @@ marked on the calendar." | |||
| 1893 | ;; Discard any mark portion from diary-anniversary, etc. | 1910 | ;; Discard any mark portion from diary-anniversary, etc. |
| 1894 | (if (consp diary-entry) (setq diary-entry (cdr diary-entry))) | 1911 | (if (consp diary-entry) (setq diary-entry (cdr diary-entry))) |
| 1895 | (mapconcat 'eval diary-remind-message "")))) | 1912 | (mapconcat 'eval diary-remind-message "")))) |
| 1896 | ;; Diary entry may apply to one of a list of days before date | 1913 | ;; Diary entry may apply to one of a list of days before date. |
| 1897 | ((and (listp days) days) | 1914 | ((and (listp days) days) |
| 1898 | (or (diary-remind sexp (car days) marking) | 1915 | (or (diary-remind sexp (car days) marking) |
| 1899 | (diary-remind sexp (cdr days) marking)))))) | 1916 | (diary-remind sexp (cdr days) marking)))))) |
| @@ -1930,21 +1947,21 @@ If omitted, NONMARKING defaults to nil and FILE defaults to | |||
| 1930 | 1947 | ||
| 1931 | (defun insert-diary-entry (arg) | 1948 | (defun insert-diary-entry (arg) |
| 1932 | "Insert a diary entry for the date indicated by point. | 1949 | "Insert a diary entry for the date indicated by point. |
| 1933 | Prefix arg will make the entry nonmarking." | 1950 | Prefix argument ARG makes the entry nonmarking." |
| 1934 | (interactive "P") | 1951 | (interactive "P") |
| 1935 | (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t) | 1952 | (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t) |
| 1936 | arg)) | 1953 | arg)) |
| 1937 | 1954 | ||
| 1938 | (defun insert-weekly-diary-entry (arg) | 1955 | (defun insert-weekly-diary-entry (arg) |
| 1939 | "Insert a weekly diary entry for the day of the week indicated by point. | 1956 | "Insert a weekly diary entry for the day of the week indicated by point. |
| 1940 | Prefix arg will make the entry nonmarking." | 1957 | Prefix argument ARG makes the entry nonmarking." |
| 1941 | (interactive "P") | 1958 | (interactive "P") |
| 1942 | (make-diary-entry (calendar-day-name (calendar-cursor-to-date t)) | 1959 | (make-diary-entry (calendar-day-name (calendar-cursor-to-date t)) |
| 1943 | arg)) | 1960 | arg)) |
| 1944 | 1961 | ||
| 1945 | (defun insert-monthly-diary-entry (arg) | 1962 | (defun insert-monthly-diary-entry (arg) |
| 1946 | "Insert a monthly diary entry for the day of the month indicated by point. | 1963 | "Insert a monthly diary entry for the day of the month indicated by point. |
| 1947 | Prefix arg will make the entry nonmarking." | 1964 | Prefix argument ARG makes the entry nonmarking." |
| 1948 | (interactive "P") | 1965 | (interactive "P") |
| 1949 | (let ((calendar-date-display-form | 1966 | (let ((calendar-date-display-form |
| 1950 | (if european-calendar-style | 1967 | (if european-calendar-style |
| @@ -1955,7 +1972,7 @@ Prefix arg will make the entry nonmarking." | |||
| 1955 | 1972 | ||
| 1956 | (defun insert-yearly-diary-entry (arg) | 1973 | (defun insert-yearly-diary-entry (arg) |
| 1957 | "Insert an annual diary entry for the day of the year indicated by point. | 1974 | "Insert an annual diary entry for the day of the year indicated by point. |
| 1958 | Prefix arg will make the entry nonmarking." | 1975 | Prefix argument ARG makes the entry nonmarking." |
| 1959 | (interactive "P") | 1976 | (interactive "P") |
| 1960 | (let ((calendar-date-display-form | 1977 | (let ((calendar-date-display-form |
| 1961 | (if european-calendar-style | 1978 | (if european-calendar-style |
| @@ -1966,7 +1983,7 @@ Prefix arg will make the entry nonmarking." | |||
| 1966 | 1983 | ||
| 1967 | (defun insert-anniversary-diary-entry (arg) | 1984 | (defun insert-anniversary-diary-entry (arg) |
| 1968 | "Insert an anniversary diary entry for the date given by point. | 1985 | "Insert an anniversary diary entry for the date given by point. |
| 1969 | Prefix arg will make the entry nonmarking." | 1986 | Prefix argument ARG makes the entry nonmarking." |
| 1970 | (interactive "P") | 1987 | (interactive "P") |
| 1971 | (let ((calendar-date-display-form | 1988 | (let ((calendar-date-display-form |
| 1972 | (if european-calendar-style | 1989 | (if european-calendar-style |
| @@ -1980,7 +1997,7 @@ Prefix arg will make the entry nonmarking." | |||
| 1980 | 1997 | ||
| 1981 | (defun insert-block-diary-entry (arg) | 1998 | (defun insert-block-diary-entry (arg) |
| 1982 | "Insert a block diary entry for the days between the point and marked date. | 1999 | "Insert a block diary entry for the days between the point and marked date. |
| 1983 | Prefix arg will make the entry nonmarking." | 2000 | Prefix argument ARG makes the entry nonmarking." |
| 1984 | (interactive "P") | 2001 | (interactive "P") |
| 1985 | (let ((calendar-date-display-form | 2002 | (let ((calendar-date-display-form |
| 1986 | (if european-calendar-style | 2003 | (if european-calendar-style |
| @@ -2005,7 +2022,7 @@ Prefix arg will make the entry nonmarking." | |||
| 2005 | 2022 | ||
| 2006 | (defun insert-cyclic-diary-entry (arg) | 2023 | (defun insert-cyclic-diary-entry (arg) |
| 2007 | "Insert a cyclic diary entry starting at the date given by point. | 2024 | "Insert a cyclic diary entry starting at the date given by point. |
| 2008 | Prefix arg will make the entry nonmarking." | 2025 | Prefix argument ARG makes the entry nonmarking." |
| 2009 | (interactive "P") | 2026 | (interactive "P") |
| 2010 | (let ((calendar-date-display-form | 2027 | (let ((calendar-date-display-form |
| 2011 | (if european-calendar-style | 2028 | (if european-calendar-style |
| @@ -2083,7 +2100,7 @@ Prefix arg will make the entry nonmarking." | |||
| 2083 | '("^Parashat.*$" . font-lock-comment-face) | 2100 | '("^Parashat.*$" . font-lock-comment-face) |
| 2084 | `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp | 2101 | `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp |
| 2085 | diary-time-regexp) . 'diary-time)) | 2102 | diary-time-regexp) . 'diary-time)) |
| 2086 | "Keywords to highlight in fancy diary display") | 2103 | "Keywords to highlight in fancy diary display.") |
| 2087 | 2104 | ||
| 2088 | ;; If region looks like it might start or end in the middle of a | 2105 | ;; If region looks like it might start or end in the middle of a |
| 2089 | ;; multiline pattern, extend the region to encompass the whole pattern. | 2106 | ;; multiline pattern, extend the region to encompass the whole pattern. |
| @@ -2118,7 +2135,7 @@ Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'." | |||
| 2118 | 2135 | ||
| 2119 | 2136 | ||
| 2120 | (defun diary-font-lock-sexps (limit) | 2137 | (defun diary-font-lock-sexps (limit) |
| 2121 | "Recognize sexp diary entry for font-locking." | 2138 | "Recognize sexp diary entry up to LIMIT for font-locking." |
| 2122 | (if (re-search-forward | 2139 | (if (re-search-forward |
| 2123 | (concat "^" (regexp-quote diary-nonmarking-symbol) | 2140 | (concat "^" (regexp-quote diary-nonmarking-symbol) |
| 2124 | "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)") | 2141 | "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)") |
| @@ -2152,12 +2169,12 @@ names." | |||
| 2152 | (if symbol (regexp-quote symbol) "") "\\(" | 2169 | (if symbol (regexp-quote symbol) "") "\\(" |
| 2153 | (mapconcat 'eval | 2170 | (mapconcat 'eval |
| 2154 | ;; If backup, omit first item (backup) | 2171 | ;; If backup, omit first item (backup) |
| 2155 | ;; and last item (not part of date) | 2172 | ;; and last item (not part of date). |
| 2156 | (if (equal (car x) 'backup) | 2173 | (if (equal (car x) 'backup) |
| 2157 | (nreverse (cdr (reverse (cdr x)))) | 2174 | (nreverse (cdr (reverse (cdr x)))) |
| 2158 | x) | 2175 | x) |
| 2159 | "") | 2176 | "") |
| 2160 | ;; With backup, last item is not part of date | 2177 | ;; With backup, last item is not part of date. |
| 2161 | (if (equal (car x) 'backup) | 2178 | (if (equal (car x) 'backup) |
| 2162 | (concat "\\)" (eval (car (reverse x)))) | 2179 | (concat "\\)" (eval (car (reverse x)))) |
| 2163 | "\\)")) | 2180 | "\\)")) |