X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/45380d4259f266d79674c1586e7ff09a167c0b02..f0a51f2a94e9010ed827c7dfe8c337403e7d0fd9:/lisp/calendar/diary-lib.el diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 95588fccd9..c09bbc4360 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1,7 +1,7 @@ ;;; diary-lib.el --- diary functions ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003, -;; 2004, 2005, 2006 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Maintainer: Glenn Morris @@ -11,7 +11,7 @@ ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -29,16 +29,243 @@ ;; This collection of functions implements the diary features as described ;; in calendar.el. -;; Comments, corrections, and improvements should be sent to -;; Edward M. Reingold Department of Computer Science -;; (217) 333-6733 University of Illinois at Urbana-Champaign -;; reingold@cs.uiuc.edu 1304 West Springfield Avenue -;; Urbana, Illinois 61801 - ;;; Code: (require 'calendar) +(defcustom diary-include-string "#include" + "The string indicating inclusion of another file of diary entries. +See the documentation for the function `include-other-diary-files'." + :type 'string + :group 'diary) + +(defcustom diary-list-include-blanks nil + "If nil, do not include days with no diary entry in the list of diary entries. +Such days will then not be shown in the fancy diary buffer, even if they +are holidays." + :type 'boolean + :group 'diary) + +(defcustom diary-glob-file-regexp-prefix "^\\#" + "Regular expression prepended to attribute-regexps for file-wide specifiers." + :type 'regexp + :group 'diary) + +(defcustom diary-face 'diary + "Face name to use for diary entries." + :type 'face + :group 'diary) +(make-obsolete-variable 'diary-face "customize the face `diary' instead." + "23.1") + +(defcustom diary-face-attrs + '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string) + (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string) + (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol) + (" *\\[height:\\([-0-9a-z]+\\)\\]$" 1 :height int) + (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol) + (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol) + (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil) + (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil) + (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil) + (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil) + (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string) + (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string) + ;; Unsupported. +;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box) +;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple) + ) + "A list of (regexp regnum attr attrtype) lists where the +regexp says how to find the tag, the regnum says which +parenthetical sub-regexp this regexp looks for, and the attr says +which attribute of the face (or that this _is_ a face) is being +modified." + :type 'sexp + :group 'diary) + +(defcustom diary-file-name-prefix nil + "Non-nil means prefix each diary entry with the name of the file defining it." + :type 'boolean + :group 'diary) + +(defcustom diary-file-name-prefix-function 'identity + "The function that will take a diary file name and return the desired prefix." + :type 'function + :group 'diary) + +(defcustom sexp-diary-entry-symbol "%%" + "The string used to indicate a sexp diary entry in `diary-file'. +See the documentation for the function `list-sexp-diary-entries'." + :type 'string + :group 'diary) + +(defcustom list-diary-entries-hook nil + "List of functions called after diary file is culled for relevant entries. +It is to be used for diary entries that are not found in the diary file. + +A function `include-other-diary-files' is provided for use as the value of +this hook. This function enables you to use shared diary files together +with your own. The files included are specified in the diary file by lines +of the form + + #include \"filename\" + +This is recursive; that is, #include directives in files thus included are +obeyed. You can change the \"#include\" to some other string by changing +the variable `diary-include-string'. When you use `include-other-diary-files' +as part of the list-diary-entries-hook, you will probably also want to use the +function `mark-included-diary-files' as part of `mark-diary-entries-hook'. + +For example, you could use + + (add-hook 'list-diary-entries-hook 'include-other-diary-files) + (add-hook 'list-diary-entries-hook 'sort-diary-entries) + (add-hook 'diary-display-hook 'fancy-diary-display) + +in your `.emacs' file to cause the fancy diary buffer to be displayed with +diary entries from various included files, each day's entries sorted into +lexicographic order." + :type 'hook + :options '(include-other-diary-files sort-diary-entries) + :group 'diary) + +(defcustom mark-diary-entries-hook nil + "List of functions called after marking diary entries in the calendar. + +A function `mark-included-diary-files' is also provided for use as the +`mark-diary-entries-hook'; it enables you to use shared diary files together +with your own. The files included are specified in the diary file by lines +of the form + #include \"filename\" +This is recursive; that is, #include directives in files thus included are +obeyed. You can change the \"#include\" to some other string by changing the +variable `diary-include-string'. When you use `mark-included-diary-files' as +part of the mark-diary-entries-hook, you will probably also want to use the +function `include-other-diary-files' as part of `list-diary-entries-hook'." + :type 'hook + :options '(mark-included-diary-files) + :group 'diary) + +(defcustom nongregorian-diary-listing-hook nil + "List of functions called for listing diary file and included files. +As the files are processed for diary entries, these functions are used +to cull relevant entries. You can use either or both of +`list-hebrew-diary-entries', `list-islamic-diary-entries' and +`diary-bahai-list-entries'. The documentation for these functions +describes the style of such diary entries." + :type 'hook + :options '(list-hebrew-diary-entries + list-islamic-diary-entries + diary-bahai-list-entries) + :group 'diary) + +(defcustom nongregorian-diary-marking-hook nil + "List of functions called for marking diary file and included files. +As the files are processed for diary entries, these functions are used +to cull relevant entries. You can use either or both of +`mark-hebrew-diary-entries', `mark-islamic-diary-entries' and +`mark-bahai-diary-entries'. The documentation for these functions +describes the style of such diary entries." + :type 'hook + :options '(mark-hebrew-diary-entries + mark-islamic-diary-entries + diary-bahai-mark-entries) + :group 'diary) + +(defcustom print-diary-entries-hook 'lpr-buffer + "List of functions called after a temporary diary buffer is prepared. +The buffer shows only the diary entries currently visible in the diary +buffer. The default just does the printing. Other uses might include, for +example, rearranging the lines into order by day and time, saving the buffer +instead of deleting it, or changing the function used to do the printing." + :type 'hook + :group 'diary) + +(defcustom diary-unknown-time -9999 + "Value returned by diary-entry-time when no time is found. +The default value -9999 causes entries with no recognizable time to be placed +before those with times; 9999 would place entries with no recognizable time +after those with times." + :type 'integer + :group 'diary + :version "20.3") + +(defcustom diary-mail-addr + (if (boundp 'user-mail-address) user-mail-address "") + "Email address that `diary-mail-entries' will send email to." + :group 'diary + :type 'string + :version "20.3") + +(defcustom diary-mail-days 7 + "Default number of days for `diary-mail-entries' to check." + :group 'diary + :type 'integer + :version "20.3") + +(defcustom diary-remind-message + '("Reminder: Only " + (if (= 0 (% days 7)) + (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks")) + (concat (int-to-string days) (if (= 1 days) " day" " days"))) + " until " + diary-entry) + "Pseudo-pattern giving form of reminder messages in the fancy diary display. + +Used by the function `diary-remind', a pseudo-pattern is a list of +expressions that can involve the keywords `days' (a number), `date' (a list of +month, day, year), and `diary-entry' (a string)." + :type 'sexp + :group 'diary) + +(defcustom diary-outlook-formats + '( + ;; When: 11 October 2001 12:00-14:00 (GMT) Greenwich Mean Time : Dublin, ... + ;; [Current UK format? The timezone is meaningless. Sometimes the + ;; Where is missing.] + ("When: \\([0-9]+ [[:alpha:]]+ [0-9]+\\) \ +\\([^ ]+\\) [^\n]+ +\[^\n]+ +\\(?:Where: \\([^\n]+\\)\n+\\)? +\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*" + . "\\1\n \\2 %s, \\3") + ;; When: Tuesday, April 30, 2002 03:00 PM-03:30 PM (GMT) Greenwich Mean ... + ;; [Old UK format?] + ("^When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \\([0-9]\\{4\\}\\) \ +\\([^ ]+\\) [^\n]+ +\[^\n]+ +\\(?:Where: \\([^\n]+\\)\\)?\n+" + . "\\2 \\1 \\3\n \\4 %s, \\5") + ( + ;; German format, apparently. + "^Zeit: [^ ]+, +\\([0-9]+\\)\. +\\([[:upper:]][[:lower:]][[:lower:]]\\)[^ ]* +\\([0-9]+\\) +\\([^ ]+\\).*$" + . "\\1 \\2 \\3\n \\4 %s")) + "Alist of regexps matching message text and replacement text. + +The regexp must match the start of the message text containing an +appointment, but need not include a leading `^'. If it matches the +current message, a diary entry is made from the corresponding +template. If the template is a string, it should be suitable for +passing to `replace-match', and so will have occurrences of `\\D' to +substitute the match for the Dth subexpression. It must also contain +a single `%s' which will be replaced with the text of the message's +Subject field. Any other `%' characters must be doubled, so that the +template can be passed to `format'. + +If the template is actually a function, it is called with the message +body text as argument, and may use `match-string' etc. to make a +template following the rules above." + :type '(alist :key-type (regexp :tag "Regexp matching time/place") + :value-type (choice + (string :tag "Template for entry") + (function :tag + "Unary function providing template"))) + :version "22.1" + :group 'diary) + +;;; More user options below and in calendar.el. + + (defun diary-check-diary-file () "Check that the file specified by `diary-file' exists and is readable. If so, return the expanded file name, otherwise signal an error." @@ -81,7 +308,7 @@ D-FILE specifies the file to use as the diary file." (let ((diary-file d-file)) (diary-view-entries arg))) -(autoload 'check-calendar-holidays "holidays" +(autoload 'calendar-check-holidays "holidays" "Check the list of holidays for any that occur on DATE. The value returned is a list of strings of relevant holiday descriptions. The holidays are those in the list `calendar-holidays'.") @@ -123,13 +350,13 @@ The holidays are those in the list `calendar-holidays'.") (autoload 'diary-bahai-date "cal-bahai" "Baha'i calendar equivalent of date diary entry.") -(autoload 'list-bahai-diary-entries "cal-bahai" +(autoload 'diary-bahai-list-entries "cal-bahai" "Add any Baha'i date entries from the diary file to `diary-entries-list'.") -(autoload 'mark-bahai-diary-entries "cal-bahai" +(autoload 'diary-bahai-mark-entries "cal-bahai" "Mark days in the calendar window that have Baha'i date diary entries.") -(autoload 'mark-bahai-calendar-date-pattern "cal-bahai" +(autoload 'calendar-bahai-mark-date-pattern "cal-bahai" "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR.") (autoload 'diary-hebrew-date "cal-hebrew" @@ -186,7 +413,6 @@ syntax of `*' and `:' changed to be word constituents.") (defvar diary-entries-list) (defvar displayed-year) (defvar displayed-month) -(defvar entry) (defvar date) (defvar number) (defvar date-string) @@ -263,14 +489,27 @@ search." (setq attr-list (cdr attr-list))))) (list entry ret-attr)))) +(defun diary-set-maybe-redraw (symbol value) + "Set SYMBOL's value to VALUE, and redraw the diary if necessary. +Redraws the diary if it is being displayed (note this is not the same as +just visiting the `diary-file'), and SYMBOL's value is to be changed." + (let ((oldvalue (eval symbol))) + (custom-set-default symbol value) + (and (not (equal value oldvalue)) + (diary-live-p) + ;; Note this assumes diary was called without prefix arg. + (diary)))) ;; This can be removed once the kill/yank treatment of invisible text ;; (see etc/TODO) is fixed. -- gm (defcustom diary-header-line-flag t - "If non-nil, `diary-simple-display' will show a header line. + "If non-nil, `simple-diary-display' will show a header line. The format of the header is specified by `diary-header-line-format'." :group 'diary :type 'boolean + :initialize 'custom-initialize-default + ;; FIXME overkill. + :set 'diary-set-maybe-redraw :version "22.1") (defvar diary-selective-display nil) @@ -282,14 +521,33 @@ The format of the header is specified by `diary-header-line-format'." before edit/copy" "Diary")) ?\s (frame-width))) - "Format of the header line displayed by `diary-simple-display'. + "Format of the header line displayed by `simple-diary-display'. Only used if `diary-header-line-flag' is non-nil." :group 'diary :type 'sexp + :initialize 'custom-initialize-default + ;; FIXME overkill. + :set 'diary-set-maybe-redraw :version "22.1") (defvar diary-saved-point) ; internal +;; The first version of this also checked for diary-selective-display +;; in the non-fancy case. This was an attempt to distinguish between +;; displaying the diary and just visiting the diary file. However, +;; when using fancy diary, calling diary when there are no entries to +;; display does not create the fancy buffer, nor does it switch on +;; selective-display in the diary buffer. This means some +;; customizations will not take effect, eg: +;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00466.html +;; So the check for selective-display was dropped. This means the +;; diary will be displayed if one customizes a diary variable while +;; just visiting the diary-file. This is i) unlikely, and ii) no great loss. +(defun diary-live-p () + "Return non-nil if the diary is being displayed." + (or (get-buffer fancy-diary-buffer) + (and diary-file + (find-buffer-visiting (substitute-in-file-name diary-file))))) (defcustom number-of-diary-entries 1 "Specifies how many days of diary entries are to be displayed initially. @@ -300,10 +558,10 @@ entries will be displayed. If the value 2 is used, then both the current day's and the next day's entries will be displayed. The value can also be a vector such as [0 2 2 2 2 4 1]; this value -says to display no diary entries on Sunday, the display the entries -for the current date and the day after on Monday through Thursday, -display Friday through Monday's entries on Friday, and display only -Saturday's entries on Saturday. +says to display no diary entries on Sunday, the entries for +the current date and the day after on Monday through Thursday, +Friday through Monday's entries on Friday, and only Saturday's +entries on Saturday. This variable does not affect the diary display with the `d' command from the calendar; in that case, the prefix argument controls the @@ -317,6 +575,8 @@ number of days of diary entries displayed." (integer :tag "Thursday") (integer :tag "Friday") (integer :tag "Saturday"))) + :initialize 'custom-initialize-default + :set 'diary-set-maybe-redraw :group 'diary) @@ -410,7 +670,17 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." (or (verify-visited-file-modtime diary-buffer) (revert-buffer t t)))) ;; Setup things like the header-line-format and invisibility-spec. - (when (eq major-mode default-major-mode) (diary-mode)) + (if (eq major-mode default-major-mode) + (diary-mode) + ;; This kludge is to make customizations to + ;; diary-header-line-flag after diary has been displayed + ;; take effect. Unconditionally calling (diary-mode) + ;; clobbers file local variables. + ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00363.html + ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-04/msg00404.html + (if (eq major-mode 'diary-mode) + (setq header-line-format (and diary-header-line-flag + diary-header-line-format)))) ;; d-s-p is passed to the diary display function. (let ((diary-saved-point (point))) (save-excursion @@ -423,95 +693,84 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." (set (make-local-variable 'diary-selective-display) t) (overlay-put ol 'invisible 'diary) (overlay-put ol 'evaporate t))) - (calendar-for-loop - i from 1 to number do - (let ((month (extract-calendar-month date)) - (day (extract-calendar-day date)) - (year (extract-calendar-year date)) - (entry-found (list-sexp-diary-entries date))) - (dolist (date-form diary-date-forms) - (let* - ((backup (when (eq (car date-form) 'backup) - (setq date-form (cdr date-form)) - t)) - (dayname - (format "%s\\|%s\\.?" - (calendar-day-name date) - (calendar-day-name date 'abbrev))) - (monthname - (format "\\*\\|%s\\|%s\\.?" - (calendar-month-name month) - (calendar-month-name month 'abbrev))) - (month (concat "\\*\\|0*" (int-to-string month))) - (day (concat "\\*\\|0*" (int-to-string day))) - (year - (concat - "\\*\\|0*" (int-to-string year) - (if abbreviated-calendar-year - (concat "\\|" (format "%02d" (% year 100))) - ""))) - (regexp - (concat - "\\(\\`\\|\^M\\|\n\\)" mark "?\\(" - (mapconcat 'eval date-form "\\)\\(?:") - "\\)")) - (case-fold-search t)) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (if backup (re-search-backward "\\<" nil t)) - (if (and (or (char-equal (preceding-char) ?\^M) - (char-equal (preceding-char) ?\n)) - (not (looking-at " \\|\^I"))) - ;; Diary entry that consists only of date. - (backward-char 1) - ;; Found a nonempty diary entry--make it - ;; visible and add it to the list. - (setq entry-found t) - (let ((entry-start (point)) - date-start temp) - (re-search-backward "\^M\\|\n\\|\\`") - (setq date-start (point)) - ;; When selective display (rather than - ;; overlays) was used, diary file used to - ;; start in a blank line and end in a - ;; newline. Now that neither of these - ;; need be true, 'move handles the latter - ;; and 1/2 kludge the former. - (re-search-forward - "\^M\\|\n" nil 'move - (if (and (bobp) (not (looking-at "\^M\\|\n"))) - 1 - 2)) - (while (looking-at " \\|\^I") - (re-search-forward "\^M\\|\n" nil 'move)) - (unless (and (eobp) (not (bolp))) - (backward-char 1)) - (unless list-only - (remove-overlays date-start (point) - 'invisible 'diary)) - (setq entry (buffer-substring entry-start (point)) - temp (diary-pull-attrs entry file-glob-attrs) - entry (nth 0 temp)) - (add-to-diary-list - date - entry - (buffer-substring - (1+ date-start) (1- entry-start)) - (copy-marker entry-start) (nth 1 temp))))))) - (or entry-found - (not diary-list-include-blanks) - (add-to-diary-list date "" "" "" "")) - (setq date - (calendar-gregorian-from-absolute - (1+ (calendar-absolute-from-gregorian date)))) - (setq entry-found nil))))) + (dotimes (idummy number) + (let ((month (extract-calendar-month date)) + (day (extract-calendar-day date)) + (year (extract-calendar-year date)) + (entry-found (list-sexp-diary-entries date))) + (dolist (date-form diary-date-forms) + (let* + ((backup (when (eq (car date-form) 'backup) + (setq date-form (cdr date-form)) + t)) + (dayname + (format "%s\\|%s\\.?" + (calendar-day-name date) + (calendar-day-name date 'abbrev))) + (monthname + (format "\\*\\|%s\\|%s\\.?" + (calendar-month-name month) + (calendar-month-name month 'abbrev))) + (month (concat "\\*\\|0*" (int-to-string month))) + (day (concat "\\*\\|0*" (int-to-string day))) + (year + (concat + "\\*\\|0*" (int-to-string year) + (if abbreviated-calendar-year + (concat "\\|" (format "%02d" (% year 100))) + ""))) + (regexp + (concat + "^" mark "?\\(" + (mapconcat 'eval date-form "\\)\\(?:") + "\\)")) + (case-fold-search t)) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (if backup (re-search-backward "\\<" nil t)) + (if (and (bolp) (not (looking-at "[ \t]"))) + ;; Diary entry that consists only of date. + (backward-char 1) + ;; Found a nonempty diary entry--make it + ;; visible and add it to the list. + (setq entry-found t) + (if (looking-at "[ \t]*\n[ \t]") (forward-line 1)) + (let ((entry-start (point)) + date-start temp) + (setq date-start + (line-end-position + (if (and (bolp) (> number 1)) -1 0))) + (forward-line 1) + (while (looking-at "[ \t]") + (forward-line 1)) + (unless (and (eobp) (not (bolp))) + (backward-char 1)) + (unless list-only + (remove-overlays date-start (point) + 'invisible 'diary)) + (setq entry (buffer-substring entry-start (point)) + temp (diary-pull-attrs entry file-glob-attrs) + entry (nth 0 temp)) + (add-to-diary-list + date + entry + (buffer-substring + (1+ date-start) (1- entry-start)) + (copy-marker entry-start) (nth 1 temp))))))) + (or entry-found + (not diary-list-include-blanks) + (add-to-diary-list date "" "" "" "")) + (setq date + (calendar-gregorian-from-absolute + (1+ (calendar-absolute-from-gregorian date)))) + (setq entry-found nil))))) (goto-char (point-min)) (run-hooks 'nongregorian-diary-listing-hook 'list-diary-entries-hook) (unless list-only (if diary-display-hook - (run-hooks 'diary-display-hook) - (simple-diary-display))) + (run-hooks 'diary-display-hook) + (simple-diary-display))) (run-hooks 'diary-hook) diary-entries-list)))))) @@ -532,7 +791,7 @@ changing the variable `diary-include-string'." (goto-char (point-min)) (while (re-search-forward (concat - "\\(?:\\`\\|\^M\\|\n\\)" + "^" (regexp-quote diary-include-string) " \"\\([^\"]*\\)\"") nil t) @@ -561,7 +820,7 @@ changing the variable `diary-include-string'." (defun simple-diary-display () "Display the diary buffer if there are any relevant entries or holidays." (let* ((holiday-list (if holidays-in-diary-buffer - (check-calendar-holidays original-date))) + (calendar-check-holidays original-date))) (hol-string (format "%s%s%s" date-string (if holiday-list ": " "") @@ -569,7 +828,8 @@ changing the variable `diary-include-string'." (msg (format "No diary entries for %s" hol-string)) ;; If selected window is dedicated (to the calendar), ;; need a new one to display the diary. - (pop-up-frames (window-dedicated-p (selected-window)))) + (pop-up-frames (or pop-up-frames + (window-dedicated-p (selected-window))))) (calendar-set-mode-line (format "Diary for %s" hol-string)) (if (or (not diary-entries-list) (and (not (cdr diary-entries-list)) @@ -639,7 +899,7 @@ This function is provided for optional use as the `diary-display-hook'." (and (not (cdr diary-entries-list)) (string-equal (car (cdr (car diary-entries-list))) ""))) (let* ((holiday-list (if holidays-in-diary-buffer - (check-calendar-holidays original-date))) + (calendar-check-holidays original-date))) (msg (format "No diary entries for %s %s" (concat date-string (if holiday-list ":" "")) (mapconcat 'identity holiday-list "; ")))) @@ -833,19 +1093,6 @@ is created." (diary-unhide-everything) (display-buffer (current-buffer))))) -(defcustom diary-mail-addr - (if (boundp 'user-mail-address) user-mail-address "") - "Email address that `diary-mail-entries' will send email to." - :group 'diary - :type 'string - :version "20.3") - -(defcustom diary-mail-days 7 - "Default number of days for `diary-mail-entries' to check." - :group 'diary - :type 'integer - :version "20.3") - ;;;###autoload (defun diary-mail-entries (&optional ndays) "Send a mail message showing diary entries for next NDAYS days. @@ -952,18 +1199,18 @@ diary entries." (year "[0-9]+\\|\\*") (l (length date-form)) (d-name-pos (- l (length (memq 'dayname date-form)))) - (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) + (d-name-pos (if (/= l d-name-pos) (+ 1 d-name-pos))) (m-name-pos (- l (length (memq 'monthname date-form)))) - (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) + (m-name-pos (if (/= l m-name-pos) (+ 1 m-name-pos))) (d-pos (- l (length (memq 'day date-form)))) - (d-pos (if (/= l d-pos) (+ 2 d-pos))) + (d-pos (if (/= l d-pos) (+ 1 d-pos))) (m-pos (- l (length (memq 'month date-form)))) - (m-pos (if (/= l m-pos) (+ 2 m-pos))) + (m-pos (if (/= l m-pos) (+ 1 m-pos))) (y-pos (- l (length (memq 'year date-form)))) - (y-pos (if (/= l y-pos) (+ 2 y-pos))) + (y-pos (if (/= l y-pos) (+ 1 y-pos))) (regexp (concat - "\\(\\`\\|\^M\\|\n\\)\\(" + "^\\(" (mapconcat 'eval date-form "\\)\\(") "\\)")) (case-fold-search t)) @@ -1032,7 +1279,7 @@ diary entries." Each entry in the diary file (or included files) visible in the calendar window is marked. See the documentation for the function `list-sexp-diary-entries'." (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol)) - (s-entry (concat "\\(\\`\\|\^M\\|\n\\)\\(" + (s-entry (concat "^\\(" sexp-mark "(\\)\\|\\(" (regexp-quote diary-nonmarking-symbol) sexp-mark "(diary-remind\\)")) @@ -1053,31 +1300,21 @@ is marked. See the documentation for the function `list-sexp-diary-entries'." (setq marking-diary-entry (char-equal (preceding-char) ?\()) (re-search-backward "(") (let ((sexp-start (point)) - sexp entry entry-start line-start marks) + sexp entry entry-start marks) (forward-sexp) (setq sexp (buffer-substring-no-properties sexp-start (point))) - (save-excursion - (re-search-backward "\^M\\|\n\\|\\`") - (setq line-start (point))) (forward-char 1) - (if (and (or (char-equal (preceding-char) ?\^M) - (char-equal (preceding-char) ?\n)) - (not (looking-at " \\|\^I"))) + (if (and (bolp) (not (looking-at "[ \t]"))) (progn;; Diary entry consists only of the sexp (backward-char 1) (setq entry "")) (setq entry-start (point)) ;; Find end of entry - (re-search-forward "\^M\\|\n" nil t) - (while (looking-at " \\|\^I") - (or (re-search-forward "\^M\\|\n" nil t) - (re-search-forward "$" nil t))) - (if (or (char-equal (preceding-char) ?\^M) - (char-equal (preceding-char) ?\n)) - (backward-char 1)) - (setq entry (buffer-substring-no-properties entry-start (point))) - (while (string-match "[\^M]" entry) - (aset entry (match-beginning 0) ?\n ))) + (forward-line 1) + (while (looking-at "[ \t]") + (forward-line 1)) + (if (bolp) (backward-char 1)) + (setq entry (buffer-substring-no-properties entry-start (point)))) (calendar-for-loop date from first-date to last-date do (if (setq mark (diary-sexp-entry sexp entry (calendar-gregorian-from-absolute date))) @@ -1103,7 +1340,7 @@ changing the variable `diary-include-string'." (goto-char (point-min)) (while (re-search-forward (concat - "\\(?:\\`\\|\^M\\|\n\\)" + "^" (regexp-quote diary-include-string) " \"\\([^\"]*\\)\"") nil t) @@ -1152,9 +1389,9 @@ A value of 0 in any position is a wildcard." (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y -1) - (calendar-for-loop i from 0 to 2 do - (mark-calendar-month m y month day year color) - (increment-calendar-month m y 1))))) + (dotimes (idummy 3) + (mark-calendar-month m y month day year color) + (increment-calendar-month m y 1))))) (defun mark-calendar-month (month year p-month p-day p-year &optional color) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. @@ -1183,16 +1420,6 @@ A value of 0 in any position of the pattern is a wildcard." (and (= t1 t2) (string-lessp ts1 ts2))))))) -(defcustom diary-unknown-time - -9999 - "Value returned by diary-entry-time when no time is found. -The default value -9999 causes entries with no recognizable time to be placed -before those with times; 9999 would place entries with no recognizable time -after those with times." - :type 'integer - :group 'diary - :version "20.3") - (defun diary-entry-time (s) "Return time at the beginning of the string S as a military-style integer. For example, returns 1325 for 1:25pm. @@ -1203,25 +1430,23 @@ XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can be used instead of a colon (:) to separate the hour and minute parts." (let ((case-fold-search nil)) (cond ((string-match ; Military time - "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" + "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s) (+ (* 100 (string-to-number (match-string 1 s))) (string-to-number (match-string 2 s)))) ((string-match ; Hour only XXam or XXpm - "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) + "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) (if (equal ?a (downcase (aref s (match-beginning 2)))) 0 1200))) ((string-match ; Hour and minute XX:XXam or XX:XXpm - "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) + "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) (string-to-number (match-string 2 s)) (if (equal ?a (downcase (aref s (match-beginning 3)))) 0 1200))) (t diary-unknown-time)))) ; Unrecognizable -;; Unrecognizable - (defun list-sexp-diary-entries (date) "Add sexp entries for DATE from the diary file to `diary-entries-list'. Also, Make them visible in the diary file. Returns t if any entries were @@ -1385,7 +1610,7 @@ A number of built-in functions are available for this type of diary entry: Marking these entries is *extremely* time consuming, so these entries are best if they are nonmarking." - (let ((s-entry (concat "\\(\\`\\|\^M\\|\n\\)" + (let ((s-entry (concat "^" (regexp-quote diary-nonmarking-symbol) "?" (regexp-quote sexp-diary-entry-symbol) @@ -1400,27 +1625,21 @@ best if they are nonmarking." sexp entry specifier entry-start line-start) (forward-sexp) (setq sexp (buffer-substring-no-properties sexp-start (point))) - (save-excursion - (re-search-backward "\^M\\|\n\\|\\`") - (setq line-start (point))) + (setq line-start (line-end-position 0)) (setq specifier (buffer-substring-no-properties (1+ line-start) (point)) entry-start (1+ line-start)) (forward-char 1) - (if (and (or (char-equal (preceding-char) ?\^M) - (char-equal (preceding-char) ?\n)) - (not (looking-at " \\|\^I"))) + (if (and (bolp) (not (looking-at "[ \t]"))) (progn;; Diary entry consists only of the sexp (backward-char 1) (setq entry "")) (setq entry-start (point)) - (re-search-forward "\^M\\|\n" nil t) - (while (looking-at " \\|\^I") - (re-search-forward "\^M\\|\n" nil t)) + (forward-line 1) + (while (looking-at "[ \t]") + (forward-line 1)) (backward-char 1) - (setq entry (buffer-substring-no-properties entry-start (point))) - (while (string-match "[\^M]" entry) - (aset entry (match-beginning 0) ?\n ))) + (setq entry (buffer-substring-no-properties entry-start (point)))) (let ((diary-entry (diary-sexp-entry sexp entry date)) temp literal) (setq literal entry ; before evaluation @@ -1640,22 +1859,6 @@ use when highlighting the day in the calendar." "Day of year and number of days remaining in the year of date diary entry." (calendar-day-of-year-string date)) -(defcustom diary-remind-message - '("Reminder: Only " - (if (= 0 (% days 7)) - (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks")) - (concat (int-to-string days) (if (= 1 days) " day" " days"))) - " until " - diary-entry) - "Pseudo-pattern giving form of reminder messages in the fancy diary -display. - -Used by the function `diary-remind', a pseudo-pattern is a list of -expressions that can involve the keywords `days' (a number), `date' (a list of -month, day, year), and `diary-entry' (a string)." - :type 'sexp - :group 'diary) - (defun diary-remind (sexp days &optional marking) "Provide a reminder of a diary entry. SEXP is a diary-sexp. DAYS is either a single number or a list of numbers @@ -1959,54 +2162,62 @@ names." '(1 diary-face))) diary-date-forms))) -(eval-when-compile (require 'cal-hebrew) - (require 'cal-islam)) - -(defvar diary-font-lock-keywords - (append - (diary-font-lock-date-forms calendar-month-name-array - nil calendar-month-abbrev-array) - (when (or (memq 'mark-hebrew-diary-entries - nongregorian-diary-marking-hook) - (memq 'list-hebrew-diary-entries - nongregorian-diary-listing-hook)) - (require 'cal-hebrew) - (diary-font-lock-date-forms - calendar-hebrew-month-name-array-leap-year - hebrew-diary-entry-symbol)) - (when (or (memq 'mark-islamic-diary-entries - nongregorian-diary-marking-hook) - (memq 'list-islamic-diary-entries - nongregorian-diary-listing-hook)) - (require 'cal-islam) - (diary-font-lock-date-forms - calendar-islamic-month-name-array - islamic-diary-entry-symbol)) - (list - (cons - (concat "^" (regexp-quote diary-include-string) ".*$") - 'font-lock-keyword-face) - (cons - (concat "^" (regexp-quote diary-nonmarking-symbol) - "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)") - '(1 font-lock-reference-face)) - (cons - (concat "^" (regexp-quote diary-nonmarking-symbol)) - 'font-lock-reference-face) - (cons - (concat "^" (regexp-quote diary-nonmarking-symbol) - "?\\(" (regexp-quote hebrew-diary-entry-symbol) "\\)") - '(1 font-lock-reference-face)) - (cons - (concat "^" (regexp-quote diary-nonmarking-symbol) - "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") - '(1 font-lock-reference-face)) - '(diary-font-lock-sexps . font-lock-keyword-face) - `(,(concat "\\(^\\|\\s-\\)" - diary-time-regexp "\\(-" diary-time-regexp "\\)?") - . 'diary-time))) - "Forms to highlight in `diary-mode'.") - +(defvar calendar-hebrew-month-name-array-leap-year) +(defvar calendar-islamic-month-name-array) +(defvar calendar-bahai-month-name-array) + +(defun diary-font-lock-keywords () + "Return a value for the variable `diary-font-lock-keywords'." + (append + (diary-font-lock-date-forms calendar-month-name-array + nil calendar-month-abbrev-array) + (when (or (memq 'mark-hebrew-diary-entries + nongregorian-diary-marking-hook) + (memq 'list-hebrew-diary-entries + nongregorian-diary-listing-hook)) + (require 'cal-hebrew) + (diary-font-lock-date-forms + calendar-hebrew-month-name-array-leap-year hebrew-diary-entry-symbol)) + (when (or (memq 'mark-islamic-diary-entries + nongregorian-diary-marking-hook) + (memq 'list-islamic-diary-entries + nongregorian-diary-listing-hook)) + (require 'cal-islam) + (diary-font-lock-date-forms + calendar-islamic-month-name-array islamic-diary-entry-symbol)) + (when (or (memq 'diary-bahai-mark-entries + nongregorian-diary-marking-hook) + (memq 'diary-bahai-list-entries + nongregorian-diary-marking-hook)) + (require 'cal-bahai) + (diary-font-lock-date-forms + calendar-bahai-month-name-array bahai-diary-entry-symbol)) + (list + (cons + (format "^%s.*$" (regexp-quote diary-include-string)) + 'font-lock-keyword-face) + (cons + (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol) + (regexp-quote sexp-diary-entry-symbol)) + '(1 font-lock-reference-face)) + (cons + (format "^%s" (regexp-quote diary-nonmarking-symbol)) + 'font-lock-reference-face) + (cons + (format "^%s?%s" (regexp-quote diary-nonmarking-symbol) + (regexp-opt (mapcar 'regexp-quote + (list hebrew-diary-entry-symbol + islamic-diary-entry-symbol + bahai-diary-entry-symbol)) + t)) + '(1 font-lock-reference-face)) + '(diary-font-lock-sexps . font-lock-keyword-face) + `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp + diary-time-regexp) + . 'diary-time)))) + +(defvar diary-font-lock-keywords (diary-font-lock-keywords) + "Forms to highlight in `diary-mode'.") ;; Following code from Dave Love . ;; Import Outlook-format appointments from mail messages in Gnus or @@ -2017,53 +2228,7 @@ names." ;; message formats recognized are customizable through ;; `diary-outlook-formats'. -(defcustom diary-outlook-formats - '( - ;; When: 11 October 2001 12:00-14:00 (GMT) Greenwich Mean Time : Dublin, ... - ;; [Current UK format? The timezone is meaningless. Sometimes the - ;; Where is missing.] - ("When: \\([0-9]+ [[:alpha:]]+ [0-9]+\\) \ -\\([^ ]+\\) [^\n]+ -\[^\n]+ -\\(?:Where: \\([^\n]+\\)\n+\\)? -\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*" - . "\\1\n \\2 %s, \\3") - ;; When: Tuesday, April 30, 2002 03:00 PM-03:30 PM (GMT) Greenwich Mean ... - ;; [Old UK format?] - ("^When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \\([0-9]\\{4\\}\\) \ -\\([^ ]+\\) [^\n]+ -\[^\n]+ -\\(?:Where: \\([^\n]+\\)\\)?\n+" - . "\\2 \\1 \\3\n \\4 %s, \\5") - ( - ;; German format, apparently. - "^Zeit: [^ ]+, +\\([0-9]+\\)\. +\\([[:upper:]][[:lower:]][[:lower:]]\\)[^ ]* +\\([0-9]+\\) +\\([^ ]+\\).*$" - . "\\1 \\2 \\3\n \\4 %s")) - "Alist of regexps matching message text and replacement text. - -The regexp must match the start of the message text containing an -appointment, but need not include a leading `^'. If it matches the -current message, a diary entry is made from the corresponding -template. If the template is a string, it should be suitable for -passing to `replace-match', and so will have occurrences of `\\D' to -substitute the match for the Dth subexpression. It must also contain -a single `%s' which will be replaced with the text of the message's -Subject field. Any other `%' characters must be doubled, so that the -template can be passed to `format'. - -If the template is actually a function, it is called with the message -body text as argument, and may use `match-string' etc. to make a -template following the rules above." - :type '(alist :key-type (regexp :tag "Regexp matching time/place") - :value-type (choice - (string :tag "Template for entry") - (function :tag "Unary function providing template"))) - :version "22.1" - :group 'diary) - - ;; Dynamically bound. -(defvar body) (defvar subject) (defun diary-from-outlook-internal (&optional test-only)