Show
Ignore:
Timestamp:
11/01/05 07:08:22 (3 years ago)
Author:
miyoshi
Message:

Sync up with Emacs CVS HEAD.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • vendor/emacs-CVS_HEAD/lisp/calendar/diary-lib.el

    r3892 r3939  
    55 
    66;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> 
    7 ;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk> 
     7;; Maintainer: Glenn Morris <rgm@gnu.org> 
    88;; Keywords: calendar 
    99 
    …… 
    272272;; (see etc/TODO) is fixed. -- gm 
    273273(defcustom diary-header-line-flag t 
    274   "*If non-nil, `simple-diary-display' will show a header line. 
     274  "If non-nil, `diary-simple-display' will show a header line. 
    275275The format of the header is specified by `diary-header-line-format'." 
    276276  :group   'diary 
    …… 
    278278  :version "22.1") 
    279279 
     280(defvar diary-selective-display nil) 
     281 
    280282(defcustom diary-header-line-format 
    281283  '(:eval (calendar-string-spread 
    282            (list (if selective-display 
     284           (list (if diary-selective-display 
    283285                     "Selective display active - press \"s\" in calendar \ 
    284286before edit/copy" 
    285287                   "Diary")) 
    286288           ?\s (frame-width))) 
    287   "*Format of the header line displayed by `simple-diary-display'. 
     289  "Format of the header line displayed by `diary-simple-display'. 
    288290Only used if `diary-header-line-flag' is non-nil." 
    289291  :group   'diary 
    …… 
    323325 
    324326(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) 
    325 (defun diary-list-entries (date number) 
     327(defun diary-list-entries (date number &optional list-only) 
    326328  "Create and display a buffer containing the relevant lines in `diary-file'. 
    327329The arguments are DATE and NUMBER; the entries selected are those 
    …… 
    330332 
    331333Returns a list of all relevant diary entries found, if any, in order by date. 
    332 The list entries have the form ((month day year) string specifier) where 
    333 \(month day year) is the date of the entry, string is the entry text, and 
    334 specifier is the applicability.  If the variable `diary-list-include-blanks' 
    335 is t, this list includes a dummy diary entry consisting of the empty string) 
     334The list entries have the form ((MONTH DAY YEAR) STRING SPECIFIER) where 
     335\(MONTH DAY YEAR) is the date of the entry, STRING is the entry text, and 
     336SPECIFIER is the applicability.  If the variable `diary-list-include-blanks' 
     337is t, this list includes a dummy diary entry consisting of the empty string 
    336338for a date with no diary entries. 
    337339 
    …… 
    355357 
    356358    `diary-hook' is run last.  This can be used for an appointment 
    357         notification function." 
     359        notification function. 
     360 
     361If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." 
    358362  (unless number 
    359363    (setq number (if (vectorp number-of-diary-entries) 
    …… 
    374378            (or (verify-visited-file-modtime diary-buffer) 
    375379                (revert-buffer t t)))) 
     380        ;; Setup things like the header-line-format and invisibility-spec. 
     381        (when (eq major-mode 'fundamental-mode) (diary-mode)) 
    376382        ;; d-s-p is passed to the diary display function. 
    377383        (let ((diary-saved-point (point))) 
    378384          (save-excursion 
    379385            (setq file-glob-attrs (nth 1 (diary-pull-attrs nil ""))) 
    380             (setq selective-display t) 
    381             (setq selective-display-ellipses nil) 
    382             (if diary-header-line-flag 
    383                 (setq header-line-format diary-header-line-format)) 
    384386            (with-syntax-table diary-syntax-table 
    385               (let ((buffer-read-only nil) 
    386                     (diary-modified (buffer-modified-p)) 
    387                     (mark (regexp-quote diary-nonmarking-symbol))) 
    388                 ;; First and last characters must be ^M or \n for 
    389                 ;; selective display to work properly 
    390                 (goto-char (1- (point-max))) 
    391                 (if (not (looking-at "\^M\\|\n")) 
    392                     (progn 
    393                       (goto-char (point-max)) 
    394                       (insert "\^M"))) 
     387              (let ((mark (regexp-quote diary-nonmarking-symbol))) 
    395388                (goto-char (point-min)) 
    396                 (if (not (looking-at "\^M\\|\n")) 
    397                     (insert "\^M")) 
    398                 (subst-char-in-region (point-min) (point-max) ?\n ?\^M t) 
     389                (unless list-only 
     390                  (let ((ol (make-overlay (point-min) (point-max) nil t nil))) 
     391                    (set (make-local-variable 'diary-selective-display) t) 
     392                    (overlay-put ol 'invisible 'diary) 
     393                    (overlay-put ol 'evaporate t))) 
    399394                (calendar-for-loop 
    400395                 i from 1 to number do 
    …… 
    427422                           (concat 
    428423                            "\\(\\`\\|\^M\\|\n\\)" mark "?\\(" 
    429                             (mapconcat 'eval date-form "\\)\\(") 
     424                            (mapconcat 'eval date-form "\\)\\(?:") 
    430425                            "\\)")) 
    431426                          (case-fold-search t)) 
    …… 
    445440                             (re-search-backward "\^M\\|\n\\|\\`") 
    446441                             (setq date-start (point)) 
    447                              (re-search-forward "\^M\\|\n" nil t 2) 
     442                             ;; When selective display (rather than 
     443                             ;; overlays) was used, diary file used to 
     444                             ;; start in a blank line and end in a 
     445                             ;; newline. Now that neither of these 
     446                             ;; need be true, 'move handles the latter 
     447                             ;; and 1/2 kludge the former. 
     448                             (re-search-forward 
     449                              "\^M\\|\n" nil 'move 
     450                              (if (and (bobp) (not (looking-at "\^M\\|\n"))) 
     451                                  1 
     452                                2)) 
    448453                             (while (looking-at " \\|\^I") 
    449                                (re-search-forward "\^M\\|\n" nil t)) 
    450                              (backward-char 1) 
    451                              (subst-char-in-region date-start 
    452                                                    (point) ?\^M ?\n t) 
     454                               (re-search-forward "\^M\\|\n" nil 'move)) 
     455                             (unless (eobp) (backward-char 1)) 
     456                             (unless list-only 
     457                               (remove-overlays date-start (point) 
     458                                                'invisible 'diary)) 
    453459                             (setq entry (buffer-substring entry-start (point)) 
    454460                                   temp (diary-pull-attrs entry file-glob-attrs) 
    …… 
    468474                         (calendar-gregorian-from-absolute 
    469475                          (1+ (calendar-absolute-from-gregorian date)))) 
    470                    (setq entry-found nil))) 
    471                 (set-buffer-modified-p diary-modified))) 
     476                   (setq entry-found nil))))) 
    472477            (goto-char (point-min)) 
    473478            (run-hooks 'nongregorian-diary-listing-hook 
    474479                       'list-diary-entries-hook) 
    475             (if diary-display-hook 
    476                 (run-hooks 'diary-display-hook) 
    477               (simple-diary-display)) 
     480            (unless list-only 
     481              (if diary-display-hook 
     482                  (run-hooks 'diary-display-hook) 
     483                (simple-diary-display))) 
    478484            (run-hooks 'diary-hook) 
    479485            diary-entries-list)))))) 
    480486 
    481487(defun diary-unhide-everything () 
    482   (setq selective-display nil) 
    483   (let ((inhibit-read-only t) 
    484         (modified (buffer-modified-p))) 
    485     (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) 
    486     (set-buffer-modified-p modified)) 
     488  (kill-local-variable 'diary-selective-display) 
     489  (remove-overlays (point-min) (point-max) 'invisible 'diary) 
    487490  (kill-local-variable 'mode-line-format)) 
    488491 
    …… 
    604607          (display-buffer holiday-buffer) 
    605608          (message  "No diary entries for %s" date-string))) 
    606     (save-excursion;; Prepare the fancy diary buffer. 
    607       (set-buffer (make-fancy-diary-buffer)) 
     609    (with-current-buffer;; Prepare the fancy diary buffer. 
     610        (make-fancy-diary-buffer) 
    608611      (setq buffer-read-only nil) 
    609612      (let ((entry-list diary-entries-list) 
    …… 
    674677                                     (apply 
    675678                                      'concat "temp-face-" 
    676                                       (mapcar '(lambda (sym) 
    677                                                 (if (stringp sym) 
    678                                                     sym 
    679                                                   (symbol-name sym))) 
     679                                      (mapcar (lambda (sym) 
     680                                                (if (stringp sym) 
     681                                                    sym 
     682                                                  (symbol-name sym))) 
    680683                                              marks)))) 
    681684                         (faceinfo marks)) 
    …… 
    688691                      (setcar (cdr faceinfo) nil)) 
    689692                    (setq marks (delq nil marks)) 
    690                   ;; Apply the font aspects 
     693                    ;; Apply the font aspects. 
    691694                    (apply 'set-face-attribute temp-face nil marks) 
    692695                    (search-backward entry) 
    …… 
    705708(defun make-fancy-diary-buffer () 
    706709  "Create and return the initial fancy diary buffer." 
    707   (save-excursion 
    708     (set-buffer (get-buffer-create fancy-diary-buffer)) 
     710  (with-current-buffer (get-buffer-create fancy-diary-buffer) 
    709711    (setq buffer-read-only nil) 
    710712    (calendar-set-mode-line "Diary Entries") 
    …… 
    727729  (interactive) 
    728730  (if (bufferp (get-buffer fancy-diary-buffer)) 
    729       (save-excursion 
    730         (set-buffer (get-buffer fancy-diary-buffer)) 
     731      (with-current-buffer (get-buffer fancy-diary-buffer) 
    731732        (run-hooks 'print-diary-entries-hook)) 
    732733    (let ((diary-buffer 
    733734           (find-buffer-visiting (substitute-in-file-name diary-file)))) 
    734735      (if diary-buffer 
    735           (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*")) 
     736          (let ((temp-buffer (get-buffer-create " *Printable Diary Entries*")) 
    736737                (heading)) 
    737             (save-excursion 
    738               (set-buffer diary-buffer) 
     738            (with-current-buffer diary-buffer 
    739739              (setq heading 
    740740                    (if (not (stringp mode-line-format)) 
    741741                        "All Diary Entries" 
    742742                      (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format) 
    743                       (substring mode-line-format 
    744                                  (match-beginning 1) (match-end 1)))) 
    745               (copy-to-buffer temp-buffer (point-min) (point-max)) 
     743                      (match-string 1 mode-line-format))) 
     744              (let ((start (point-min)) 
     745                    end) 
     746                (while 
     747                    (progn 
     748                      (setq end (next-single-char-property-change 
     749                                 start 'invisible)) 
     750                      (if (get-char-property start 'invisible) 
     751                          nil 
     752                        (with-current-buffer temp-buffer 
     753                          (insert-buffer-substring diary-buffer 
     754                                                   start (or end (point-max))))) 
     755                      (setq start end) 
     756                      (and end (< end (point-max)))))) 
    746757              (set-buffer temp-buffer) 
    747               (while (re-search-forward "\^M.*$" nil t) 
    748                 (replace-match "")) 
    749758              (goto-char (point-min)) 
    750759              (insert heading "\n" 
    …… 
    765774    (with-current-buffer (or (find-buffer-visiting d-file) 
    766775                             (find-file-noselect d-file t)) 
     776      (when (eq major-mode 'fundamental-mode) (diary-mode)) 
    767777      (diary-unhide-everything) 
    768778      (display-buffer (current-buffer))))) 
    …… 
    770780(defcustom diary-mail-addr 
    771781  (if (boundp 'user-mail-address) user-mail-address "") 
    772   "*Email address that `diary-mail-entries' will send email to." 
     782  "Email address that `diary-mail-entries' will send email to." 
    773783  :group 'diary 
    774784  :type  'string 
    …… 
    776786 
    777787(defcustom diary-mail-days 7 
    778   "*Default number of days for `diary-mail-entries' to check." 
     788  "Default number of days for `diary-mail-entries' to check." 
    779789  :group 'diary 
    780790  :type 'integer 
    …… 
    867877    (with-current-buffer (find-file-noselect (diary-check-diary-file) t) 
    868878      (save-excursion 
     879        (when (eq major-mode 'fundamental-mode) (diary-mode)) 
    869880        (setq mark-diary-entries-in-calendar t) 
    870881        (message "Marking diary entries...") 
    …… 
    11191130(defcustom diary-unknown-time 
    11201131  -9999 
    1121   "*Value returned by diary-entry-time when no time is found. 
     1132  "Value returned by diary-entry-time when no time is found. 
    11221133The default value -9999 causes entries with no recognizable time to be placed 
    11231134before those with times; 9999 would place entries with no recognizable time 
    …… 
    13621373          (if diary-entry 
    13631374              (progn 
    1364                (subst-char-in-region line-start (point) ?\^M ?\n t) 
     1375                (remove-overlays line-start (point) 'invisible 'diary) 
    13651376                (if (< 0 (length entry)) 
    13661377                    (setq temp (diary-pull-attrs entry file-glob-attrs) 
    …… 
    15121523 
    15131524 
    1514 (defun diary-anniversary (month day year &optional mark) 
     1525(defun diary-anniversary (month day &optional year mark) 
    15151526  "Anniversary diary entry. 
    15161527Entry applies if date is the anniversary of MONTH, DAY, YEAR if 
    …… 
    15311542              month)) 
    15321543         (y (extract-calendar-year date)) 
    1533          (diff (- y year))) 
     1544         (diff (if year (- y year) 100))) 
    15341545    (if (and (= m 2) (= d 29) (not (calendar-leap-year-p y))) 
    15351546        (setq m 3 
    …… 
    15791590    " until " 
    15801591    diary-entry) 
    1581   "*Pseudo-pattern giving form of reminder messages in the fancy diary 
     1592  "Pseudo-pattern giving form of reminder messages in the fancy diary 
    15821593display. 
    15831594 
    …… 
    16581669  "Insert a diary entry STRING which may be NONMARKING in FILE. 
    16591670If omitted, NONMARKING defaults to nil and FILE defaults to 
    1660 `diary-file'.  Adds `diary-redraw-calendar' to 
    1661 `write-contents-functions' for FILE, so that the calendar will be 
    1662 redrawn with the new entry marked, if necessary." 
     1671`diary-file'." 
    16631672  (let ((pop-up-frames (window-dedicated-p (selected-window)))) 
    16641673    (find-file-other-window (substitute-in-file-name (or file diary-file)))) 
    1665   (add-hook 'after-save-hook 'diary-redraw-calendar nil t) 
     1674  (when (eq major-mode 'fundamental-mode) (diary-mode)) 
    16661675  (widen) 
    16671676  (diary-unhide-everything) 
    …… 
    18671876(eval-when-compile (require 'cal-hebrew) 
    18681877                   (require 'cal-islam)) 
     1878 
     1879(defconst diary-time-regexp 
     1880  ;; Formats that should be accepted: 
     1881  ;;   10:00 10.00 10h00 10h 10am 10:00am 10.00am 
     1882  (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\(" 
     1883          "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]" 
     1884          "\\)\\([AaPp][Mm]\\)?\\)")) 
    18691885 
    18701886(defvar diary-font-lock-keywords 
    …… 
    19081924         '(1 font-lock-reference-face)) 
    19091925        '(diary-font-lock-sexps . font-lock-keyword-face) 
    1910         '("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?" 
    1911           . font-lock-function-name-face))) 
     1926        (cons 
     1927         (concat ;; "^[ \t]+" 
     1928                 diary-time-regexp "\\(-" diary-time-regexp "\\)?") 
     1929         'font-lock-function-name-face))) 
    19121930      "Forms to highlight in `diary-mode'.") 
    19131931