Show
Ignore:
Timestamp:
10/02/05 07:23:38 (3 years ago)
Author:
miyoshi
Message:

Update.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

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

    r3823 r3892  
    5959  (diary-check-diary-file) 
    6060  (let ((date (calendar-current-date))) 
    61     (list-diary-entries 
    62      date 
    63      (cond (arg (prefix-numeric-value arg)) 
    64            ((vectorp number-of-diary-entries) 
    65             (aref number-of-diary-entries (calendar-day-of-week date))) 
    66            (t number-of-diary-entries))))) 
    67  
    68 (defun view-diary-entries (arg) 
     61    (diary-list-entries date (if arg (prefix-numeric-value arg))))) 
     62 
     63(define-obsolete-function-alias 'view-diary-entries 'diary-view-entries) 
     64(defun diary-view-entries (&optional arg) 
    6965  "Prepare and display a buffer with diary entries. 
    7066Searches the file named in `diary-file' for entries that 
    …… 
    7369  (interactive "p") 
    7470  (diary-check-diary-file) 
    75   (list-diary-entries (calendar-cursor-to-date t) arg)) 
     71  (diary-list-entries (calendar-cursor-to-date t) arg)) 
    7672 
    7773(defun view-other-diary-entries (arg d-file) 
    …… 
    183179No diary entry if there is no sunset on that date.") 
    184180 
    185 (defvar diary-syntax-table (copy-syntax-table (standard-syntax-table)) 
     181(defvar diary-syntax-table 
     182  (let ((st (copy-syntax-table (standard-syntax-table)))) 
     183    (modify-syntax-entry ?* "w" st) 
     184    (modify-syntax-entry ?: "w" st) 
     185    st) 
    186186  "The syntax table used when parsing dates in the diary file. 
    187187It is the standard syntax table used in Fundamental mode, but with the 
    188188syntax of `*' and `:' changed to be word constituents.") 
    189  
    190 (modify-syntax-entry ?* "w" diary-syntax-table) 
    191 (modify-syntax-entry ?: "w" diary-syntax-table) 
    192189 
    193190(defvar diary-entries-list) 
    …… 
    244241              (setq attrvalue nil) 
    245242              (if (re-search-forward regexp (point-max) t) 
    246                   (setq attrvalue (buffer-substring-no-properties 
    247                                    (match-beginning regnum) 
    248                                    (match-end regnum)))) 
     243                  (setq attrvalue (match-string-no-properties regnum))) 
    249244              (if (and attrvalue 
    250245                       (setq attrvalue (diary-attrtype-convert attrvalue type))) 
    …… 
    265260            (if (string-match regexp entry) 
    266261                (progn 
    267                   (setq attrvalue (substring-no-properties entry 
    268                                                            (match-beginning regnum) 
    269                                                            (match-end regnum))) 
     262                  (setq attrvalue (match-string-no-properties regnum entry)) 
    270263                  (setq entry (replace-match "" t t entry)))) 
    271264            (if (and attrvalue 
    …… 
    300293(defvar diary-saved-point)              ; internal 
    301294 
    302 (defun list-diary-entries (date number) 
    303   "Create and display a buffer containing the relevant lines in diary-file. 
     295 
     296(defcustom number-of-diary-entries 1 
     297  "Specifies how many days of diary entries are to be displayed initially. 
     298This variable affects the diary display when the command \\[diary] is used, 
     299or if the value of the variable `view-diary-entries-initially' is t.  For 
     300example, if the default value 1 is used, then only the current day's diary 
     301entries will be displayed.  If the value 2 is used, then both the current 
     302day's and the next day's entries will be displayed. 
     303 
     304The value can also be a vector such as [0 2 2 2 2 4 1]; this value 
     305says to display no diary entries on Sunday, the display the entries 
     306for the current date and the day after on Monday through Thursday, 
     307display Friday through Monday's entries on Friday, and display only 
     308Saturday's entries on Saturday. 
     309 
     310This variable does not affect the diary display with the `d' command 
     311from the calendar; in that case, the prefix argument controls the 
     312number of days of diary entries displayed." 
     313  :type '(choice (integer :tag "Entries") 
     314                 (vector :value [0 0 0 0 0 0 0] 
     315                         (integer :tag "Sunday") 
     316                         (integer :tag "Monday") 
     317                         (integer :tag "Tuesday") 
     318                         (integer :tag "Wednesday") 
     319                         (integer :tag "Thursday") 
     320                         (integer :tag "Friday") 
     321                         (integer :tag "Saturday"))) 
     322  :group 'diary) 
     323 
     324(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) 
     325(defun diary-list-entries (date number) 
     326  "Create and display a buffer containing the relevant lines in `diary-file'. 
    304327The arguments are DATE and NUMBER; the entries selected are those 
    305328for NUMBER days starting with date DATE.  The other entries are hidden 
    …… 
    333356    `diary-hook' is run last.  This can be used for an appointment 
    334357        notification function." 
    335  
     358  (unless number 
     359    (setq number (if (vectorp number-of-diary-entries) 
     360                     (aref number-of-diary-entries (calendar-day-of-week date)) 
     361                   number-of-diary-entries))) 
    336362  (when (> number 0) 
    337363    (let ((original-date date);; save for possible use in the hooks 
    338           old-diary-syntax-table 
    339364          diary-entries-list 
    340365          file-glob-attrs 
    …… 
    357382            (if diary-header-line-flag 
    358383                (setq header-line-format diary-header-line-format)) 
    359             (setq old-diary-syntax-table (syntax-table)) 
    360             (set-syntax-table diary-syntax-table) 
    361             (unwind-protect 
    362                 (let ((buffer-read-only nil) 
    363                       (diary-modified (buffer-modified-p)) 
    364                       (mark (regexp-quote diary-nonmarking-symbol))) 
    365                   ;; First and last characters must be ^M or \n for 
    366                   ;; selective display to work properly 
    367                   (goto-char (1- (point-max))) 
    368                   (if (not (looking-at "\^M\\|\n")) 
    369                       (progn 
    370                         (goto-char (point-max)) 
    371                         (insert "\^M"))) 
    372                   (goto-char (point-min)) 
    373                   (if (not (looking-at "\^M\\|\n")) 
    374                       (insert "\^M")) 
    375                   (subst-char-in-region (point-min) (point-max) ?\n ?\^M t) 
    376                   (calendar-for-loop 
    377                    i from 1 to number do 
    378                    (let ((d diary-date-forms) 
    379                          (month (extract-calendar-month date)) 
    380                          (day (extract-calendar-day date)) 
    381                          (year (extract-calendar-year date)) 
    382                          (entry-found (list-sexp-diary-entries date))) 
    383                      (while d 
    384                        (let* 
    385                            ((date-form (if (equal (car (car d)) 'backup) 
    386                                            (cdr (car d)) 
    387                                          (car d))) 
    388                             (backup (equal (car (car d)) 'backup)) 
    389                             (dayname 
    390                              (format "%s\\|%s\\.?" 
    391                                      (calendar-day-name date) 
    392                                      (calendar-day-name date 'abbrev))) 
    393                             (monthname 
    394                              (format "\\*\\|%s\\|%s\\.?" 
    395                                      (calendar-month-name month) 
    396                                      (calendar-month-name month 'abbrev))) 
    397                             (month (concat "\\*\\|0*" (int-to-string month))) 
    398                             (day (concat "\\*\\|0*" (int-to-string day))) 
    399                             (year 
    400                              (concat 
    401                               "\\*\\|0*" (int-to-string year) 
    402                               (if abbreviated-calendar-year 
    403                                   (concat "\\|" (format "%02d" (% year 100))) 
    404                                 ""))) 
    405                             (regexp 
    406                              (concat 
    407                               "\\(\\`\\|\^M\\|\n\\)" mark "?\\(" 
    408                               (mapconcat 'eval date-form "\\)\\(") 
    409                               "\\)")) 
    410                             (case-fold-search t)) 
    411                          (goto-char (point-min)) 
    412                          (while (re-search-forward regexp nil t) 
    413                            (if backup (re-search-backward "\\<" nil t)) 
    414                            (if (and (or (char-equal (preceding-char) ?\^M) 
    415                                         (char-equal (preceding-char) ?\n)) 
    416                                     (not (looking-at " \\|\^I"))) 
    417                                ;;  Diary entry that consists only of date. 
    418                                (backward-char 1) 
    419                              ;; Found a nonempty diary entry--make it 
    420                              ;; visible and add it to the list. 
    421                              (setq entry-found t) 
    422                              (let ((entry-start (point)) 
    423                                    date-start temp) 
    424                                (re-search-backward "\^M\\|\n\\|\\`") 
    425                                (setq date-start (point)) 
    426                                (re-search-forward "\^M\\|\n" nil t 2) 
    427                                (while (looking-at " \\|\^I") 
    428                                  (re-search-forward "\^M\\|\n" nil t)) 
    429                                (backward-char 1) 
    430                                (subst-char-in-region date-start 
    431                                                      (point) ?\^M ?\n t) 
    432                                (setq entry (buffer-substring entry-start (point)) 
    433                                      temp (diary-pull-attrs entry file-glob-attrs) 
    434                                      entry (nth 0 temp)) 
    435                                (add-to-diary-list 
    436                                 date 
    437                                 entry 
    438                                 (buffer-substring 
    439                                  (1+ date-start) (1- entry-start)) 
    440                                 (copy-marker entry-start) (nth 1 temp)))))) 
    441                        (setq d (cdr d))) 
    442                      (or entry-found 
    443                          (not diary-list-include-blanks) 
    444                          (setq diary-entries-list 
    445                                (append diary-entries-list 
    446                                        (list (list date "" "" "" ""))))) 
    447                      (setq date 
    448                            (calendar-gregorian-from-absolute 
    449                             (1+ (calendar-absolute-from-gregorian date)))) 
    450                      (setq entry-found nil))) 
    451                   (set-buffer-modified-p diary-modified)) 
    452               (set-syntax-table old-diary-syntax-table)) 
     384            (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"))) 
     395                (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) 
     399                (calendar-for-loop 
     400                 i from 1 to number do 
     401                 (let ((month (extract-calendar-month date)) 
     402                       (day (extract-calendar-day date)) 
     403                       (year (extract-calendar-year date)) 
     404                       (entry-found (list-sexp-diary-entries date))) 
     405                   (dolist (date-form diary-date-forms) 
     406                     (let* 
     407                         ((backup (when (eq (car date-form) 'backup) 
     408                                    (setq date-form (cdr date-form)) 
     409                                    t)) 
     410                          (dayname 
     411                           (format "%s\\|%s\\.?" 
     412                                   (calendar-day-name date) 
     413                                   (calendar-day-name date 'abbrev))) 
     414                          (monthname 
     415                           (format "\\*\\|%s\\|%s\\.?" 
     416                                   (calendar-month-name month) 
     417                                   (calendar-month-name month 'abbrev))) 
     418                          (month (concat "\\*\\|0*" (int-to-string month))) 
     419                          (day (concat "\\*\\|0*" (int-to-string day))) 
     420                          (year 
     421                           (concat 
     422                            "\\*\\|0*" (int-to-string year) 
     423                            (if abbreviated-calendar-year 
     424                                (concat "\\|" (format "%02d" (% year 100))) 
     425                              ""))) 
     426                          (regexp 
     427                           (concat 
     428                            "\\(\\`\\|\^M\\|\n\\)" mark "?\\(" 
     429                            (mapconcat 'eval date-form "\\)\\(") 
     430                            "\\)")) 
     431                          (case-fold-search t)) 
     432                       (goto-char (point-min)) 
     433                       (while (re-search-forward regexp nil t) 
     434                         (if backup (re-search-backward "\\<" nil t)) 
     435                         (if (and (or (char-equal (preceding-char) ?\^M) 
     436                                      (char-equal (preceding-char) ?\n)) 
     437                                  (not (looking-at " \\|\^I"))) 
     438                             ;;  Diary entry that consists only of date. 
     439                             (backward-char 1) 
     440                           ;; Found a nonempty diary entry--make it 
     441                           ;; visible and add it to the list. 
     442                           (setq entry-found t) 
     443                           (let ((entry-start (point)) 
     444                                 date-start temp) 
     445                             (re-search-backward "\^M\\|\n\\|\\`") 
     446                             (setq date-start (point)) 
     447                             (re-search-forward "\^M\\|\n" nil t 2) 
     448                             (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) 
     453                             (setq entry (buffer-substring entry-start (point)) 
     454                                   temp (diary-pull-attrs entry file-glob-attrs) 
     455                                   entry (nth 0 temp)) 
     456                             (add-to-diary-list 
     457                              date 
     458                              entry 
     459                              (buffer-substring 
     460                               (1+ date-start) (1- entry-start)) 
     461                              (copy-marker entry-start) (nth 1 temp))))))) 
     462                   (or entry-found 
     463                       (not diary-list-include-blanks) 
     464                       (setq diary-entries-list 
     465                             (append diary-entries-list 
     466                                     (list (list date "" "" "" ""))))) 
     467                   (setq date 
     468                         (calendar-gregorian-from-absolute 
     469                          (1+ (calendar-absolute-from-gregorian date)))) 
     470                   (setq entry-found nil))) 
     471                (set-buffer-modified-p diary-modified))) 
    453472            (goto-char (point-min)) 
    454473            (run-hooks 'nongregorian-diary-listing-hook 
    …… 
    459478            (run-hooks 'diary-hook) 
    460479            diary-entries-list)))))) 
     480 
     481(defun diary-unhide-everything () 
     482  (setq selective-display nil) 
     483  (let ((inhibit-read-only t) 
     484        (modified (buffer-modified-p))) 
     485    (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) 
     486    (set-buffer-modified-p modified)) 
     487  (kill-local-variable 'mode-line-format)) 
    461488 
    462489(defun include-other-diary-files () 
    …… 
    472499  (while (re-search-forward 
    473500          (concat 
    474            "\\(\\`\\|\^M\\|\n\\)" 
     501           "\\(?:\\`\\|\^M\\|\n\\)" 
    475502           (regexp-quote diary-include-string) 
    476503           " \"\\([^\"]*\\)\"") 
    477504          nil t) 
    478505    (let* ((diary-file (substitute-in-file-name 
    479                         (buffer-substring-no-properties 
    480                          (match-beginning 2) (match-end 2)))) 
     506                        (match-string-no-properties 1))) 
    481507           (diary-list-include-blanks nil) 
    482508           (list-diary-entries-hook 'include-other-diary-files) 
    483509           (diary-display-hook 'ignore) 
    484            (diary-hook nil) 
    485            (d-buffer (find-buffer-visiting diary-file)) 
    486            (diary-modified (if d-buffer 
    487                                (save-excursion 
    488                                  (set-buffer d-buffer) 
    489                                  (buffer-modified-p))))) 
     510           (diary-hook nil)) 
    490511      (if (file-exists-p diary-file) 
    491512          (if (file-readable-p diary-file) 
    …… 
    494515                        (append diary-entries-list 
    495516                                (list-diary-entries original-date number))) 
    496                 (save-excursion 
    497                   (set-buffer (find-buffer-visiting diary-file)) 
    498                   (let ((inhibit-read-only t)) 
    499                     (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)) 
    500                   (setq selective-display nil) 
    501                   (set-buffer-modified-p diary-modified))) 
     517                (with-current-buffer (find-buffer-visiting diary-file) 
     518                  (diary-unhide-everything))) 
    502519            (beep) 
    503520            (message "Can't read included diary file %s" diary-file) 
    …… 
    565582  "Prepare a diary buffer with relevant entries in a fancy, noneditable form. 
    566583This function is provided for optional use as the `diary-display-hook'." 
    567   (save-excursion;; Turn off selective-display in the diary file's buffer. 
    568     (set-buffer (find-buffer-visiting (substitute-in-file-name diary-file))) 
    569     (let ((diary-modified (buffer-modified-p))) 
    570       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) 
    571       (setq selective-display nil) 
    572       (kill-local-variable 'mode-line-format) 
    573       (set-buffer-modified-p diary-modified))) 
     584  (with-current-buffer ;; Turn off selective-display in the diary file's buffer. 
     585      (find-buffer-visiting (substitute-in-file-name diary-file)) 
     586    (diary-unhide-everything)) 
    574587  (if (or (not diary-entries-list) 
    575588          (and (not (cdr diary-entries-list)) 
    …… 
    741754        (error "You don't have a diary buffer!"))))) 
    742755 
    743 (defun show-all-diary-entries () 
     756(define-obsolete-function-alias 'show-all-diary-entries 'diary-show-all-entries) 
     757(defun diary-show-all-entries () 
    744758  "Show all of the diary entries in the diary file. 
    745759This function gets rid of the selective display of the diary file so that 
    …… 
    749763  (let ((d-file (diary-check-diary-file)) 
    750764        (pop-up-frames (window-dedicated-p (selected-window)))) 
    751     (save-excursion 
    752       (set-buffer (or (find-buffer-visiting d-file) 
    753                       (find-file-noselect d-file t))) 
    754       (let ((buffer-read-only nil) 
    755             (diary-modified (buffer-modified-p))) 
    756         (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) 
    757         (setq selective-display nil 
    758               mode-line-format default-mode-line-format) 
    759         (display-buffer (current-buffer)) 
    760         (set-buffer-modified-p diary-modified))))) 
     765    (with-current-buffer (or (find-buffer-visiting d-file) 
     766                             (find-file-noselect d-file t)) 
     767      (diary-unhide-everything) 
     768      (display-buffer (current-buffer))))) 
    761769 
    762770(defcustom diary-mail-addr 
    …… 
    808816    (insert 
    809817     (if (get-buffer fancy-diary-buffer) 
    810          (save-excursion 
    811            (set-buffer fancy-diary-buffer) 
    812            (buffer-substring (point-min) (point-max))) 
     818         (with-current-buffer fancy-diary-buffer (buffer-string)) 
    813819       "No entries found")) 
    814820    (call-interactively (get mail-user-agent 'sendfunc)))) 
    …… 
    845851are run.  If the optional argument REDRAW is non-nil (which is 
    846852the case interactively, for example) then any existing diary 
    847 marks are first removed. This is intended to deal with deleted 
     853marks are first removed. This is intended to deal with deleted 
    848854diary entries." 
    849855  (interactive "p") 
    …… 
    859865  (let ((marking-diary-entries t) 
    860866        file-glob-attrs marks) 
    861     (save-excursion 
    862       (set-buffer (find-file-noselect (diary-check-diary-file) t)) 
    863       (setq mark-diary-entries-in-calendar t) 
    864       (message "Marking diary entries...") 
    865       (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) 
    866       (let ((d diary-date-forms) 
    867             (old-diary-syntax-table (syntax-table)) 
    868             temp) 
    869         (set-syntax-table diary-syntax-table) 
    870         (while d 
    871           (let* ((date-form (if (equal (car (car d)) 'backup) 
    872                                 (cdr (car d)) 
    873                               (car d)));; ignore 'backup directive 
    874                  (dayname 
    875                   (diary-name-pattern calendar-day-name-array 
    876                                       calendar-day-abbrev-array)) 
    877                  (monthname 
    878                   (format "%s\\|\\*" 
    879                    (diary-name-pattern calendar-month-name-array 
    880                                        calendar-month-abbrev-array))) 
    881                  (month "[0-9]+\\|\\*") 
    882                  (day "[0-9]+\\|\\*") 
    883                  (year "[0-9]+\\|\\*") 
    884                  (l (length date-form)) 
    885                  (d-name-pos (- l (length (memq 'dayname date-form)))) 
    886                  (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) 
    887                  (m-name-pos (- l (length (memq 'monthname date-form)))) 
    888                  (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) 
    889                  (d-pos (- l (length (memq 'day date-form)))) 
    890                  (d-pos (if (/= l d-pos) (+ 2 d-pos))) 
    891                  (m-pos (- l (length (memq 'month date-form)))) 
    892                  (m-pos (if (/= l m-pos) (+ 2 m-pos))) 
    893                  (y-pos (- l (length (memq 'year date-form)))) 
    894                  (y-pos (if (/= l y-pos) (+ 2 y-pos))) 
    895                  (regexp 
    896                   (concat 
    897                    "\\(\\`\\|\^M\\|\n\\)\\(" 
    898                    (mapconcat 'eval date-form "\\)\\(") 
    899                    "\\)")) 
    900                  (case-fold-search t)) 
    901             (goto-char (point-min)) 
    902             (while (re-search-forward regexp nil t) 
    903               (let* ((dd-name 
    904                       (if d-name-pos 
    905                           (buffer-substring-no-properties 
    906                            (match-beginning d-name-pos) 
    907                            (match-end d-name-pos)))) 
    908                      (mm-name 
    909                       (if m-name-pos 
    910                           (buffer-substring-no-properties 
    911                            (match-beginning m-name-pos) 
    912                            (match-end m-name-pos)))) 
    913                      (mm (string-to-number 
    914                           (if m-pos 
    915                               (buffer-substring-no-properties 
    916                                (match-beginning m-pos) 
    917                                (match-end m-pos)) 
    918                             ""))) 
    919                      (dd (string-to-number 
    920                           (if d-pos 
    921                               (buffer-substring-no-properties 
    922                                (match-beginning d-pos) 
    923                                (match-end d-pos)) 
    924                             ""))) 
    925                      (y-str (if y-pos 
    926                                 (buffer-substring-no-properties 
    927                                  (match-beginning y-pos) 
    928                                  (match-end y-pos)))) 
    929                      (yy (if (not y-str) 
    930                              0 
    931                            (if (and (= (length y-str) 2) 
    932                                     abbreviated-calendar-year) 
    933                                (let* ((current-y 
    934                                        (extract-calendar-year 
    935                                         (calendar-current-date))) 
    936                                       (y (+ (string-to-number y-str) 
    937                                             (* 100 
    938                                                (/ current-y 100))))) 
    939                                  (if (> (- y current-y) 50) 
    940                                      (- y 100) 
    941                                    (if (> (- current-y y) 50) 
    942                                        (+ y 100) 
    943                                      y))) 
    944                              (string-to-number y-str)))) 
    945                      (save-excursion 
    946                        (setq entry (buffer-substring-no-properties 
    947                                     (point) (line-end-position)) 
    948                              temp (diary-pull-attrs entry file-glob-attrs) 
    949                              entry (nth 0 temp) 
    950                              marks (nth 1 temp)))) 
    951                 (if dd-name 
    952                     (mark-calendar-days-named 
    953                      (cdr (assoc-string 
    954                            dd-name 
    955                            (calendar-make-alist 
    956                             calendar-day-name-array 
    957                             0 nil calendar-day-abbrev-array) t)) marks) 
    958                   (if mm-name 
    959                       (setq mm 
    960                             (if (string-equal mm-name "*") 0 
    961                               (cdr (assoc-string 
    962                                     mm-name 
    963                                     (calendar-make-alist 
    964                                      calendar-month-name-array 
    965                                      1 nil calendar-month-abbrev-array) t))))) 
    966                   (mark-calendar-date-pattern mm dd yy marks)))) 
    967             (setq d (cdr d)))) 
    968         (mark-sexp-diary-entries) 
    969         (run-hooks 'nongregorian-diary-marking-hook 
    970                    'mark-diary-entries-hook) 
    971         (set-syntax-table old-diary-syntax-table) 
     867    (with-current-buffer (find-file-noselect (diary-check-diary-file) t) 
     868      (save-excursion 
     869        (setq mark-diary-entries-in-calendar t) 
     870        (message "Marking diary entries...") 
     871        (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) 
     872        (with-syntax-table diary-syntax-table 
     873          (dolist (date-form diary-date-forms) 
     874            (if (eq (car date-form) 'backup) 
     875                (setq date-form (cdr date-form))) ;; ignore 'backup directive 
     876            (let* ((dayname 
     877                    (diary-name-pattern calendar-day-name-array 
     878                                        calendar-day-abbrev-array)) 
     879                   (monthname 
     880                    (format "%s\\|\\*" 
     881                            (diary-name-pattern calendar-month-name-array 
     882                                                calendar-month-abbrev-array))) 
     883                   (month "[0-9]+\\|\\*") 
     884                   (day "[0-9]+\\|\\*") 
     885                   (year "[0-9]+\\|\\*") 
     886                   (l (length date-form)) 
     887                   (d-name-pos (- l (length (memq 'dayname date-form)))) 
     888                   (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) 
     889                   (m-name-pos (- l (length (memq 'monthname date-form)))) 
     890                   (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) 
     891                   (d-pos (- l (length (memq 'day date-form)))) 
     892                   (d-pos (if (/= l d-pos) (+ 2 d-pos))) 
     893                   (m-pos (- l (length (memq 'month date-form)))) 
     894                   (m-pos (if (/= l m-pos) (+ 2 m-pos))) 
     895                   (y-pos (- l (length (memq 'year date-form)))) 
     896                   (y-pos (if (/= l y-pos) (+ 2 y-pos))) 
     897                   (regexp 
     898                    (concat 
     899                     "\\(\\`\\|\^M\\|\n\\)\\(" 
     900                     (mapconcat 'eval date-form "\\)\\(") 
     901                     "\\)")) 
     902                   (case-fold-search t)) 
     903              (goto-char (point-min)) 
     904              (while (re-search-forward regexp nil t) 
     905                (let* ((dd-name 
     906                        (if d-name-pos 
     907                            (match-string-no-properties d-name-pos))) 
     908                       (mm-name 
     909                        (if m-name-pos 
     910                            (match-string-no-properties m-name-pos))) 
     911                       (mm (string-to-number 
     912                            (if m-pos 
     913                                (match-string-no-properties m-pos) 
     914                              ""))) 
     915                       (dd (string-to-number 
     916                            (if d-pos 
     917                                (match-string-no-properties d-pos) 
     918                              ""))) 
     919                       (y-str (if y-pos 
     920                                  (match-string-no-properties y-pos))) 
     921                       (yy (if (not y-str) 
     922                               0 
     923                             (if (and (= (length y-str) 2) 
     924                                      abbreviated-calendar-year) 
     925                                 (let* ((current-y 
     926                                         (extract-calendar-year 
     927                                          (calendar-current-date))) 
     928                                        (y (+ (string-to-number y-str) 
     929                                              (* 100 
     930                                                 (/ current-y 100))))) 
     931                                   (if (> (- y current-y) 50) 
     932                                       (- y 100) 
     933                                     (if (> (- current-y y) 50) 
     934                                         (+ y 100) 
     935                                       y))) 
     936                               (string-to-number y-str))))) 
     937                  (let ((tmp (diary-pull-attrs (buffer-substring-no-properties 
     938                                                (point) (line-end-position)) 
     939                                               file-glob-attrs))) 
     940                    (setq entry (nth 0 tmp) 
     941                          marks (nth 1 tmp))) 
     942                  (if dd-name 
     943                      (mark-calendar-days-named 
     944                       (cdr (assoc-string 
     945                             dd-name 
     946                             (calendar-make-alist 
     947                              calendar-day-name-array 
     948                              0 nil calendar-day-abbrev-array) t)) marks) 
     949                    (if mm-name 
     950                        (setq mm 
     951                              (if (string-equal mm-name "*") 0 
     952                                (cdr (assoc-string 
     953                                      mm-name 
     954                                      (calendar-make-alist 
     955                                       calendar-month-name-array 
     956                                       1 nil calendar-month-abbrev-array) t))))) 
     957                    (mark-calendar-date-pattern mm dd yy marks)))))) 
     958          (mark-sexp-diary-entries) 
     959          (run-hooks 'nongregorian-diary-marking-hook 
     960                     'mark-diary-entries-hook)) 
    972961        (message "Marking diary entries...done"))))) 
    973962 
    …… 
    983972         (file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) 
    984973         m y first-date last-date mark file-glob-attrs) 
    985     (save-excursion 
    986       (set-buffer calendar-buffer) 
     974    (with-current-buffer calendar-buffer 
    987975      (setq m displayed-month) 
    988976      (setq y displayed-year)) 
    …… 
    10491037  (while (re-search-forward 
    10501038          (concat 
    1051            "\\(\\`\\|\^M\\|\n\\)" 
     1039           "\\(?:\\`\\|\^M\\|\n\\)" 
    10521040           (regexp-quote diary-include-string) 
    10531041           " \"\\([^\"]*\\)\"") 
    10541042          nil t) 
    10551043    (let* ((diary-file (substitute-in-file-name 
    1056                         (match-string-no-properties 2))) 
     1044                        (match-string-no-properties 1))) 
    10571045           (mark-diary-entries-hook 'mark-included-diary-files) 
    10581046           (dbuff (find-buffer-visiting diary-file))) 
    …… 
    10741062  "Mark all dates in the calendar window that are day DAYNAME of the week. 
    107510630 means all Sundays, 1 means all Mondays, and so on." 
    1076   (save-excursion 
    1077     (set-buffer calendar-buffer) 
     1064  (with-current-buffer calendar-buffer 
    10781065    (let ((prev-month displayed-month) 
    10791066          (prev-year displayed-year) 
    …… 
    10951082  "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. 
    10961083A value of 0 in any position is a wildcard." 
    1097   (save-excursion 
    1098     (set-buffer calendar-buffer) 
     1084  (with-current-buffer calendar-buffer 
    10991085    (let ((m displayed-month) 
    11001086          (y displayed-year)) 
    …… 
    11531139            "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" 
    11541140            s) 
    1155            (+ (* 100 (string-to-number 
    1156                       (substring s (match-beginning 1) (match-end 1)))) 
    1157               (string-to-number (substring s (match-beginning 2) (match-end 2))))) 
     1141           (+ (* 100 (string-to-number (match-string 1 s))) 
     1142              (string-to-number (match-string 2 s)))) 
    11581143          ((string-match        ; Hour only  XXam or XXpm 
    11591144            "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) 
    1160            (+ (* 100 (% (string-to-number 
    1161                            (substring s (match-beginning 1) (match-end 1))) 
    1162                           12)) 
     1145           (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) 
    11631146              (if (equal ?a (downcase (aref s (match-beginning 2)))) 
    11641147                  0 1200))) 
    11651148          ((string-match        ; Hour and minute  XX:XXam or XX:XXpm 
    11661149            "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) 
    1167            (+ (* 100 (% (string-to-number 
    1168                            (substring s (match-beginning 1) (match-end 1))) 
    1169                           12)) 
    1170               (string-to-number (substring s (match-beginning 2) (match-end 2))) 
     1150           (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) 
     1151              (string-to-number (match-string 2 s)) 
    11711152              (if (equal ?a (downcase (aref s (match-beginning 3)))) 
    11721153                  0 1200))) 
    …… 
    14051386                     (beep) 
    14061387                     (message "Bad sexp at line %d in %s: %s" 
    1407                               (save-excursion 
    1408                                 (save-restriction 
    1409                                   (narrow-to-region 1 (point)) 
    1410                                   (goto-char (point-min)) 
    1411                                   (let ((lines 1)) 
    1412                                     (while (re-search-forward "\n\\|\^M" nil t) 
    1413                                       (setq lines (1+ lines))) 
    1414                                     lines))) 
     1388                              (count-lines (point-min) (point)) 
    14151389                              diary-file sexp) 
    14161390                     (sleep-for 2)))))) 
    …… 
    16891663  (let ((pop-up-frames (window-dedicated-p (selected-window)))) 
    16901664    (find-file-other-window (substitute-in-file-name (or file diary-file)))) 
    1691   (add-hook 'write-contents-functions 'diary-redraw-calendar nil t) 
    1692   (when selective-display 
    1693     (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) 
    1694     (setq selective-display nil) 
    1695     (kill-local-variable 'mode-line-format)) 
     1665  (add-hook 'after-save-hook 'diary-redraw-calendar nil t) 
    16961666  (widen) 
     1667  (diary-unhide-everything) 
    16971668  (goto-char (point-max)) 
    16981669  (when (let ((case-fold-search t)) 
    …… 
    17021673    (beginning-of-line) 
    17031674    (insert "\n") 
    1704     (previous-line 1)) 
     1675    (forward-line -1)) 
    17051676  (insert 
    17061677   (if (bolp) "" "\n") 
    …… 
    17991770     arg))) 
    18001771 
     1772(defvar diary-mode-map 
     1773  (let ((map (make-sparse-keymap))) 
     1774    (define-key map "\C-c\C-s" 'diary-show-all-entries) 
     1775    (define-key map "\C-c\C-q" 'quit-window) 
     1776    map) 
     1777  "Keymap for `diary-mode'.") 
     1778 
    18011779;;;###autoload 
    1802 (define-derived-mode diary-mode fundamental-mode 
    1803   "Diary" 
     1780(define-derived-mode diary-mode fundamental-mode "Diary" 
    18041781  "Major mode for editing the diary file." 
    18051782  (set (make-local-variable 'font-lock-defaults) 
    1806        '(diary-font-lock-keywords t))) 
     1783       '(diary-font-lock-keywords t)) 
     1784  (add-to-invisibility-spec '(diary . nil)) 
     1785  (add-hook 'after-save-hook 'diary-redraw-calendar nil t) 
     1786  (if diary-header-line-flag 
     1787      (setq header-line-format diary-header-line-format))) 
    18071788 
    18081789(define-derived-mode fancy-diary-display-mode fundamental-mode 
    …… 
    18111792  (set (make-local-variable 'font-lock-defaults) 
    18121793       '(fancy-diary-font-lock-keywords t)) 
    1813   (define-key (current-local-map) "q" 'quit-window)) 
     1794  (local-set-key "q" 'quit-window)) 
    18141795 
    18151796 
    …… 
    18371818 
    18381819 
    1839 (defun font-lock-diary-sexps (limit) 
     1820(defun diary-font-lock-sexps (limit) 
    18401821  "Recognize sexp diary entry for font-locking." 
    18411822  (if (re-search-forward 
    …… 
    18521833        (error t)))) 
    18531834 
    1854 (defun font-lock-diary-date-forms (month-array &optional symbol abbrev-array) 
     1835(defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array) 
    18551836  "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. 
    18561837If given, optional SYMBOL must be a prefix to entries. 
    …… 
    18661847        (day "\\([0-9]+\\|\\*\\)") 
    18671848        (year "-?\\([0-9]+\\|\\*\\)")) 
    1868     (mapcar '(lambda (x) 
     1849    (mapcar (lambda (x) 
    18691850               (cons 
    18701851                (concat "^" (regexp-quote diary-nonmarking-symbol) "?" 
    …… 
    18741855                                   ;; and last item (not part of date)&