/[emacs]/emacs/lisp/calendar/diary-lib.el
ViewVC logotype

Diff of /emacs/lisp/calendar/diary-lib.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.101 by cdominik, Thu Aug 25 07:11:10 2005 UTC revision 1.102 by monnier, Mon Sep 12 21:21:42 2005 UTC
# Line 58  does nothing.  This function is suitable Line 58  does nothing.  This function is suitable
58    (interactive "P")    (interactive "P")
59    (diary-check-diary-file)    (diary-check-diary-file)
60    (let ((date (calendar-current-date)))    (let ((date (calendar-current-date)))
61      (list-diary-entries      (diary-list-entries date (if arg (prefix-numeric-value arg)))))
      date  
      (cond (arg (prefix-numeric-value arg))  
            ((vectorp number-of-diary-entries)  
             (aref number-of-diary-entries (calendar-day-of-week date)))  
            (t number-of-diary-entries)))))  
62    
63  (defun view-diary-entries (arg)  (define-obsolete-function-alias 'view-diary-entries 'diary-view-entries)
64    (defun diary-view-entries (&optional arg)
65    "Prepare and display a buffer with diary entries.    "Prepare and display a buffer with diary entries.
66  Searches the file named in `diary-file' for entries that  Searches the file named in `diary-file' for entries that
67  match ARG days starting with the date indicated by the cursor position  match ARG days starting with the date indicated by the cursor position
68  in the displayed three-month calendar."  in the displayed three-month calendar."
69    (interactive "p")    (interactive "p")
70    (diary-check-diary-file)    (diary-check-diary-file)
71    (list-diary-entries (calendar-cursor-to-date t) arg))    (diary-list-entries (calendar-cursor-to-date t) arg))
72    
73  (defun view-other-diary-entries (arg d-file)  (defun view-other-diary-entries (arg d-file)
74    "Prepare and display buffer of diary entries from an alternative diary file.    "Prepare and display buffer of diary entries from an alternative diary file.
# Line 182  The holidays are those in the list `cale Line 178  The holidays are those in the list `cale
178    "Local time of candle lighting diary entry--applies if date is a Friday.    "Local time of candle lighting diary entry--applies if date is a Friday.
179  No diary entry if there is no sunset on that date.")  No diary entry if there is no sunset on that date.")
180    
181  (defvar diary-syntax-table (copy-syntax-table (standard-syntax-table))  (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)
186    "The syntax table used when parsing dates in the diary file.    "The syntax table used when parsing dates in the diary file.
187  It is the standard syntax table used in Fundamental mode, but with the  It is the standard syntax table used in Fundamental mode, but with the
188  syntax of `*' and `:' changed to be word constituents.")  syntax of `*' and `:' changed to be word constituents.")
189    
 (modify-syntax-entry ?* "w" diary-syntax-table)  
 (modify-syntax-entry ?: "w" diary-syntax-table)  
   
190  (defvar diary-entries-list)  (defvar diary-entries-list)
191  (defvar displayed-year)  (defvar displayed-year)
192  (defvar displayed-month)  (defvar displayed-month)
# Line 243  search." Line 240  search."
240                      regexp (concat diary-glob-file-regexp-prefix regexp))                      regexp (concat diary-glob-file-regexp-prefix regexp))
241                (setq attrvalue nil)                (setq attrvalue nil)
242                (if (re-search-forward regexp (point-max) t)                (if (re-search-forward regexp (point-max) t)
243                    (setq attrvalue (buffer-substring-no-properties                    (setq attrvalue (match-string-no-properties regnum)))
                                    (match-beginning regnum)  
                                    (match-end regnum))))  
244                (if (and attrvalue                (if (and attrvalue
245                         (setq attrvalue (diary-attrtype-convert attrvalue type)))                         (setq attrvalue (diary-attrtype-convert attrvalue type)))
246                    (setq ret-attr (append ret-attr (list attrname attrvalue))))                    (setq ret-attr (append ret-attr (list attrname attrvalue))))
# Line 264  search." Line 259  search."
259              (setq attrvalue nil)              (setq attrvalue nil)
260              (if (string-match regexp entry)              (if (string-match regexp entry)
261                  (progn                  (progn
262                    (setq attrvalue (substring-no-properties entry                    (setq attrvalue (match-string-no-properties regnum entry))
                                                            (match-beginning regnum)  
                                                            (match-end regnum)))  
263                    (setq entry (replace-match "" t t entry))))                    (setq entry (replace-match "" t t entry))))
264              (if (and attrvalue              (if (and attrvalue
265                       (setq attrvalue (diary-attrtype-convert attrvalue type)))                       (setq attrvalue (diary-attrtype-convert attrvalue type)))
# Line 299  Only used if `diary-header-line-flag' is Line 292  Only used if `diary-header-line-flag' is
292    
293  (defvar diary-saved-point)              ; internal  (defvar diary-saved-point)              ; internal
294    
295  (defun list-diary-entries (date number)  
296    "Create and display a buffer containing the relevant lines in diary-file.  (defcustom number-of-diary-entries 1
297      "Specifies how many days of diary entries are to be displayed initially.
298    This variable affects the diary display when the command \\[diary] is used,
299    or if the value of the variable `view-diary-entries-initially' is t.  For
300    example, if the default value 1 is used, then only the current day's diary
301    entries will be displayed.  If the value 2 is used, then both the current
302    day's and the next day's entries will be displayed.
303    
304    The value can also be a vector such as [0 2 2 2 2 4 1]; this value
305    says to display no diary entries on Sunday, the display the entries
306    for the current date and the day after on Monday through Thursday,
307    display Friday through Monday's entries on Friday, and display only
308    Saturday's entries on Saturday.
309    
310    This variable does not affect the diary display with the `d' command
311    from the calendar; in that case, the prefix argument controls the
312    number 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'.
327  The arguments are DATE and NUMBER; the entries selected are those  The arguments are DATE and NUMBER; the entries selected are those
328  for NUMBER days starting with date DATE.  The other entries are hidden  for NUMBER days starting with date DATE.  The other entries are hidden
329  using selective display.  If NUMBER is less than 1, this function does nothing.  using selective display.  If NUMBER is less than 1, this function does nothing.
# Line 332  These hooks have the following distinct Line 355  These hooks have the following distinct
355    
356      `diary-hook' is run last.  This can be used for an appointment      `diary-hook' is run last.  This can be used for an appointment
357          notification function."          notification function."
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)))
362    (when (> number 0)    (when (> number 0)
363      (let ((original-date date);; save for possible use in the hooks      (let ((original-date date);; save for possible use in the hooks
           old-diary-syntax-table  
364            diary-entries-list            diary-entries-list
365            file-glob-attrs            file-glob-attrs
366            (date-string (calendar-date-string date))            (date-string (calendar-date-string date))
# Line 356  These hooks have the following distinct Line 381  These hooks have the following distinct
381              (setq selective-display-ellipses nil)              (setq selective-display-ellipses nil)
382              (if diary-header-line-flag              (if diary-header-line-flag
383                  (setq header-line-format diary-header-line-format))                  (setq header-line-format diary-header-line-format))
384              (setq old-diary-syntax-table (syntax-table))              (with-syntax-table diary-syntax-table
385              (set-syntax-table diary-syntax-table)                (let ((buffer-read-only nil)
386              (unwind-protect                      (diary-modified (buffer-modified-p))
387                  (let ((buffer-read-only nil)                      (mark (regexp-quote diary-nonmarking-symbol)))
388                        (diary-modified (buffer-modified-p))                  ;; First and last characters must be ^M or \n for
389                        (mark (regexp-quote diary-nonmarking-symbol)))                  ;; selective display to work properly
390                    ;; First and last characters must be ^M or \n for                  (goto-char (1- (point-max)))
391                    ;; selective display to work properly                  (if (not (looking-at "\^M\\|\n"))
392                    (goto-char (1- (point-max)))                      (progn
393                    (if (not (looking-at "\^M\\|\n"))                        (goto-char (point-max))
394                        (progn                        (insert "\^M")))
395                          (goto-char (point-max))                  (goto-char (point-min))
396                          (insert "\^M")))                  (if (not (looking-at "\^M\\|\n"))
397                    (goto-char (point-min))                      (insert "\^M"))
398                    (if (not (looking-at "\^M\\|\n"))                  (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
399                        (insert "\^M"))                  (calendar-for-loop
400                    (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)                   i from 1 to number do
401                    (calendar-for-loop                   (let ((month (extract-calendar-month date))
402                     i from 1 to number do                         (day (extract-calendar-day date))
403                     (let ((d diary-date-forms)                         (year (extract-calendar-year date))
404                           (month (extract-calendar-month date))                         (entry-found (list-sexp-diary-entries date)))
405                           (day (extract-calendar-day date))                     (dolist (date-form diary-date-forms)
406                           (year (extract-calendar-year date))                       (let*
407                           (entry-found (list-sexp-diary-entries date)))                           ((backup (when (eq (car date-form) 'backup)
408                       (while d                                      (setq date-form (cdr date-form))
409                         (let*                                      t))
410                             ((date-form (if (equal (car (car d)) 'backup)                            (dayname
411                                             (cdr (car d))                             (format "%s\\|%s\\.?"
412                                           (car d)))                                     (calendar-day-name date)
413                              (backup (equal (car (car d)) 'backup))                                     (calendar-day-name date 'abbrev)))
414                              (dayname                            (monthname
415                               (format "%s\\|%s\\.?"                             (format "\\*\\|%s\\|%s\\.?"
416                                       (calendar-day-name date)                                     (calendar-month-name month)
417                                       (calendar-day-name date 'abbrev)))                                     (calendar-month-name month 'abbrev)))
418                              (monthname                            (month (concat "\\*\\|0*" (int-to-string month)))
419                               (format "\\*\\|%s\\|%s\\.?"                            (day (concat "\\*\\|0*" (int-to-string day)))
420                                       (calendar-month-name month)                            (year
421                                       (calendar-month-name month 'abbrev)))                             (concat
422                              (month (concat "\\*\\|0*" (int-to-string month)))                              "\\*\\|0*" (int-to-string year)
423                              (day (concat "\\*\\|0*" (int-to-string day)))                              (if abbreviated-calendar-year
424                              (year                                  (concat "\\|" (format "%02d" (% year 100)))
425                               (concat                                "")))
426                                "\\*\\|0*" (int-to-string year)                            (regexp
427                                (if abbreviated-calendar-year                             (concat
428                                    (concat "\\|" (format "%02d" (% year 100)))                              "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
429                                  "")))                              (mapconcat 'eval date-form "\\)\\(")
430                              (regexp                              "\\)"))
431                               (concat                            (case-fold-search t))
432                                "\\(\\`\\|\^M\\|\n\\)" mark "?\\("                         (goto-char (point-min))
433                                (mapconcat 'eval date-form "\\)\\(")                         (while (re-search-forward regexp nil t)
434                                "\\)"))                           (if backup (re-search-backward "\\<" nil t))
435                              (case-fold-search t))                           (if (and (or (char-equal (preceding-char) ?\^M)
436                           (goto-char (point-min))                                        (char-equal (preceding-char) ?\n))
437                           (while (re-search-forward regexp nil t)                                    (not (looking-at " \\|\^I")))
438                             (if backup (re-search-backward "\\<" nil t))                               ;;  Diary entry that consists only of date.
439                             (if (and (or (char-equal (preceding-char) ?\^M)                               (backward-char 1)
440                                          (char-equal (preceding-char) ?\n))                             ;; Found a nonempty diary entry--make it
441                                      (not (looking-at " \\|\^I")))                             ;; visible and add it to the list.
442                                 ;;  Diary entry that consists only of date.                             (setq entry-found t)
443                                 (backward-char 1)                             (let ((entry-start (point))
444                               ;; Found a nonempty diary entry--make it                                   date-start temp)
445                               ;; visible and add it to the list.                               (re-search-backward "\^M\\|\n\\|\\`")
446                               (setq entry-found t)                               (setq date-start (point))
447                               (let ((entry-start (point))                               (re-search-forward "\^M\\|\n" nil t 2)
448                                     date-start temp)                               (while (looking-at " \\|\^I")
449                                 (re-search-backward "\^M\\|\n\\|\\`")                                 (re-search-forward "\^M\\|\n" nil t))
450                                 (setq date-start (point))                               (backward-char 1)
451                                 (re-search-forward "\^M\\|\n" nil t 2)                               (subst-char-in-region date-start
452                                 (while (looking-at " \\|\^I")                                                     (point) ?\^M ?\n t)
453                                   (re-search-forward "\^M\\|\n" nil t))                               (setq entry (buffer-substring entry-start (point))
454                                 (backward-char 1)                                     temp (diary-pull-attrs entry file-glob-attrs)
455                                 (subst-char-in-region date-start                                     entry (nth 0 temp))
456                                                       (point) ?\^M ?\n t)                               (add-to-diary-list
457                                 (setq entry (buffer-substring entry-start (point))                                date
458                                       temp (diary-pull-attrs entry file-glob-attrs)                                entry
459                                       entry (nth 0 temp))                                (buffer-substring
460                                 (add-to-diary-list                                 (1+ date-start) (1- entry-start))
461                                  date                                (copy-marker entry-start) (nth 1 temp)))))))
462                                  entry                     (or entry-found
463                                  (buffer-substring                         (not diary-list-include-blanks)
464                                   (1+ date-start) (1- entry-start))                         (setq diary-entries-list
465                                  (copy-marker entry-start) (nth 1 temp))))))                               (append diary-entries-list
466                         (setq d (cdr d)))                                       (list (list date "" "" "" "")))))
467                       (or entry-found                     (setq date
468                           (not diary-list-include-blanks)                           (calendar-gregorian-from-absolute
469                           (setq diary-entries-list                            (1+ (calendar-absolute-from-gregorian date))))
470                                 (append diary-entries-list                     (setq entry-found nil)))
471                                         (list (list date "" "" "" "")))))                  (set-buffer-modified-p diary-modified)))
                      (setq date  
                            (calendar-gregorian-from-absolute  
                             (1+ (calendar-absolute-from-gregorian date))))  
                      (setq entry-found nil)))  
                   (set-buffer-modified-p diary-modified))  
               (set-syntax-table old-diary-syntax-table))  
472              (goto-char (point-min))              (goto-char (point-min))
473              (run-hooks 'nongregorian-diary-listing-hook              (run-hooks 'nongregorian-diary-listing-hook
474                         'list-diary-entries-hook)                         'list-diary-entries-hook)
# Line 459  These hooks have the following distinct Line 478  These hooks have the following distinct
478              (run-hooks 'diary-hook)              (run-hooks 'diary-hook)
479              diary-entries-list))))))              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))
488    
489  (defun include-other-diary-files ()  (defun include-other-diary-files ()
490    "Include the diary entries from other diary files with those of diary-file.    "Include the diary entries from other diary files with those of diary-file.
491  This function is suitable for use in `list-diary-entries-hook';  This function is suitable for use in `list-diary-entries-hook';
# Line 471  changing the variable `diary-include-str Line 498  changing the variable `diary-include-str
498    (goto-char (point-min))    (goto-char (point-min))
499    (while (re-search-forward    (while (re-search-forward
500            (concat            (concat
501             "\\(\\`\\|\^M\\|\n\\)"             "\\(?:\\`\\|\^M\\|\n\\)"
502             (regexp-quote diary-include-string)             (regexp-quote diary-include-string)
503             " \"\\([^\"]*\\)\"")             " \"\\([^\"]*\\)\"")
504            nil t)            nil t)
505      (let* ((diary-file (substitute-in-file-name      (let* ((diary-file (substitute-in-file-name
506                          (buffer-substring-no-properties                          (match-string-no-properties 1)))
                          (match-beginning 2) (match-end 2))))  
507             (diary-list-include-blanks nil)             (diary-list-include-blanks nil)
508             (list-diary-entries-hook 'include-other-diary-files)             (list-diary-entries-hook 'include-other-diary-files)
509             (diary-display-hook 'ignore)             (diary-display-hook 'ignore)
510             (diary-hook nil)             (diary-hook nil))
            (d-buffer (find-buffer-visiting diary-file))  
            (diary-modified (if d-buffer  
                                (save-excursion  
                                  (set-buffer d-buffer)  
                                  (buffer-modified-p)))))  
511        (if (file-exists-p diary-file)        (if (file-exists-p diary-file)
512            (if (file-readable-p diary-file)            (if (file-readable-p diary-file)
513                (unwind-protect                (unwind-protect
514                    (setq diary-entries-list                    (setq diary-entries-list
515                          (append diary-entries-list                          (append diary-entries-list
516                                  (list-diary-entries original-date number)))                                  (list-diary-entries original-date number)))
517                  (save-excursion                  (with-current-buffer (find-buffer-visiting diary-file)
518                    (set-buffer (find-buffer-visiting diary-file))                    (diary-unhide-everything)))
                   (let ((inhibit-read-only t))  
                     (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))  
                   (setq selective-display nil)  
                   (set-buffer-modified-p diary-modified)))  
519              (beep)              (beep)
520              (message "Can't read included diary file %s" diary-file)              (message "Can't read included diary file %s" diary-file)
521              (sleep-for 2))              (sleep-for 2))
# Line 564  changing the variable `diary-include-str Line 581  changing the variable `diary-include-str
581  (defun fancy-diary-display ()  (defun fancy-diary-display ()
582    "Prepare a diary buffer with relevant entries in a fancy, noneditable form.    "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
583  This function is provided for optional use as the `diary-display-hook'."  This function is provided for optional use as the `diary-display-hook'."
584    (save-excursion;; Turn off selective-display in the diary file's buffer.    (with-current-buffer ;; Turn off selective-display in the diary file's buffer.
585      (set-buffer (find-buffer-visiting (substitute-in-file-name diary-file)))        (find-buffer-visiting (substitute-in-file-name diary-file))
586      (let ((diary-modified (buffer-modified-p)))      (diary-unhide-everything))
       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)  
       (setq selective-display nil)  
       (kill-local-variable 'mode-line-format)  
       (set-buffer-modified-p diary-modified)))  
587    (if (or (not diary-entries-list)    (if (or (not diary-entries-list)
588            (and (not (cdr diary-entries-list))            (and (not (cdr diary-entries-list))
589                 (string-equal (car (cdr (car diary-entries-list))) "")))                 (string-equal (car (cdr (car diary-entries-list))) "")))
# Line 740  the actual printing." Line 753  the actual printing."
753                (kill-buffer temp-buffer)))                (kill-buffer temp-buffer)))
754          (error "You don't have a diary buffer!")))))          (error "You don't have a diary buffer!")))))
755    
756  (defun show-all-diary-entries ()  (define-obsolete-function-alias 'show-all-diary-entries 'diary-show-all-entries)
757    (defun diary-show-all-entries ()
758    "Show all of the diary entries in the diary file.    "Show all of the diary entries in the diary file.
759  This function gets rid of the selective display of the diary file so that  This function gets rid of the selective display of the diary file so that
760  all entries, not just some, are visible.  If there is no diary buffer, one  all entries, not just some, are visible.  If there is no diary buffer, one
# Line 748  is created." Line 762  is created."
762    (interactive)    (interactive)
763    (let ((d-file (diary-check-diary-file))    (let ((d-file (diary-check-diary-file))
764          (pop-up-frames (window-dedicated-p (selected-window))))          (pop-up-frames (window-dedicated-p (selected-window))))
765      (save-excursion      (with-current-buffer (or (find-buffer-visiting d-file)
766        (set-buffer (or (find-buffer-visiting d-file)                               (find-file-noselect d-file t))
767                        (find-file-noselect d-file t)))        (diary-unhide-everything))))
       (let ((buffer-read-only nil)  
             (diary-modified (buffer-modified-p)))  
         (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)  
         (setq selective-display nil  
               mode-line-format default-mode-line-format)  
         (display-buffer (current-buffer))  
         (set-buffer-modified-p diary-modified)))))  
768    
769  (defcustom diary-mail-addr  (defcustom diary-mail-addr
770    (if (boundp 'user-mail-address) user-mail-address "")    (if (boundp 'user-mail-address) user-mail-address "")
# Line 807  to run it every morning at 1am." Line 814  to run it every morning at 1am."
814                            (calendar-date-string (calendar-current-date))))                            (calendar-date-string (calendar-current-date))))
815      (insert      (insert
816       (if (get-buffer fancy-diary-buffer)       (if (get-buffer fancy-diary-buffer)
817           (save-excursion           (with-current-buffer fancy-diary-buffer (buffer-string))
            (set-buffer fancy-diary-buffer)  
            (buffer-substring (point-min) (point-max)))  
818         "No entries found"))         "No entries found"))
819      (call-interactively (get mail-user-agent 'sendfunc))))      (call-interactively (get mail-user-agent 'sendfunc))))
820    
# Line 844  marked.  After the entries are marked, t Line 849  marked.  After the entries are marked, t
849  `nongregorian-diary-marking-hook' and `mark-diary-entries-hook'  `nongregorian-diary-marking-hook' and `mark-diary-entries-hook'
850  are run.  If the optional argument REDRAW is non-nil (which is  are run.  If the optional argument REDRAW is non-nil (which is
851  the case interactively, for example) then any existing diary  the case interactively, for example) then any existing diary
852  marks are first removed. This is intended to deal with deleted  marks are first removed.  This is intended to deal with deleted
853  diary entries."  diary entries."
854    (interactive "p")    (interactive "p")
855    ;; To remove any deleted diary entries. Do not redraw when:    ;; To remove any deleted diary entries. Do not redraw when:
# Line 858  diary entries." Line 863  diary entries."
863      (redraw-calendar))      (redraw-calendar))
864    (let ((marking-diary-entries t)    (let ((marking-diary-entries t)
865          file-glob-attrs marks)          file-glob-attrs marks)
866      (save-excursion      (with-current-buffer (find-file-noselect (diary-check-diary-file) t)
       (set-buffer (find-file-noselect (diary-check-diary-file) t))  
867        (setq mark-diary-entries-in-calendar t)        (setq mark-diary-entries-in-calendar t)
868        (message "Marking diary entries...")        (message "Marking diary entries...")
869        (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))        (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
# Line 902  diary entries." Line 906  diary entries."
906              (while (re-search-forward regexp nil t)              (while (re-search-forward regexp nil t)
907                (let* ((dd-name                (let* ((dd-name
908                        (if d-name-pos                        (if d-name-pos
909                            (buffer-substring-no-properties                            (match-string-no-properties d-name-pos)))
                            (match-beginning d-name-pos)  
                            (match-end d-name-pos))))  
910                       (mm-name                       (mm-name
911                        (if m-name-pos                        (if m-name-pos
912                            (buffer-substring-no-properties                            (match-string-no-properties m-name-pos)))
                            (match-beginning m-name-pos)  
                            (match-end m-name-pos))))  
913                       (mm (string-to-number                       (mm (string-to-number
914                            (if m-pos                            (if m-pos
915                                (buffer-substring-no-properties                                (match-string-no-properties m-pos)
                                (match-beginning m-pos)  
                                (match-end m-pos))  
916                              "")))                              "")))
917                       (dd (string-to-number                       (dd (string-to-number
918                            (if d-pos                            (if d-pos
919                                (buffer-substring-no-properties                                (match-string-no-properties d-pos)
                                (match-beginning d-pos)  
                                (match-end d-pos))  
920                              "")))                              "")))
921                       (y-str (if y-pos                       (y-str (if y-pos
922                                  (buffer-substring-no-properties                                  (match-string-no-properties y-pos)))
                                  (match-beginning y-pos)  
                                  (match-end y-pos))))  
923                       (yy (if (not y-str)                       (yy (if (not y-str)
924                               0                               0
925                             (if (and (= (length y-str) 2)                             (if (and (= (length y-str) 2)
# Line 941  diary entries." Line 935  diary entries."
935                                     (if (> (- current-y y) 50)                                     (if (> (- current-y y) 50)
936                                         (+ y 100)                                         (+ y 100)
937                                       y)))                                       y)))
938                               (string-to-number y-str))))                               (string-to-number y-str)))))
939                       (save-excursion                  (save-excursion
940                         (setq entry (buffer-substring-no-properties                    (setq entry (buffer-substring-no-properties
941                                      (point) (line-end-position))                                 (point) (line-end-position))
942                               temp (diary-pull-attrs entry file-glob-attrs)                          temp (diary-pull-attrs entry file-glob-attrs)
943                               entry (nth 0 temp)                          entry (nth 0 temp)
944                               marks (nth 1 temp))))                          marks (nth 1 temp)))
945                  (if dd-name                  (if dd-name
946                      (mark-calendar-days-named                      (mark-calendar-days-named
947                       (cdr (assoc-string                       (cdr (assoc-string
# Line 982  is marked.  See the documentation for th Line 976  is marked.  See the documentation for th
976                            sexp-mark "(diary-remind\\)"))                            sexp-mark "(diary-remind\\)"))
977           (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))           (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
978           m y first-date last-date mark file-glob-attrs)           m y first-date last-date mark file-glob-attrs)
979      (save-excursion      (with-current-buffer calendar-buffer
       (set-buffer calendar-buffer)  
980        (setq m displayed-month)        (setq m displayed-month)
981        (setq y displayed-year))        (setq y displayed-year))
982      (increment-calendar-month m y -1)      (increment-calendar-month m y -1)
# Line 1048  changing the variable `diary-include-str Line 1041  changing the variable `diary-include-str
1041    (goto-char (point-min))    (goto-char (point-min))
1042    (while (re-search-forward    (while (re-search-forward
1043            (concat            (concat
1044             "\\(\\`\\|\^M\\|\n\\)"             "\\(?:\\`\\|\^M\\|\n\\)"
1045             (regexp-quote diary-include-string)             (regexp-quote diary-include-string)
1046             " \"\\([^\"]*\\)\"")             " \"\\([^\"]*\\)\"")
1047            nil t)            nil t)
1048      (let* ((diary-file (substitute-in-file-name      (let* ((diary-file (substitute-in-file-name
1049                          (match-string-no-properties 2)))                          (match-string-no-properties 1)))
1050             (mark-diary-entries-hook 'mark-included-diary-files)             (mark-diary-entries-hook 'mark-included-diary-files)
1051             (dbuff (find-buffer-visiting diary-file)))             (dbuff (find-buffer-visiting diary-file)))
1052        (if (file-exists-p diary-file)        (if (file-exists-p diary-file)
# Line 1073  changing the variable `diary-include-str Line 1066  changing the variable `diary-include-str
1066  (defun mark-calendar-days-named (dayname &optional color)  (defun mark-calendar-days-named (dayname &optional color)
1067    "Mark all dates in the calendar window that are day DAYNAME of the week.    "Mark all dates in the calendar window that are day DAYNAME of the week.
1068  0 means all Sundays, 1 means all Mondays, and so on."  0 means all Sundays, 1 means all Mondays, and so on."
1069    (save-excursion    (with-current-buffer calendar-buffer
     (set-buffer calendar-buffer)  
1070      (let ((prev-month displayed-month)      (let ((prev-month displayed-month)
1071            (prev-year displayed-year)            (prev-year displayed-year)
1072            (succ-month displayed-month)            (succ-month displayed-month)
# Line 1094  changing the variable `diary-include-str Line 1086  changing the variable `diary-include-str
1086  (defun mark-calendar-date-pattern (month day year &optional color)  (defun mark-calendar-date-pattern (month day year &optional color)
1087    "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.    "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
1088  A value of 0 in any position is a wildcard."  A value of 0 in any position is a wildcard."
1089    (save-excursion    (with-current-buffer calendar-buffer
     (set-buffer calendar-buffer)  
1090      (let ((m displayed-month)      (let ((m displayed-month)
1091            (y displayed-year))            (y displayed-year))
1092        (increment-calendar-month m y -1)        (increment-calendar-month m y -1)
# Line 1152  be used instead of a colon (:) to separa Line 1143  be used instead of a colon (:) to separa
1143      (cond ((string-match        ; Military time      (cond ((string-match        ; Military time
1144              "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"              "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
1145              s)              s)
1146             (+ (* 100 (string-to-number             (+ (* 100 (string-to-number (match-string 1 s)))
1147                        (substring s (match-beginning 1) (match-end 1))))                (string-to-number (match-string 2 s))))
               (string-to-number (substring s (match-beginning 2) (match-end 2)))))  
1148            ((string-match        ; Hour only  XXam or XXpm            ((string-match        ; Hour only  XXam or XXpm
1149              "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)              "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
1150             (+ (* 100 (% (string-to-number             (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
                            (substring s (match-beginning 1) (match-end 1)))  
                           12))  
1151                (if (equal ?a (downcase (aref s (match-beginning 2))))                (if (equal ?a (downcase (aref s (match-beginning 2))))
1152                    0 1200)))                    0 1200)))
1153            ((string-match        ; Hour and minute  XX:XXam or XX:XXpm            ((string-match        ; Hour and minute  XX:XXam or XX:XXpm
1154              "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)              "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
1155             (+ (* 100 (% (string-to-number             (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
1156                             (substring s (match-beginning 1) (match-end 1)))                (string-to-number (match-string 2 s))
                           12))  
               (string-to-number (substring s (match-beginning 2) (match-end 2)))  
1157                (if (equal ?a (downcase (aref s (match-beginning 3))))                (if (equal ?a (downcase (aref s (match-beginning 3))))
1158                    0 1200)))                    0 1200)))
1159            (t diary-unknown-time)))) ; Unrecognizable            (t diary-unknown-time)))) ; Unrecognizable
# Line 1404  best if they are nonmarking." Line 1390  best if they are nonmarking."
1390                      (error                      (error
1391                       (beep)                       (beep)
1392                       (message "Bad sexp at line %d in %s: %s"                       (message "Bad sexp at line %d in %s: %s"
1393                                (save-excursion                                (count-lines (point-min) (point))
                                 (save-restriction  
                                   (narrow-to-region 1 (point))  
                                   (goto-char (point-min))  
                                   (let ((lines 1))  
                                     (while (re-search-forward "\n\\|\^M" nil t)  
                                       (setq lines (1+ lines)))  
                                     lines)))  
1394                                diary-file sexp)                                diary-file sexp)
1395                       (sleep-for 2))))))                       (sleep-for 2))))))
1396      (cond ((stringp result) result)      (cond ((stringp result) result)
# Line 1688  If omitted, NONMARKING defaults to nil a Line 1667  If omitted, NONMARKING defaults to nil a
1667  redrawn with the new entry marked, if necessary."  redrawn with the new entry marked, if necessary."
1668    (let ((pop-up-frames (window-dedicated-p (selected-window))))    (let ((pop-up-frames (window-dedicated-p (selected-window))))
1669      (find-file-other-window (substitute-in-file-name (or file diary-file))))      (find-file-other-window (substitute-in-file-name (or file diary-file))))
1670    (add-hook 'write-contents-functions 'diary-redraw-calendar nil t)    (add-hook 'after-save-hook 'diary-redraw-calendar nil t)
   (when selective-display  
     (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)  
     (setq selective-display nil)  
     (kill-local-variable 'mode-line-format))  
1671    (widen)    (widen)
1672      (diary-unhide-everything)
1673    (goto-char (point-max))    (goto-char (point-max))
1674    (when (let ((case-fold-search t))    (when (let ((case-fold-search t))
1675            (search-backward "Local Variables:"            (search-backward "Local Variables:"
# Line 1701  redrawn with the new entry marked, if ne Line 1677  redrawn with the new entry marked, if ne
1677                             t))                             t))
1678      (beginning-of-line)      (beginning-of-line)
1679      (insert "\n")      (insert "\n")
1680      (previous-line 1))      (forward-line -1))
1681    (insert    (insert
1682     (if (bolp) "" "\n")     (if (bolp) "" "\n")
1683     (if nonmarking diary-nonmarking-symbol "")     (if nonmarking diary-nonmarking-symbol "")
# Line 1798  Prefix arg will make the entry nonmarkin Line 1774  Prefix arg will make the entry nonmarkin
1774               (calendar-date-string (calendar-cursor-to-date t) nil t))               (calendar-date-string (calendar-cursor-to-date t) nil t))
1775       arg)))       arg)))
1776    
1777    (defvar diary-mode-map
1778      (let ((map (make-sparse-keymap)))
1779        (define-key map "\C-c\C-s" 'diary-show-all-entries)
1780        (define-key map "\C-c\C-q" 'quit-window)
1781        map)
1782      "Keymap for `diary-mode'.")
1783    
1784  ;;;###autoload  ;;;###autoload
1785  (define-derived-mode diary-mode fundamental-mode  (define-derived-mode diary-mode fundamental-mode "Diary"
   "Diary"  
1786    "Major mode for editing the diary file."    "Major mode for editing the diary file."
1787    (set (make-local-variable 'font-lock-defaults)    (set (make-local-variable 'font-lock-defaults)
1788         '(diary-font-lock-keywords t)))         '(diary-font-lock-keywords t))
1789      (add-to-invisibility-spec '(diary . nil))
1790      (add-hook 'after-save-hook 'diary-redraw-calendar nil t)
1791      (if diary-header-line-flag
1792          (setq header-line-format diary-header-line-format)))
1793    
1794  (define-derived-mode fancy-diary-display-mode fundamental-mode  (define-derived-mode fancy-diary-display-mode fundamental-mode
1795    "Diary"    "Diary"
1796    "Major mode used while displaying diary entries using Fancy Display."    "Major mode used while displaying diary entries using Fancy Display."
1797    (set (make-local-variable 'font-lock-defaults)    (set (make-local-variable 'font-lock-defaults)
1798         '(fancy-diary-font-lock-keywords t))         '(fancy-diary-font-lock-keywords t))
1799    (define-key (current-local-map) "q" 'quit-window))    (local-set-key "q" 'quit-window))
1800    
1801    
1802  (defvar fancy-diary-font-lock-keywords  (defvar fancy-diary-font-lock-keywords
# Line 1836  Prefix arg will make the entry nonmarkin Line 1822  Prefix arg will make the entry nonmarkin
1822    "Keywords to highlight in fancy diary display")    "Keywords to highlight in fancy diary display")
1823    
1824    
1825  (defun font-lock-diary-sexps (limit)  (defun diary-font-lock-sexps (limit)
1826    "Recognize sexp diary entry for font-locking."    "Recognize sexp diary entry for font-locking."
1827    (if (re-search-forward    (if (re-search-forward
1828         (concat "^" (regexp-quote diary-nonmarking-symbol)         (concat "^" (regexp-quote diary-nonmarking-symbol)
# Line 1851  Prefix arg will make the entry nonmarkin Line 1837  Prefix arg will make the entry nonmarkin
1837                t))                t))
1838          (error t))))          (error t))))
1839    
1840  (defun font-lock-diary-date-forms (month-array &optional symbol abbrev-array)  (defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array)
1841    "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.    "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
1842  If given, optional SYMBOL must be a prefix to entries.  If given, optional SYMBOL must be a prefix to entries.
1843  If optional ABBREV-ARRAY is present, the abbreviations constructed  If optional ABBREV-ARRAY is present, the abbreviations constructed
# Line 1865  names." Line 1851  names."
1851          (month "\\([0-9]+\\|\\*\\)")          (month "\\([0-9]+\\|\\*\\)")
1852          (day "\\([0-9]+\\|\\*\\)")          (day "\\([0-9]+\\|\\*\\)")
1853          (year "-?\\([0-9]+\\|\\*\\)"))          (year "-?\\([0-9]+\\|\\*\\)"))
1854      (mapcar '(lambda (x)      (mapcar (lambda (x)
1855                 (cons                 (cons
1856                  (concat "^" (regexp-quote diary-nonmarking-symbol) "?"                  (concat "^" (regexp-quote diary-nonmarking-symbol) "?"
1857                          (if symbol (regexp-quote symbol) "") "\\("                          (if symbol (regexp-quote symbol) "") "\\("
# Line 1873  names." Line 1859  names."
1859                                     ;; If backup, omit first item (backup)                                     ;; If backup, omit first item (backup)
1860                                     ;; and last item (not part of date)                                     ;; and last item (not part of date)
1861                                     (if (equal (car x) 'backup)                                     (if (equal (car x) 'backup)
1862                                         (reverse (cdr (reverse (cdr x))))                                        (nreverse (cdr (reverse (cdr x))))
1863                                       x)                                       x)
1864                                     "")                                     "")
1865                          ;; With backup, last item is not part of date                          ;; With backup, last item is not part of date
# Line 1888  names." Line 1874  names."
1874    
1875  (defvar diary-font-lock-keywords  (defvar diary-font-lock-keywords
1876        (append        (append
1877         (font-lock-diary-date-forms calendar-month-name-array         (diary-font-lock-date-forms calendar-month-name-array
1878                                     nil calendar-month-abbrev-array)                                     nil calendar-month-abbrev-array)
1879         (when (or (memq 'mark-hebrew-diary-entries         (when (or (memq 'mark-hebrew-diary-entries
1880                         nongregorian-diary-marking-hook)                         nongregorian-diary-marking-hook)
1881                   (memq 'list-hebrew-diary-entries                   (memq 'list-hebrew-diary-entries
1882                         nongregorian-diary-listing-hook))                         nongregorian-diary-listing-hook))
1883           (require 'cal-hebrew)           (require 'cal-hebrew)
1884           (font-lock-diary-date-forms           (diary-font-lock-date-forms
1885            calendar-hebrew-month-name-array-leap-year            calendar-hebrew-month-name-array-leap-year
1886            hebrew-diary-entry-symbol))            hebrew-diary-entry-symbol))
1887         (when (or (memq 'mark-islamic-diary-entries         (when (or (memq 'mark-islamic-diary-entries
# Line 1903  names." Line 1889  names."
1889                   (memq 'list-islamic-diary-entries                   (memq 'list-islamic-diary-entries
1890                         nongregorian-diary-listing-hook))                         nongregorian-diary-listing-hook))
1891           (require 'cal-islam)           (require 'cal-islam)
1892           (font-lock-diary-date-forms           (diary-font-lock-date-forms
1893            calendar-islamic-month-name-array            calendar-islamic-month-name-array
1894            islamic-diary-entry-symbol))            islamic-diary-entry-symbol))
1895         (list         (list
# Line 1925  names." Line 1911  names."
1911           (concat "^" (regexp-quote diary-nonmarking-symbol)           (concat "^" (regexp-quote diary-nonmarking-symbol)
1912                   "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")                   "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
1913           '(1 font-lock-reference-face))           '(1 font-lock-reference-face))
1914          '(font-lock-diary-sexps . font-lock-keyword-face)          '(diary-font-lock-sexps . font-lock-keyword-face)
1915          '("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"          '("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"
1916            . font-lock-function-name-face)))            . font-lock-function-name-face)))
1917        "Forms to highlight in diary-mode")        "Forms to highlight in `diary-mode'.")
1918    
1919    
1920  ;; Following code from Dave Love <fx@gnu.org>.  ;; Following code from Dave Love <fx@gnu.org>.
# Line 2087  user is asked to confirm its addition." Line 2073  user is asked to confirm its addition."
2073    
2074  (provide 'diary-lib)  (provide 'diary-lib)
2075    
2076  ;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010  ;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
2077  ;;; diary-lib.el ends here  ;;; diary-lib.el ends here

Legend:
Removed from v.1.101  
changed lines
  Added in v.1.102

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26