aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-03-15 03:03:08 +0000
committerGlenn Morris2008-03-15 03:03:08 +0000
commit4e11bcc210ba6a50eeda79aa3324b8944bfe76e8 (patch)
treea2b33427b9a50d1bc9174821e767726ac1c8b847
parent711d00e76e91b333f5c63344fb89103937614761 (diff)
downloademacs-4e11bcc210ba6a50eeda79aa3324b8944bfe76e8.tar.gz
emacs-4e11bcc210ba6a50eeda79aa3324b8944bfe76e8.zip
(diary-face-attrs, diary-glob-file-regexp-prefix, diary-selective-display)
(number-of-diary-entries, diary-list-entries, diary-goto-entry): (list-sexp-diary-entries, diary-date, diary-block, diary-float) (diary-anniversary, diary-cyclic) (diary-fancy-font-lock-fontify-region-function): Doc fixes. (diary-header-line-format): Change wording. (diary-list-entries): Set `date-start' in let. (include-other-diary-files, mark-included-diary-files): Use format. (simple-diary-display, fancy-diary-display): Use cadr, unless. (mark-diary-entries): Use 1+. (mark-sexp-diary-entries, list-sexp-diary-entries): Use when. (mark-calendar-month): Use dotimes. (diary-list-entries-1, diary-mark-entries-1): New functions.
-rw-r--r--lisp/ChangeLog97
-rw-r--r--lisp/calendar/diary-lib.el414
2 files changed, 379 insertions, 132 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 36c2c11350d..90eabaf24f2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,100 @@
12008-03-15 Glenn Morris <rgm@gnu.org>
2
3 * calendar/diary-lib.el (diary-list-entries-1, diary-mark-entries-1):
4 New functions.
5 * calendar/cal-bahai.el (number, original-date, add-to-diary-list)
6 (diary-name-pattern, mark-calendar-days-named): Remove declarations.
7 (diary-list-entries-1, diary-mark-entries-1): Autoload.
8 (diary-bahai-list-entries): Use diary-list-entries-1.
9 (diary-bahai-mark-entries): Doc fix. Use diary-mark-entries-1.
10 * calendar/cal-hebrew.el (number, original-date, add-to-diary-list)
11 (diary-name-pattern, mark-calendar-days-named): Remove declarations.
12 (diary-list-entries-1, diary-mark-entries-1): Autoload.
13 (list-hebrew-diary-entries): Use diary-list-entries-1.
14 (mark-hebrew-diary-entries): Doc fix. Use diary-mark-entries-1.
15 * calendar/cal-islam.el (number, original-date, add-to-diary-list)
16 (diary-name-pattern, mark-calendar-days-named): Remove declarations.
17 (diary-list-entries-1, diary-mark-entries-1): Autoload.
18 (list-islamic-diary-entries): Use diary-list-entries-1.
19 (mark-islamic-diary-entries): Doc fix. Use diary-mark-entries-1.
20
21 * calendar/appt.el (appt-check, appt-delete, appt-make-list): Use caar.
22
23 * calendar/cal-bahai.el (calendar-bahai-epoch): Doc fix.
24
25 * calendar/cal-china.el (number-chinese-months)
26 (calendar-chinese-from-absolute): Use nth, caar.
27
28 * calendar/cal-coptic.el (coptic-calendar-epoch): Doc fix.
29
30 * calendar/cal-french.el (french-calendar-accents): Doc fix.
31
32 * calendar/cal-hebrew.el (calendar-hebrew-month-name-array-common-year)
33 (calendar-hebrew-month-name-array-leap-year)
34 (hebrew-calendar-parashiot-names): Make constants.
35 (diary-parasha): Move definition after constants it uses.
36
37 * calendar/cal-html.el (cal-html-insert-link-yearpage)
38 (cal-html-htmlify-list): Doc fix.
39 (cal-html-htmlify-entry): Use nth.
40
41 * calendar/cal-islam.el (calendar-islamic-month-name-array)
42 (calendar-islamic-epoch): Make constants.
43 (calendar-islamic-epoch): Doc fix.
44
45 * calendar/cal-menu.el (cal-menu-goto-menu): Use "Go To".
46
47 * calendar/cal-tex.el (cal-tex-hook, cal-tex-insert-preamble)
48 (cal-tex-month-name): Doc fix.
49 (cal-tex-last-blank-p): Use zerop.
50
51 * calendar/calendar.el (european-calendar-style, calendar-for-loop)
52 (calendar-sum, calendar-insert-indented, mouse-calendar-other-month)
53 (calendar-cursor-to-date): Doc fix.
54 (hebrew-holidays-1, hebrew-holidays-4): Simplify.
55 (extract-calendar-day, extract-calendar-year): Use cadr, nth.
56 (calendar-day-number): Use when.
57 (generate-calendar-month): Use dotimes.
58 (exit-calendar, calendar-print-other-dates): Use let rather than let*.
59 (calendar-set-mark): Reverse conditional.
60 (calendar-make-alist): Move definition before use.
61
62 * calendar/diary-lib.el (diary-face-attrs)
63 (diary-glob-file-regexp-prefix, diary-selective-display)
64 (number-of-diary-entries, diary-list-entries, diary-goto-entry):
65 (list-sexp-diary-entries, diary-date, diary-block, diary-float)
66 (diary-anniversary, diary-cyclic)
67 (diary-fancy-font-lock-fontify-region-function): Doc fixes.
68 (diary-header-line-format): Change wording.
69 (diary-list-entries): Set `date-start' in let.
70 (include-other-diary-files, mark-included-diary-files): Use format.
71 (simple-diary-display, fancy-diary-display): Use cadr, unless.
72 (mark-diary-entries): Use 1+.
73 (mark-sexp-diary-entries, list-sexp-diary-entries): Use when.
74 (mark-calendar-month): Use dotimes.
75
76 * calendar/holidays.el (displayed-month, displayed-year): Move
77 declarations where needed.
78 (calendar-list-holidays): Doc fix.
79
80 * calendar/parse-time.el (parse-time-string): Simplify.
81
82 * calendar/solar.el (solar-n-hemi-seasons, solar-s-hemi-seasons):
83 Make constants.
84 (solar-sunrise-sunset): Rename some local variables for clarity.
85 (sunrise-sunset): Use zerop.
86 (solar-mean-equinoxes/solstices): Doc fix.
87
88 * calendar/timeclock.el (timeclock-time-to-seconds, timeclock-log-data):
89 Use nth.
90 (timeclock-completing-read, timeclock-generate-report): Use zerop.
91 (timeclock-mean, timeclock-generate-report): Use dolist.
92
93 * calendar/todo-mode.el (todo-add-category): Simplify.
94 (todo-more-important-p, todo-delete-item, todo-file-item): Use unless,
95 when.
96 (todo-top-priorities): Use zerop.
97
12008-03-14 Nick Roberts <nickrob@snap.net.nz> 982008-03-14 Nick Roberts <nickrob@snap.net.nz>
2 99
3 * buff-menu.el (list-buffers-noselect): Display buffer name in 100 * buff-menu.el (list-buffers-noselect): Display buffer name in
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index dae56f9428d..d6b99a21411 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -84,7 +84,7 @@ are holidays."
84This is used by `diary-pull-attrs' to fontify certain diary 84This is used by `diary-pull-attrs' to fontify certain diary
85elements. REGEXP is a regular expression to for, and SUBEXP is 85elements. REGEXP is a regular expression to for, and SUBEXP is
86the numbered sub-expression to extract. `diary-glob-file-regexp-prefix' 86the numbered sub-expression to extract. `diary-glob-file-regexp-prefix'
87is prepended to REGEXP for file-wide specifiers. ATTRIBUTE 87is pre-pended to REGEXP for file-wide specifiers. ATTRIBUTE
88specifies which face attribute (e.g. `:foreground') to modify, or 88specifies which face attribute (e.g. `:foreground') to modify, or
89that this is a face (`:face') to apply. TYPE is the type of 89that this is a face (`:face') to apply. TYPE is the type of
90attribute being applied. Available TYPES (see `diary-attrtype-convert') 90attribute being applied. Available TYPES (see `diary-attrtype-convert')
@@ -101,7 +101,7 @@ are: `string', `symbol', `int', `tnil',`stringtnil.'"
101 :group 'diary) 101 :group 'diary)
102 102
103(defcustom diary-glob-file-regexp-prefix "^\\#" 103(defcustom diary-glob-file-regexp-prefix "^\\#"
104 "Regular expression prepended to `diary-face-attrs' for file-wide specifiers." 104 "Regular expression pre-pended to `diary-face-attrs' for file-wide specifiers."
105 :type 'regexp 105 :type 'regexp
106 :group 'diary) 106 :group 'diary)
107 107
@@ -417,12 +417,13 @@ The format of the header is specified by `diary-header-line-format'."
417 :set 'diary-set-maybe-redraw 417 :set 'diary-set-maybe-redraw
418 :version "22.1") 418 :version "22.1")
419 419
420(defvar diary-selective-display nil) 420(defvar diary-selective-display nil
421 "Internal diary variable; non-nil if some diary text is hidden.")
421 422
422(defcustom diary-header-line-format 423(defcustom diary-header-line-format
423 '(:eval (calendar-string-spread 424 '(:eval (calendar-string-spread
424 (list (if diary-selective-display 425 (list (if diary-selective-display
425 "Selective display active - press \"s\" in calendar \ 426 "Some text is hidden - press \"s\" in calendar \
426before edit/copy" 427before edit/copy"
427 "Diary")) 428 "Diary"))
428 ?\s (frame-width))) 429 ?\s (frame-width)))
@@ -439,11 +440,11 @@ Only used if `diary-header-line-flag' is non-nil."
439;; in the non-fancy case. This was an attempt to distinguish between 440;; in the non-fancy case. This was an attempt to distinguish between
440;; displaying the diary and just visiting the diary file. However, 441;; displaying the diary and just visiting the diary file. However,
441;; when using fancy diary, calling diary when there are no entries to 442;; when using fancy diary, calling diary when there are no entries to
442;; display does not create the fancy buffer, nor does it switch on 443;; display does not create the fancy buffer, nor does it set
443;; selective-display in the diary buffer. This means some 444;; diary-selective-display in the diary buffer. This means some
444;; customizations will not take effect, eg: 445;; customizations will not take effect, eg:
445;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00466.html 446;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00466.html
446;; So the check for selective-display was dropped. This means the 447;; So the check for diary-selective-display was dropped. This means the
447;; diary will be displayed if one customizes a diary variable while 448;; diary will be displayed if one customizes a diary variable while
448;; just visiting the diary-file. This is i) unlikely, and ii) no great loss. 449;; just visiting the diary-file. This is i) unlikely, and ii) no great loss.
449;;;###cal-autoload 450;;;###cal-autoload
@@ -456,8 +457,8 @@ Only used if `diary-header-line-flag' is non-nil."
456(defcustom number-of-diary-entries 1 457(defcustom number-of-diary-entries 1
457 "Specifies how many days of diary entries are to be displayed initially. 458 "Specifies how many days of diary entries are to be displayed initially.
458This variable affects the diary display when the command \\[diary] is used, 459This variable affects the diary display when the command \\[diary] is used,
459or if the value of the variable `view-diary-entries-initially' is t. For 460or if the value of the variable `view-diary-entries-initially' is non-nil.
460example, if the default value 1 is used, then only the current day's diary 461For example, if the default value 1 is used, then only the current day's diary
461entries will be displayed. If the value 2 is used, then both the current 462entries will be displayed. If the value 2 is used, then both the current
462day's and the next day's entries will be displayed. 463day's and the next day's entries will be displayed.
463 464
@@ -521,19 +522,90 @@ FILENAME being the file containing the diary entry."
521 (list marker (buffer-file-name) literal) 522 (list marker (buffer-file-name) literal)
522 globcolor)))))) 523 globcolor))))))
523 524
525(defvar number)
526(defvar original-date)
527
528;; FIXME use for list-diary-entries.
529(defun diary-list-entries-1 (months symbol absfunc)
530 "List diary entries of a certain type.
531MONTHS is an array of month names. SYMBOL marks diary entries of the type
532in question. ABSFUNC is a function that converts absolute dates to dates
533of the appropriate type."
534 (if (< 0 number)
535 (let ((gdate original-date)
536 (mark (regexp-quote diary-nonmarking-symbol)))
537 (dotimes (idummy number)
538 (let* ((tdate (funcall absfunc
539 (calendar-absolute-from-gregorian gdate)))
540 (month (extract-calendar-month tdate))
541 (day (extract-calendar-day tdate))
542 (year (extract-calendar-year tdate))
543 backup)
544 (dolist (date-form diary-date-forms)
545 (if (setq backup (eq (car date-form) 'backup))
546 (setq date-form (cdr date-form)))
547 (let* ((dayname
548 (format "%s\\|%s\\.?"
549 (calendar-day-name gdate)
550 (calendar-day-name gdate 'abbrev)))
551 (calendar-month-name-array months)
552 (monthname
553 (format "\\*\\|%s" (calendar-month-name month)))
554 (month (format "\\*\\|0*%s" (int-to-string month)))
555 (day (format "\\*\\|0*%s" (int-to-string day)))
556 (year
557 (format "\\*\\|0*%s%s" (int-to-string year)
558 (if abbreviated-calendar-year
559 (format "\\|%s"
560 (int-to-string (% year 100)))
561 "")))
562 (regexp
563 (format "^%s?%s\\(%s\\)" mark (regexp-quote symbol)
564 (mapconcat 'eval date-form "\\)\\(")))
565 (case-fold-search t))
566 (goto-char (point-min))
567 (while (re-search-forward regexp nil t)
568 (if backup (re-search-backward "\\<" nil t))
569 (if (and (bolp) (not (looking-at "[ \t]")))
570 ;; Diary entry that consists only of date.
571 (backward-char 1)
572 ;; Found a nonempty diary entry--make it visible and
573 ;; add it to the list.
574 ;; Actual entry starts on the next-line?
575 (if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
576 (let ((entry-start (point))
577 ;; If bolp, must have done (forward-line 1).
578 (date-start (line-end-position (if (bolp) -1 0))))
579 (forward-line 1)
580 (while (looking-at "[ \t]") ; continued entry
581 (forward-line 1))
582 (unless (and (eobp) (not (bolp)))
583 (backward-char 1))
584 (remove-overlays date-start (point) 'invisible 'diary)
585 (add-to-diary-list
586 gdate
587 (buffer-substring-no-properties entry-start (point))
588 (buffer-substring-no-properties
589 (1+ date-start) (1- entry-start))
590 (copy-marker entry-start))))))))
591 (setq gdate
592 (calendar-gregorian-from-absolute
593 (1+ (calendar-absolute-from-gregorian gdate))))))
594 (goto-char (point-min))))
595
524(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) 596(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries)
525(defun diary-list-entries (date number &optional list-only) 597(defun diary-list-entries (date number &optional list-only)
526 "Create and display a buffer containing the relevant lines in `diary-file'. 598 "Create and display a buffer containing the relevant lines in `diary-file'.
527The arguments are DATE and NUMBER; the entries selected are those 599The arguments are DATE and NUMBER; the entries selected are those
528for NUMBER days starting with date DATE. The other entries are hidden 600for NUMBER days starting with date DATE. The other entries are hidden
529using selective display. If NUMBER is less than 1, this function does nothing. 601using overlays. If NUMBER is less than 1, this function does nothing.
530 602
531Returns a list of all relevant diary entries found, if any, in order by date. 603Returns a list of all relevant diary entries found, if any, in order by date.
532The list entries have the form ((MONTH DAY YEAR) STRING SPECIFIER) where 604The list entries have the form ((MONTH DAY YEAR) STRING SPECIFIER) where
533\(MONTH DAY YEAR) is the date of the entry, STRING is the entry text, and 605\(MONTH DAY YEAR) is the date of the entry, STRING is the entry text, and
534SPECIFIER is the applicability. If the variable `diary-list-include-blanks' 606SPECIFIER is the applicability. If the variable `diary-list-include-blanks'
535is t, this list includes a dummy diary entry consisting of the empty string 607is non-nil, this list includes a dummy diary entry consisting of the empty
536for a date with no diary entries. 608string for a date with no diary entries.
537 609
538After the list is prepared, the hooks `nongregorian-diary-listing-hook', 610After the list is prepared, the hooks `nongregorian-diary-listing-hook',
539`list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run. 611`list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run.
@@ -648,10 +720,11 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
648 (setq entry-found t) 720 (setq entry-found t)
649 (if (looking-at "[ \t]*\n[ \t]") (forward-line 1)) 721 (if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
650 (let ((entry-start (point)) 722 (let ((entry-start (point))
651 date-start temp) 723 (temp)
652 (setq date-start 724 (date-start
653 (line-end-position 725 (line-end-position
654 (if (and (bolp) (> number 1)) -1 0))) 726 ;; FIXME Why number > 1?
727 (if (and (bolp) (> number 1)) -1 0))))
655 (forward-line 1) 728 (forward-line 1)
656 (while (looking-at "[ \t]") 729 (while (looking-at "[ \t]")
657 (forward-line 1)) 730 (forward-line 1))
@@ -706,10 +779,7 @@ are obeyed. You can change the `#include' to some other string by
706changing the variable `diary-include-string'." 779changing the variable `diary-include-string'."
707 (goto-char (point-min)) 780 (goto-char (point-min))
708 (while (re-search-forward 781 (while (re-search-forward
709 (concat 782 (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
710 "^"
711 (regexp-quote diary-include-string)
712 " \"\\([^\"]*\\)\"")
713 nil t) 783 nil t)
714 (let ((diary-file (substitute-in-file-name 784 (let ((diary-file (substitute-in-file-name
715 (match-string-no-properties 1))) 785 (match-string-no-properties 1)))
@@ -753,7 +823,7 @@ changing the variable `diary-include-string'."
753 (calendar-set-mode-line (format "Diary for %s" hol-string)) 823 (calendar-set-mode-line (format "Diary for %s" hol-string))
754 (if (or (not diary-entries-list) 824 (if (or (not diary-entries-list)
755 (and (not (cdr diary-entries-list)) 825 (and (not (cdr diary-entries-list))
756 (string-equal (car (cdr (car diary-entries-list))) ""))) 826 (string-equal (cadr (car diary-entries-list)) "")))
757 (if (< (length msg) (frame-width)) 827 (if (< (length msg) (frame-width))
758 (message "%s" msg) 828 (message "%s" msg)
759 (set-buffer (get-buffer-create holiday-buffer)) 829 (set-buffer (get-buffer-create holiday-buffer))
@@ -787,7 +857,7 @@ changing the variable `diary-include-string'."
787 'face 'diary-button) 857 'face 'diary-button)
788 858
789(defun diary-goto-entry (button) 859(defun diary-goto-entry (button)
790 "Jump to the diary entry for the button at point." 860 "Jump to the diary entry for the BUTTON at point."
791 (let* ((locator (button-get button 'locator)) 861 (let* ((locator (button-get button 'locator))
792 (marker (car locator)) 862 (marker (car locator))
793 markbuf file) 863 markbuf file)
@@ -819,7 +889,7 @@ This function is provided for optional use as the `diary-display-hook'."
819 (diary-unhide-everything)) 889 (diary-unhide-everything))
820 (if (or (not diary-entries-list) 890 (if (or (not diary-entries-list)
821 (and (not (cdr diary-entries-list)) 891 (and (not (cdr diary-entries-list))
822 (string-equal (car (cdr (car diary-entries-list))) ""))) 892 (string-equal (cadr (car diary-entries-list)) "")))
823 (let* ((holiday-list (if holidays-in-diary-buffer 893 (let* ((holiday-list (if holidays-in-diary-buffer
824 (calendar-check-holidays original-date))) 894 (calendar-check-holidays original-date)))
825 (msg (format "No diary entries for %s %s" 895 (msg (format "No diary entries for %s %s"
@@ -846,49 +916,48 @@ This function is provided for optional use as the `diary-display-hook'."
846 (holiday-list-last-year 1) 916 (holiday-list-last-year 1)
847 (date (list 0 0 0))) 917 (date (list 0 0 0)))
848 (dolist (entry entry-list) 918 (dolist (entry entry-list)
849 (if (not (calendar-date-equal date (car entry))) 919 (unless (calendar-date-equal date (car entry))
850 (progn 920 (setq date (car entry))
851 (setq date (car entry)) 921 (and holidays-in-diary-buffer
852 (and holidays-in-diary-buffer 922 (calendar-date-compare
853 (calendar-date-compare 923 (list (list holiday-list-last-month
854 (list (list holiday-list-last-month 924 (calendar-last-day-of-month
855 (calendar-last-day-of-month 925 holiday-list-last-month
856 holiday-list-last-month 926 holiday-list-last-year)
857 holiday-list-last-year) 927 holiday-list-last-year))
858 holiday-list-last-year)) 928 (list date))
859 (list date)) 929 ;; We need to get the holidays for the next 3 months.
860 ;; We need to get the holidays for the next 3 months. 930 (setq holiday-list-last-month
861 (setq holiday-list-last-month 931 (extract-calendar-month date)
862 (extract-calendar-month date) 932 holiday-list-last-year
863 holiday-list-last-year 933 (extract-calendar-year date))
864 (extract-calendar-year date)) 934 (progn
865 (progn 935 (increment-calendar-month
866 (increment-calendar-month 936 holiday-list-last-month holiday-list-last-year 1)
867 holiday-list-last-month holiday-list-last-year 1) 937 t)
868 t) 938 (setq holiday-list
869 (setq holiday-list 939 (let ((displayed-month holiday-list-last-month)
870 (let ((displayed-month holiday-list-last-month) 940 (displayed-year holiday-list-last-year))
871 (displayed-year holiday-list-last-year)) 941 (calendar-holiday-list)))
872 (calendar-holiday-list))) 942 (increment-calendar-month
873 (increment-calendar-month 943 holiday-list-last-month holiday-list-last-year 1))
874 holiday-list-last-month holiday-list-last-year 1)) 944 (let (date-holiday-list)
875 (let (date-holiday-list) 945 ;; Make a list of all holidays for date.
876 ;; Make a list of all holidays for date. 946 (dolist (h holiday-list)
877 (dolist (h holiday-list) 947 (if (calendar-date-equal date (car h))
878 (if (calendar-date-equal date (car h)) 948 (setq date-holiday-list (append date-holiday-list
879 (setq date-holiday-list (append date-holiday-list 949 (cdr h)))))
880 (cdr h))))) 950 (insert (if (bobp) "" ?\n) (calendar-date-string date))
881 (insert (if (bobp) "" ?\n) (calendar-date-string date)) 951 (if date-holiday-list (insert ": "))
882 (if date-holiday-list (insert ": ")) 952 (let ((l (current-column))
883 (let ((l (current-column)) 953 (longest 0))
884 (longest 0)) 954 (insert (mapconcat (lambda (x)
885 (insert (mapconcat (lambda (x) 955 (if (< longest (length x))
886 (if (< longest (length x)) 956 (setq longest (length x)))
887 (setq longest (length x))) 957 x)
888 x) 958 date-holiday-list
889 date-holiday-list 959 (concat "\n" (make-string l ? ))))
890 (concat "\n" (make-string l ? )))) 960 (insert ?\n (make-string (+ l longest) ?=) ?\n))))
891 (insert ?\n (make-string (+ l longest) ?=) ?\n)))))
892 (let ((this-entry (cadr entry)) 961 (let ((this-entry (cadr entry))
893 this-loc) 962 this-loc)
894 (unless (zerop (length this-entry)) 963 (unless (zerop (length this-entry))
@@ -1073,6 +1142,95 @@ argument PAREN is non-nil, the regexp is surrounded by parentheses."
1073(defvar marking-diary-entry nil 1142(defvar marking-diary-entry nil
1074 "True during the marking of diary entries, if current entry is marking.") 1143 "True during the marking of diary entries, if current entry is marking.")
1075 1144
1145;; FIXME use for mark-diary-entries.
1146(defun diary-mark-entries-1 (months symbol absfunc markfunc)
1147 "Mark diary entries of a certain type.
1148MONTHS is an array of month names. SYMBOL marks diary entries of the type
1149in question. ABSFUNC is a function that converts absolute dates to dates
1150of the appropriate type. MARKFUNC is a function that marks entries
1151of the appropriate type matching a given date pattern."
1152 (let ((dayname (diary-name-pattern calendar-day-name-array
1153 calendar-day-abbrev-array))
1154 (monthname (format "%s\\|\\*" (diary-name-pattern months)))
1155 (month "[0-9]+\\|\\*")
1156 (day "[0-9]+\\|\\*")
1157 (year "[0-9]+\\|\\*")
1158 (case-fold-search t))
1159 (dolist (date-form diary-date-forms)
1160 (if (eq (car date-form) 'backup) ; ignore 'backup directive
1161 (setq date-form (cdr date-form)))
1162 (let* ((l (length date-form))
1163 (d-name-pos (- l (length (memq 'dayname date-form))))
1164 (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
1165 (m-name-pos (- l (length (memq 'monthname date-form))))
1166 (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
1167 (d-pos (- l (length (memq 'day date-form))))
1168 (d-pos (if (/= l d-pos) (+ 2 d-pos)))
1169 (m-pos (- l (length (memq 'month date-form))))
1170 (m-pos (if (/= l m-pos) (+ 2 m-pos)))
1171 (y-pos (- l (length (memq 'year date-form))))
1172 (y-pos (if (/= l y-pos) (+ 2 y-pos)))
1173 (regexp (format "^%s\\(%s\\)" (regexp-quote symbol)
1174 (mapconcat 'eval date-form "\\)\\("))))
1175 (goto-char (point-min))
1176 (while (re-search-forward regexp nil t)
1177 (let* ((dd-name
1178 (if d-name-pos
1179 (buffer-substring
1180 (match-beginning d-name-pos)
1181 (match-end d-name-pos))))
1182 (mm-name
1183 (if m-name-pos
1184 (buffer-substring
1185 (match-beginning m-name-pos)
1186 (match-end m-name-pos))))
1187 (mm (string-to-number
1188 (if m-pos
1189 (buffer-substring
1190 (match-beginning m-pos)
1191 (match-end m-pos))
1192 "")))
1193 (dd (string-to-number
1194 (if d-pos
1195 (buffer-substring
1196 (match-beginning d-pos)
1197 (match-end d-pos))
1198 "")))
1199 (y-str (if y-pos
1200 (buffer-substring
1201 (match-beginning y-pos)
1202 (match-end y-pos))))
1203 (yy (if (not y-str)
1204 0
1205 (if (and (= (length y-str) 2)
1206 abbreviated-calendar-year)
1207 (let* ((current-y
1208 (extract-calendar-year
1209 (funcall absfunc
1210 (calendar-absolute-from-gregorian
1211 (calendar-current-date)))))
1212 (y (+ (string-to-number y-str)
1213 (* 100 (/ current-y 100)))))
1214 (if (> (- y current-y) 50)
1215 (- y 100)
1216 (if (> (- current-y y) 50)
1217 (+ y 100)
1218 y)))
1219 (string-to-number y-str)))))
1220 (if dd-name
1221 (mark-calendar-days-named
1222 (cdr (assoc-string dd-name
1223 (calendar-make-alist
1224 calendar-day-name-array
1225 0 nil calendar-day-abbrev-array) t)))
1226 (if mm-name
1227 (setq mm
1228 (if (string-equal mm-name "*") 0
1229 (cdr (assoc-string
1230 mm-name
1231 (calendar-make-alist months) t)))))
1232 (funcall markfunc mm dd yy))))))))
1233
1076;;;###cal-autoload 1234;;;###cal-autoload
1077(defun mark-diary-entries (&optional redraw) 1235(defun mark-diary-entries (&optional redraw)
1078 "Mark days in the calendar window that have diary entries. 1236 "Mark days in the calendar window that have diary entries.
@@ -1117,15 +1275,15 @@ diary entries."
1117 (setq date-form (cdr date-form))) ; ignore 'backup directive 1275 (setq date-form (cdr date-form))) ; ignore 'backup directive
1118 (let* ((l (length date-form)) 1276 (let* ((l (length date-form))
1119 (d-name-pos (- l (length (memq 'dayname date-form)))) 1277 (d-name-pos (- l (length (memq 'dayname date-form))))
1120 (d-name-pos (if (/= l d-name-pos) (+ 1 d-name-pos))) 1278 (d-name-pos (if (/= l d-name-pos) (1+ d-name-pos)))
1121 (m-name-pos (- l (length (memq 'monthname date-form)))) 1279 (m-name-pos (- l (length (memq 'monthname date-form))))
1122 (m-name-pos (if (/= l m-name-pos) (+ 1 m-name-pos))) 1280 (m-name-pos (if (/= l m-name-pos) (1+ m-name-pos)))
1123 (d-pos (- l (length (memq 'day date-form)))) 1281 (d-pos (- l (length (memq 'day date-form))))
1124 (d-pos (if (/= l d-pos) (+ 1 d-pos))) 1282 (d-pos (if (/= l d-pos) (1+ d-pos)))
1125 (m-pos (- l (length (memq 'month date-form)))) 1283 (m-pos (- l (length (memq 'month date-form))))
1126 (m-pos (if (/= l m-pos) (+ 1 m-pos))) 1284 (m-pos (if (/= l m-pos) (1+ m-pos)))
1127 (y-pos (- l (length (memq 'year date-form)))) 1285 (y-pos (- l (length (memq 'year date-form))))
1128 (y-pos (if (/= l y-pos) (+ 1 y-pos))) 1286 (y-pos (if (/= l y-pos) (1+ y-pos)))
1129 (regexp 1287 (regexp
1130 (concat 1288 (concat
1131 "^\\(" 1289 "^\\("
@@ -1238,21 +1396,22 @@ is marked. See the documentation for the function `list-sexp-diary-entries'."
1238 (if (bolp) (backward-char 1)) 1396 (if (bolp) (backward-char 1))
1239 (setq entry (buffer-substring-no-properties entry-start (point)))) 1397 (setq entry (buffer-substring-no-properties entry-start (point))))
1240 (calendar-for-loop date from first-date to last-date do 1398 (calendar-for-loop date from first-date to last-date do
1241 (if (setq mark 1399 (when (setq mark
1242 (diary-sexp-entry sexp entry 1400 (diary-sexp-entry
1243 (calendar-gregorian-from-absolute date))) 1401 sexp entry
1244 (progn 1402 (calendar-gregorian-from-absolute
1245 ;; FIXME what? 1403 date)))
1246 (setq marks (diary-pull-attrs 1404 ;; FIXME does this make sense?
1247 entry file-glob-attrs) 1405 (setq marks (diary-pull-attrs
1248 marks (nth 1 (diary-pull-attrs 1406 entry file-glob-attrs)
1249 entry file-glob-attrs))) 1407 marks (nth 1 (diary-pull-attrs
1250 (mark-visible-calendar-date 1408 entry file-glob-attrs)))
1251 (calendar-gregorian-from-absolute date) 1409 (mark-visible-calendar-date
1252 (if (< 0 (length marks)) 1410 (calendar-gregorian-from-absolute date)
1253 marks 1411 (if (< 0 (length marks))
1254 (if (consp mark) 1412 marks
1255 (car mark))))))))))) 1413 (if (consp mark)
1414 (car mark))))))))))
1256 1415
1257(defun mark-included-diary-files () 1416(defun mark-included-diary-files ()
1258 "Mark the diary entries from other diary files with those of the diary file. 1417 "Mark the diary entries from other diary files with those of the diary file.
@@ -1265,10 +1424,7 @@ are obeyed. You can change the `#include' to some other string by
1265changing the variable `diary-include-string'." 1424changing the variable `diary-include-string'."
1266 (goto-char (point-min)) 1425 (goto-char (point-min))
1267 (while (re-search-forward 1426 (while (re-search-forward
1268 (concat 1427 (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
1269 "^"
1270 (regexp-quote diary-include-string)
1271 " \"\\([^\"]*\\)\"")
1272 nil t) 1428 nil t)
1273 (let* ((diary-file (substitute-in-file-name 1429 (let* ((diary-file (substitute-in-file-name
1274 (match-string-no-properties 1))) 1430 (match-string-no-properties 1)))
@@ -1331,9 +1487,8 @@ Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
1331 (and (zerop p-month) 1487 (and (zerop p-month)
1332 (or (zerop p-year) (= year p-year)))) 1488 (or (zerop p-year) (= year p-year))))
1333 (if (zerop p-day) 1489 (if (zerop p-day)
1334 (calendar-for-loop 1490 (dotimes (i (calendar-last-day-of-month month year))
1335 i from 1 to (calendar-last-day-of-month month year) do 1491 (mark-visible-calendar-date (list month (1+ i) year) color))
1336 (mark-visible-calendar-date (list month i year) color))
1337 (mark-visible-calendar-date (list month p-day year) color)))) 1492 (mark-visible-calendar-date (list month p-day year) color))))
1338 1493
1339(defun sort-diary-entries () 1494(defun sort-diary-entries ()
@@ -1406,12 +1561,11 @@ A number of built-in functions are available for this type of diary entry:
1406 1561
1407 %%(diary-date MONTH DAY YEAR &optional MARK) text 1562 %%(diary-date MONTH DAY YEAR &optional MARK) text
1408 Entry applies if date is MONTH, DAY, YEAR if 1563 Entry applies if date is MONTH, DAY, YEAR if
1409 `european-calendar-style' is nil, and DAY, MONTH, YEAR if 1564 `european-calendar-style' is nil (otherwise DAY, MONTH,
1410 `european-calendar-style' is t. DAY, MONTH, and YEAR 1565 YEAR). DAY, MONTH, and YEAR can be lists of integers,
1411 can be lists of integers, the constant t, or an integer. 1566 `t' (meaning all values), or an integer. An optional
1412 The constant t means all values. An optional parameter 1567 parameter MARK specifies a face or single-character string
1413 MARK specifies a face or single-character string to use 1568 to use when highlighting the day in the calendar.
1414 when highlighting the day in the calendar.
1415 1569
1416 %%(diary-float MONTH DAYNAME N &optional DAY MARK) text 1570 %%(diary-float MONTH DAYNAME N &optional DAY MARK) text
1417 Entry will appear on the Nth DAYNAME of MONTH. 1571 Entry will appear on the Nth DAYNAME of MONTH.
@@ -1426,7 +1580,7 @@ A number of built-in functions are available for this type of diary entry:
1426 1580
1427 %%(diary-block M1 D1 Y1 M2 D2 Y2 &optional MARK) text 1581 %%(diary-block M1 D1 Y1 M2 D2 Y2 &optional MARK) text
1428 Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2, 1582 Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
1429 inclusive. (If `european-calendar-style' is t, the 1583 inclusive. (If `european-calendar-style' is non-nil, the
1430 order of the parameters should be changed to D1, M1, Y1, 1584 order of the parameters should be changed to D1, M1, Y1,
1431 D2, M2, Y2.) An optional parameter MARK specifies a face 1585 D2, M2, Y2.) An optional parameter MARK specifies a face
1432 or single-character string to use when highlighting the 1586 or single-character string to use when highlighting the
@@ -1434,7 +1588,7 @@ A number of built-in functions are available for this type of diary entry:
1434 1588
1435 %%(diary-anniversary MONTH DAY YEAR &optional MARK) text 1589 %%(diary-anniversary MONTH DAY YEAR &optional MARK) text
1436 Entry will appear on anniversary dates of MONTH DAY, YEAR. 1590 Entry will appear on anniversary dates of MONTH DAY, YEAR.
1437 (If `european-calendar-style' is t, the order of the 1591 (If `european-calendar-style' is non-nil, the order of the
1438 parameters should be changed to DAY, MONTH, YEAR.) Text 1592 parameters should be changed to DAY, MONTH, YEAR.) Text
1439 can contain %d or %d%s; %d will be replaced by the number 1593 can contain %d or %d%s; %d will be replaced by the number
1440 of years since the MONTH DAY, YEAR and %s will be replaced 1594 of years since the MONTH DAY, YEAR and %s will be replaced
@@ -1446,7 +1600,7 @@ A number of built-in functions are available for this type of diary entry:
1446 1600
1447 %%(diary-cyclic N MONTH DAY YEAR &optional MARK) text 1601 %%(diary-cyclic N MONTH DAY YEAR &optional MARK) text
1448 Entry will appear every N days, starting MONTH DAY, YEAR. 1602 Entry will appear every N days, starting MONTH DAY, YEAR.
1449 (If `european-calendar-style' is t, the order of the 1603 (If `european-calendar-style' is non-nil, the order of the
1450 parameters should be changed to N, DAY, MONTH, YEAR.) Text 1604 parameters should be changed to N, DAY, MONTH, YEAR.) Text
1451 can contain %d or %d%s; %d will be replaced by the number 1605 can contain %d or %d%s; %d will be replaced by the number
1452 of repetitions since the MONTH DAY, YEAR and %s will 1606 of repetitions since the MONTH DAY, YEAR and %s will
@@ -1520,8 +1674,8 @@ A number of built-in functions are available for this type of diary entry:
1520 Text is assumed to be the name of the person; the date is 1674 Text is assumed to be the name of the person; the date is
1521 the date of death on the *civil* calendar. The diary entry 1675 the date of death on the *civil* calendar. The diary entry
1522 will appear on the proper Hebrew-date anniversary and on the 1676 will appear on the proper Hebrew-date anniversary and on the
1523 day before. (If `european-calendar-style' is t, the order 1677 day before. (If `european-calendar-style' is non-nil, the
1524 of the parameters should be changed to DAY, MONTH, YEAR.) 1678 parameter order should be changed to DAY, MONTH, YEAR.)
1525 1679
1526 %%(diary-rosh-hodesh) 1680 %%(diary-rosh-hodesh)
1527 Diary entries will be made on the dates of Rosh Hodesh on 1681 Diary entries will be made on the dates of Rosh Hodesh on
@@ -1577,18 +1731,16 @@ best if they are nonmarking."
1577 entry (if (consp diary-entry) 1731 entry (if (consp diary-entry)
1578 (cdr diary-entry) 1732 (cdr diary-entry)
1579 diary-entry)) 1733 diary-entry))
1580 (if diary-entry 1734 (when diary-entry
1581 (progn 1735 (remove-overlays line-start (point) 'invisible 'diary)
1582 (remove-overlays line-start (point) 'invisible 'diary) 1736 (if (< 0 (length entry))
1583 (if (< 0 (length entry)) 1737 (setq temp (diary-pull-attrs entry file-glob-attrs)
1584 (setq temp (diary-pull-attrs entry file-glob-attrs) 1738 entry (nth 0 temp)
1585 entry (nth 0 temp) 1739 marks (nth 1 temp))))
1586 marks (nth 1 temp)))))
1587 (add-to-diary-list date 1740 (add-to-diary-list date
1588 entry 1741 entry
1589 specifier 1742 specifier
1590 (if entry-start (copy-marker entry-start) 1743 (if entry-start (copy-marker entry-start))
1591 nil)
1592 marks 1744 marks
1593 literal) 1745 literal)
1594 (setq entry-found (or entry-found diary-entry))))) 1746 (setq entry-found (or entry-found diary-entry)))))
@@ -1620,9 +1772,8 @@ best if they are nonmarking."
1620(defun diary-date (month day year &optional mark) 1772(defun diary-date (month day year &optional mark)
1621 "Specific date(s) diary entry. 1773 "Specific date(s) diary entry.
1622Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil, 1774Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil,
1623and DAY, MONTH, YEAR if `european-calendar-style' is t. DAY, MONTH, and YEAR 1775and DAY, MONTH, YEAR otherwise. DAY, MONTH, and YEAR can be lists of
1624can be lists of integers, the constant t, or an integer. The constant t means 1776integers, `t' (meaning all values), or an integer.
1625all values.
1626 1777
1627An optional parameter MARK specifies a face or single-character string to 1778An optional parameter MARK specifies a face or single-character string to
1628use when highlighting the day in the calendar." 1779use when highlighting the day in the calendar."
@@ -1651,9 +1802,8 @@ use when highlighting the day in the calendar."
1651(defun diary-block (m1 d1 y1 m2 d2 y2 &optional mark) 1802(defun diary-block (m1 d1 y1 m2 d2 y2 &optional mark)
1652 "Block diary entry. 1803 "Block diary entry.
1653Entry applies if date is between, or on one of, two dates. 1804Entry applies if date is between, or on one of, two dates.
1654The order of the parameters is 1805The order of the parameters is M1, D1, Y1, M2, D2, Y2 if
1655M1, D1, Y1, M2, D2, Y2 if `european-calendar-style' is nil, and 1806`european-calendar-style' is nil, and D1, M1, Y1, D2, M2, Y2 otherwise.
1656D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t.
1657 1807
1658An optional parameter MARK specifies a face or single-character string to 1808An optional parameter MARK specifies a face or single-character string to
1659use when highlighting the day in the calendar." 1809use when highlighting the day in the calendar."
@@ -1673,9 +1823,9 @@ use when highlighting the day in the calendar."
1673;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. 1823;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
1674(defun diary-float (month dayname n &optional day mark) 1824(defun diary-float (month dayname n &optional day mark)
1675 "Floating diary entry--entry applies if date is the nth dayname of month. 1825 "Floating diary entry--entry applies if date is the nth dayname of month.
1676Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, the constant 1826Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, an integer,
1677t, or an integer. The constant t means all months. If N is negative, count 1827or `t' (meaning all months). If N is negative, count backward from the end
1678backward from the end of the month. 1828of the month.
1679 1829
1680An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY. 1830An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY.
1681Optional MARK specifies a face or single-character string to use when 1831Optional MARK specifies a face or single-character string to use when
@@ -1740,12 +1890,12 @@ highlighting the day in the calendar."
1740(defun diary-anniversary (month day &optional year mark) 1890(defun diary-anniversary (month day &optional year mark)
1741 "Anniversary diary entry. 1891 "Anniversary diary entry.
1742Entry applies if date is the anniversary of MONTH, DAY, YEAR if 1892Entry applies if date is the anniversary of MONTH, DAY, YEAR if
1743`european-calendar-style' is nil, and DAY, MONTH, YEAR if 1893`european-calendar-style' is nil, and DAY, MONTH, YEAR otherwise. The
1744`european-calendar-style' is t. Diary entry can contain `%d' or `%d%s'; the 1894diary entry can contain `%d' or `%d%s'; the %d will be replaced by the
1745%d will be replaced by the number of years since the MONTH DAY, YEAR and the 1895number of years since the MONTH DAY, YEAR and the %s will be replaced by
1746%s will be replaced by the ordinal ending of that number (that is, `st', `nd', 1896the ordinal ending of that number (that is, `st', `nd', `rd' or `th', as
1747`rd' or `th', as appropriate. The anniversary of February 29 is considered 1897appropriate. The anniversary of February 29 is considered to be March 1
1748to be March 1 in non-leap years. 1898in non-leap years.
1749 1899
1750An optional parameter MARK specifies a face or single-character string to 1900An optional parameter MARK specifies a face or single-character string to
1751use when highlighting the day in the calendar." 1901use when highlighting the day in the calendar."
@@ -1766,7 +1916,7 @@ use when highlighting the day in the calendar."
1766;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. 1916;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
1767(defun diary-cyclic (n month day year &optional mark) 1917(defun diary-cyclic (n month day year &optional mark)
1768 "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR. 1918 "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
1769If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR. 1919If `european-calendar-style' is non-nil, parameters are N, DAY, MONTH, YEAR.
1770ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of 1920ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of
1771repetitions since the MONTH DAY, YEAR and %s will be replaced by the 1921repetitions since the MONTH DAY, YEAR and %s will be replaced by the
1772ordinal ending of that number (that is, `st', `nd', `rd' or `th', as 1922ordinal ending of that number (that is, `st', `nd', `rd' or `th', as
@@ -2034,7 +2184,8 @@ Prefix argument ARG makes the entry nonmarking."
2034;; multiline pattern, extend the region to encompass the whole pattern. 2184;; multiline pattern, extend the region to encompass the whole pattern.
2035(defun diary-fancy-font-lock-fontify-region-function (beg end &optional verbose) 2185(defun diary-fancy-font-lock-fontify-region-function (beg end &optional verbose)
2036 "Function to use for `font-lock-fontify-region-function' in Fancy Diary. 2186 "Function to use for `font-lock-fontify-region-function' in Fancy Diary.
2037Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'." 2187Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'.
2188Fontify the region between BEG and END, quietly unless VERBOSE is non-nil."
2038 (goto-char beg) 2189 (goto-char beg)
2039 (forward-line 0) 2190 (forward-line 0)
2040 (if (looking-at "=+$") (forward-line -1)) 2191 (if (looking-at "=+$") (forward-line -1))
@@ -2176,8 +2327,7 @@ names."
2176;; message formats recognized are customizable through 2327;; message formats recognized are customizable through
2177;; `diary-outlook-formats'. 2328;; `diary-outlook-formats'.
2178 2329
2179;; Dynamically bound. 2330(defvar subject) ; bound in diary-from-outlook-gnus
2180(defvar subject)
2181 2331
2182(defun diary-from-outlook-internal (&optional test-only) 2332(defun diary-from-outlook-internal (&optional test-only)
2183 "Snarf a diary entry from a message assumed to be from MS Outlook. 2333 "Snarf a diary entry from a message assumed to be from MS Outlook.