emacs: lisp/calendar/diary-lib.el comparison

comparison lisp/calendar/diary-lib.el @ 90228:fa0da9b57058

Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-82 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 542-553) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 116-121) - Merge from emacs--cvs-trunk--0 - Update from CVS

author	Miles Bader <miles@gnu.org>
date	Mon, 19 Sep 2005 10:20:33 +0000
parents	2d92f5c9d6ae 23bf1a7921e0
children	ee12d75eb214

comparison

equal deleted inserted replaced

-:10fe5fadaf89
+:fa0da9b57058
 by the variable `number-of-diary-entries'.  A value of ARG less than 1
 does nothing.  This function is suitable for execution in a `.emacs' file."
 (interactive "P")
 (diary-check-diary-file)
 (let ((date (calendar-current-date)))
-(list-diary-entries
+(diary-list-entries date (if arg (prefix-numeric-value arg)))))
-date
-(cond (arg (prefix-numeric-value arg))
+(define-obsolete-function-alias 'view-diary-entries 'diary-view-entries)
-((vectorp number-of-diary-entries)
+(defun diary-view-entries (&optional arg)
-(aref number-of-diary-entries (calendar-day-of-week date)))
-(t number-of-diary-entries)))))
-(defun view-diary-entries (arg)
 "Prepare and display a buffer with diary entries.
 Searches the file named in `diary-file' for entries that
 match ARG days starting with the date indicated by the cursor position
 in the displayed three-month calendar."
 (interactive "p")
 (diary-check-diary-file)
-(list-diary-entries (calendar-cursor-to-date t) arg))
+(diary-list-entries (calendar-cursor-to-date t) arg))
 (defun view-other-diary-entries (arg d-file)
 "Prepare and display buffer of diary entries from an alternative diary file.
 Searches for entries that match ARG days, starting with the date indicated
 by the cursor position in the displayed three-month calendar.
 (autoload 'diary-sabbath-candles "solar"
 "Local time of candle lighting diary entry--applies if date is a Friday.
 No diary entry if there is no sunset on that date.")
-(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table))
+(defvar diary-syntax-table
+(let ((st (copy-syntax-table (standard-syntax-table))))
+(modify-syntax-entry ?* "w" st)
+(modify-syntax-entry ?: "w" st)
+st)
 "The syntax table used when parsing dates in the diary file.
 It is the standard syntax table used in Fundamental mode, but with the
 syntax of `*' and `:' changed to be word constituents.")
-(modify-syntax-entry ?* "w" diary-syntax-table)
-(modify-syntax-entry ?: "w" diary-syntax-table)
 (defvar diary-entries-list)
 (defvar displayed-year)
 (defvar displayed-month)
 (defvar entry)
 		    attrname (nth 2 attr)
 		    type (nth 3 attr)
 		    regexp (concat diary-glob-file-regexp-prefix regexp))
 	      (setq attrvalue nil)
 	      (if (re-search-forward regexp (point-max) t)
-		  (setq attrvalue (buffer-substring-no-properties
+		  (setq attrvalue (match-string-no-properties regnum)))
-				   (match-beginning regnum)
-				   (match-end regnum))))
 	      (if (and attrvalue
 		       (setq attrvalue (diary-attrtype-convert attrvalue type)))
 		  (setq ret-attr (append ret-attr (list attrname attrvalue))))
 	      (setq attr-list (cdr attr-list)))
 	    (setq fileglobattrs ret-attr))
 		  attrname (nth 2 attr)
 		  type (nth 3 attr))
 	    (setq attrvalue nil)
 	    (if (string-match regexp entry)
 		(progn
-		  (setq attrvalue (substring-no-properties entry
+		  (setq attrvalue (match-string-no-properties regnum entry))
-							   (match-beginning regnum)
-							   (match-end regnum)))
 		  (setq entry (replace-match "" t t entry))))
 	    (if (and attrvalue
 		     (setq attrvalue (diary-attrtype-convert attrvalue type)))
 		(setq ret-attr (append ret-attr (list attrname attrvalue))))
 	    (setq attr-list (cdr attr-list)))))
 :type    'sexp
 :version "22.1")
 (defvar diary-saved-point)		; internal
-(defun list-diary-entries (date number)
-"Create and display a buffer containing the relevant lines in diary-file.
+(defcustom number-of-diary-entries 1
+"Specifies how many days of diary entries are to be displayed initially.
+This variable affects the diary display when the command \\[diary] is used,
+or if the value of the variable `view-diary-entries-initially' is t.  For
+example, if the default value 1 is used, then only the current day's diary
+entries will be displayed.  If the value 2 is used, then both the current
+day's and the next day's entries will be displayed.
+The value can also be a vector such as [0 2 2 2 2 4 1]; this value
+says to display no diary entries on Sunday, the display the entries
+for the current date and the day after on Monday through Thursday,
+display Friday through Monday's entries on Friday, and display only
+Saturday's entries on Saturday.
+This variable does not affect the diary display with the `d' command
+from the calendar; in that case, the prefix argument controls the
+number of days of diary entries displayed."
+:type '(choice (integer :tag "Entries")
+		 (vector :value [0 0 0 0 0 0 0]
+			 (integer :tag "Sunday")
+			 (integer :tag "Monday")
+			 (integer :tag "Tuesday")
+			 (integer :tag "Wednesday")
+			 (integer :tag "Thursday")
+			 (integer :tag "Friday")
+			 (integer :tag "Saturday")))
+:group 'diary)
+(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries)
+(defun diary-list-entries (date number)
+"Create and display a buffer containing the relevant lines in `diary-file'.
 The arguments are DATE and NUMBER; the entries selected are those
 for NUMBER days starting with date DATE.  The other entries are hidden
 using selective display.  If NUMBER is less than 1, this function does nothing.
 Returns a list of all relevant diary entries found, if any, in order by date.
 fancy-diary-display, if desired.  If you want no diary display, use
 add-hook to set this to ignore.
 `diary-hook' is run last.  This can be used for an appointment
 notification function."
+(unless number
+(setq number (if (vectorp number-of-diary-entries)
+(aref number-of-diary-entries (calendar-day-of-week date))
+number-of-diary-entries)))
 (when (> number 0)
 (let ((original-date date);; save for possible use in the hooks
-old-diary-syntax-table
 diary-entries-list
 file-glob-attrs
 (date-string (calendar-date-string date))
 (d-file (substitute-in-file-name diary-file)))
 (message "Preparing diary...")
 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil "")))
 (setq selective-display t)
 (setq selective-display-ellipses nil)
 (if diary-header-line-flag
 (setq header-line-format diary-header-line-format))
-(setq old-diary-syntax-table (syntax-table))
+(with-syntax-table diary-syntax-table
-(set-syntax-table diary-syntax-table)
+(let ((buffer-read-only nil)
-(unwind-protect
+(diary-modified (buffer-modified-p))
-(let ((buffer-read-only nil)
+(mark (regexp-quote diary-nonmarking-symbol)))
-(diary-modified (buffer-modified-p))
+;; First and last characters must be ^M or \n for
-(mark (regexp-quote diary-nonmarking-symbol)))
+;; selective display to work properly
-;; First and last characters must be ^M or \n for
+(goto-char (1- (point-max)))
-;; selective display to work properly
+(if (not (looking-at "\^M\\|\n"))
-(goto-char (1- (point-max)))
+(progn
-(if (not (looking-at "\^M\\|\n"))
+(goto-char (point-max))
-(progn
+(insert "\^M")))
-(goto-char (point-max))
+(goto-char (point-min))
-(insert "\^M")))
+(if (not (looking-at "\^M\\|\n"))
-(goto-char (point-min))
+(insert "\^M"))
-(if (not (looking-at "\^M\\|\n"))
+(subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
-(insert "\^M"))
+(calendar-for-loop
-(subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
+i from 1 to number do
-(calendar-for-loop
+(let ((month (extract-calendar-month date))
-i from 1 to number do
+(day (extract-calendar-day date))
-(let ((d diary-date-forms)
+(year (extract-calendar-year date))
-(month (extract-calendar-month date))
+(entry-found (list-sexp-diary-entries date)))
-(day (extract-calendar-day date))
+(dolist (date-form diary-date-forms)
-(year (extract-calendar-year date))
+(let*
-(entry-found (list-sexp-diary-entries date)))
+((backup (when (eq (car date-form) 'backup)
-(while d
+(setq date-form (cdr date-form))
-(let*
+t))
-((date-form (if (equal (car (car d)) 'backup)
+(dayname
-(cdr (car d))
+(format "%s\\|%s\\.?"
-(car d)))
+(calendar-day-name date)
-(backup (equal (car (car d)) 'backup))
+(calendar-day-name date 'abbrev)))
-(dayname
+(monthname
-(format "%s\\|%s\\.?"
+(format "\\*\\|%s\\|%s\\.?"
-(calendar-day-name date)
+(calendar-month-name month)
-(calendar-day-name date 'abbrev)))
+(calendar-month-name month 'abbrev)))
-(monthname
+(month (concat "\\*\\|0*" (int-to-string month)))
-(format "\\*\\|%s\\|%s\\.?"
+(day (concat "\\*\\|0*" (int-to-string day)))
-(calendar-month-name month)
+(year
-(calendar-month-name month 'abbrev)))
+(concat
-(month (concat "\\*\\|0*" (int-to-string month)))
+"\\*\\|0*" (int-to-string year)
-(day (concat "\\*\\|0*" (int-to-string day)))
+(if abbreviated-calendar-year
-(year
+(concat "\\|" (format "%02d" (% year 100)))
-(concat
+"")))
-"\\*\\|0*" (int-to-string year)
+(regexp
-(if abbreviated-calendar-year
+(concat
-(concat "\\|" (format "%02d" (% year 100)))
+"\\(\\`\\|\^M\\|\n\\)" mark "?\\("
-"")))
+(mapconcat 'eval date-form "\\)\\(")
-(regexp
+"\\)"))
-(concat
+(case-fold-search t))
-"\\(\\`\\|\^M\\|\n\\)" mark "?\\("
+(goto-char (point-min))
-(mapconcat 'eval date-form "\\)\\(")
+(while (re-search-forward regexp nil t)
-"\\)"))
+(if backup (re-search-backward "\\<" nil t))
-(case-fold-search t))
+(if (and (or (char-equal (preceding-char) ?\^M)
-(goto-char (point-min))
+(char-equal (preceding-char) ?\n))
-(while (re-search-forward regexp nil t)
+(not (looking-at " \\|\^I")))
-(if backup (re-search-backward "\\<" nil t))
+;;  Diary entry that consists only of date.
-(if (and (or (char-equal (preceding-char) ?\^M)
+(backward-char 1)
-(char-equal (preceding-char) ?\n))
+;; Found a nonempty diary entry--make it
-(not (looking-at " \\|\^I")))
+;; visible and add it to the list.
-;;  Diary entry that consists only of date.
+(setq entry-found t)
-(backward-char 1)
+(let ((entry-start (point))
-;; Found a nonempty diary entry--make it
+date-start temp)
-;; visible and add it to the list.
+(re-search-backward "\^M\\|\n\\|\\`")
-(setq entry-found t)
+(setq date-start (point))
-(let ((entry-start (point))
+(re-search-forward "\^M\\|\n" nil t 2)
-date-start temp)
+(while (looking-at " \\|\^I")
-(re-search-backward "\^M\\|\n\\|\\`")
+(re-search-forward "\^M\\|\n" nil t))
-(setq date-start (point))
+(backward-char 1)
-(re-search-forward "\^M\\|\n" nil t 2)
+(subst-char-in-region date-start
-(while (looking-at " \\|\^I")
+(point) ?\^M ?\n t)
-(re-search-forward "\^M\\|\n" nil t))
+(setq entry (buffer-substring entry-start (point))
-(backward-char 1)
+temp (diary-pull-attrs entry file-glob-attrs)
-(subst-char-in-region date-start
+entry (nth 0 temp))
-(point) ?\^M ?\n t)
+(add-to-diary-list
-(setq entry (buffer-substring entry-start (point))
+date
-temp (diary-pull-attrs entry file-glob-attrs)
+entry
-entry (nth 0 temp))
+(buffer-substring
-(add-to-diary-list
+(1+ date-start) (1- entry-start))
-date
+(copy-marker entry-start) (nth 1 temp)))))))
-entry
+(or entry-found
-(buffer-substring
+(not diary-list-include-blanks)
-(1+ date-start) (1- entry-start))
+(setq diary-entries-list
-(copy-marker entry-start) (nth 1 temp))))))
+(append diary-entries-list
-(setq d (cdr d)))
+(list (list date "" "" "" "")))))
-(or entry-found
+(setq date
-(not diary-list-include-blanks)
+(calendar-gregorian-from-absolute
-(setq diary-entries-list
+(1+ (calendar-absolute-from-gregorian date))))
-(append diary-entries-list
+(setq entry-found nil)))
-(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))
 (goto-char (point-min))
 (run-hooks 'nongregorian-diary-listing-hook
 'list-diary-entries-hook)
 (if diary-display-hook
 (run-hooks 'diary-display-hook)
 (simple-diary-display))
 (run-hooks 'diary-hook)
 diary-entries-list))))))
+(defun diary-unhide-everything ()
+(setq selective-display nil)
+(let ((inhibit-read-only t)
+(modified (buffer-modified-p)))
+(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
+(set-buffer-modified-p modified))
+(kill-local-variable 'mode-line-format))
 (defun include-other-diary-files ()
 "Include the diary entries from other diary files with those of diary-file.
 This function is suitable for use in `list-diary-entries-hook';
 it enables you to use shared diary files together with your own.
 are obeyed.  You can change the `#include' to some other string by
 changing the variable `diary-include-string'."
 (goto-char (point-min))
 (while (re-search-forward
 (concat
-"\\(\\`\\|\^M\\|\n\\)"
+"\\(?:\\`\\|\^M\\|\n\\)"
 (regexp-quote diary-include-string)
 " \"\\([^\"]*\\)\"")
 nil t)
 (let* ((diary-file (substitute-in-file-name
-(buffer-substring-no-properties
+(match-string-no-properties 1)))
-(match-beginning 2) (match-end 2))))
 (diary-list-include-blanks nil)
 (list-diary-entries-hook 'include-other-diary-files)
 (diary-display-hook 'ignore)
-(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)))))
 (if (file-exists-p diary-file)
 (if (file-readable-p diary-file)
 (unwind-protect
 (setq diary-entries-list
 (append diary-entries-list
 (list-diary-entries original-date number)))
-(save-excursion
+(with-current-buffer (find-buffer-visiting diary-file)
-(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)))
 (beep)
 (message "Can't read included diary file %s" diary-file)
 (sleep-for 2))
 (beep)
 (message "Can't find included diary file %s" diary-file)
 (goto-char (marker-position marker)))))
 (defun fancy-diary-display ()
 "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
 This function is provided for optional use as the `diary-display-hook'."
-(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.
-(set-buffer (find-buffer-visiting (substitute-in-file-name diary-file)))
+(find-buffer-visiting (substitute-in-file-name diary-file))
-(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)))
 (if (or (not diary-entries-list)
 (and (not (cdr diary-entries-list))
 (string-equal (car (cdr (car diary-entries-list))) "")))
 (let* ((holiday-list (if holidays-in-diary-buffer
 (check-calendar-holidays original-date)))
 (make-string (length heading) ?=) "\n")
 (run-hooks 'print-diary-entries-hook)
 (kill-buffer temp-buffer)))
 (error "You don't have a diary buffer!")))))
-(defun show-all-diary-entries ()
+(define-obsolete-function-alias 'show-all-diary-entries 'diary-show-all-entries)
+(defun diary-show-all-entries ()
 "Show all of the diary entries in the diary file.
 This function gets rid of the selective display of the diary file so that
 all entries, not just some, are visible.  If there is no diary buffer, one
 is created."
 (interactive)
 (let ((d-file (diary-check-diary-file))
 (pop-up-frames (window-dedicated-p (selected-window))))
-(save-excursion
+(with-current-buffer (or (find-buffer-visiting d-file)
-(set-buffer (or (find-buffer-visiting d-file)
+(find-file-noselect d-file t))
-(find-file-noselect d-file t)))
+(diary-unhide-everything)
-(let ((buffer-read-only nil)
+(display-buffer (current-buffer)))))
-(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)))))
 (defcustom diary-mail-addr
 (if (boundp 'user-mail-address) user-mail-address "")
 "*Email address that `diary-mail-entries' will send email to."
 :group 'diary
 (compose-mail diary-mail-addr
 (concat "Diary entries generated "
 (calendar-date-string (calendar-current-date))))
 (insert
 (if (get-buffer fancy-diary-buffer)
-(save-excursion
+(with-current-buffer fancy-diary-buffer (buffer-string))
-(set-buffer fancy-diary-buffer)
-(buffer-substring (point-min) (point-max)))
 "No entries found"))
 (call-interactively (get mail-user-agent 'sendfunc))))
 (defun diary-name-pattern (string-array &optional abbrev-array paren)
 "Return a regexp matching the strings in the array STRING-ARRAY.
 Each entry in the diary file visible in the calendar window is
 marked.  After the entries are marked, the hooks
 `nongregorian-diary-marking-hook' and `mark-diary-entries-hook'
 are run.  If the optional argument REDRAW is non-nil (which is
 the case interactively, for example) then any existing diary
-marks are first removed. This is intended to deal with deleted
+marks are first removed.  This is intended to deal with deleted
 diary entries."
 (interactive "p")
 ;; To remove any deleted diary entries. Do not redraw when:
 ;; i) processing #include diary files (else only get the marks from
 ;; the last #include file processed).
 (setq mark-diary-entries-in-calendar nil)
 (redraw-calendar))
 (let ((marking-diary-entries t)
 file-glob-attrs marks)
 (save-excursion
-(set-buffer (find-file-noselect (diary-check-diary-file) t))
+(with-current-buffer (find-file-noselect (diary-check-diary-file) t)
 (setq mark-diary-entries-in-calendar t)
 (message "Marking diary entries...")
 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
-(let ((d diary-date-forms)
+(with-syntax-table diary-syntax-table
-(old-diary-syntax-table (syntax-table))
+(dolist (date-form diary-date-forms)
-temp)
+(if (eq (car date-form) 'backup)
-(set-syntax-table diary-syntax-table)
+(setq date-form (cdr date-form))) ;; ignore 'backup directive
-(while d
+(let* ((dayname
-(let* ((date-form (if (equal (car (car d)) 'backup)
+(diary-name-pattern calendar-day-name-array
-(cdr (car d))
+calendar-day-abbrev-array))
-(car d)));; ignore 'backup directive
+(monthname
-(dayname
+(format "%s\\|\\*"
-(diary-name-pattern calendar-day-name-array
+(diary-name-pattern calendar-month-name-array
-calendar-day-abbrev-array))
+calendar-month-abbrev-array)))
-(monthname
+(month "[0-9]+\\|\\*")
-(format "%s\\|\\*"
+(day "[0-9]+\\|\\*")
-(diary-name-pattern calendar-month-name-array
+(year "[0-9]+\\|\\*")
-calendar-month-abbrev-array)))
+(l (length date-form))
-(month "[0-9]+\\|\\*")
+(d-name-pos (- l (length (memq 'dayname date-form))))
-(day "[0-9]+\\|\\*")
+(d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
-(year "[0-9]+\\|\\*")
+(m-name-pos (- l (length (memq 'monthname date-form))))
-(l (length date-form))
+(m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
-(d-name-pos (- l (length (memq 'dayname date-form))))
+(d-pos (- l (length (memq 'day date-form))))
-(d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
+(d-pos (if (/= l d-pos) (+ 2 d-pos)))
-(m-name-pos (- l (length (memq 'monthname date-form))))
+(m-pos (- l (length (memq 'month date-form))))
-(m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
+(m-pos (if (/= l m-pos) (+ 2 m-pos)))
-(d-pos (- l (length (memq 'day date-form))))
+(y-pos (- l (length (memq 'year date-form))))
-(d-pos (if (/= l d-pos) (+ 2 d-pos)))
+(y-pos (if (/= l y-pos) (+ 2 y-pos)))
-(m-pos (- l (length (memq 'month date-form))))
+(regexp
-(m-pos (if (/= l m-pos) (+ 2 m-pos)))
+(concat
-(y-pos (- l (length (memq 'year date-form))))
+"\\(\\`\\|\^M\\|\n\\)\\("
-(y-pos (if (/= l y-pos) (+ 2 y-pos)))
+(mapconcat 'eval date-form "\\)\\(")
-(regexp
+"\\)"))
-(concat
+(case-fold-search t))
-"\\(\\`\\|\^M\\|\n\\)\\("
+(goto-char (point-min))
-(mapconcat 'eval date-form "\\)\\(")
+(while (re-search-forward regexp nil t)
-"\\)"))
+(let* ((dd-name
-(case-fold-search t))
+(if d-name-pos
-(goto-char (point-min))
+(match-string-no-properties d-name-pos)))
-(while (re-search-forward regexp nil t)
+(mm-name
-(let* ((dd-name
+(if m-name-pos
-(if d-name-pos
+(match-string-no-properties m-name-pos)))
-(buffer-substring-no-properties
+(mm (string-to-number
-(match-beginning d-name-pos)
+(if m-pos
-(match-end d-name-pos))))
+(match-string-no-properties m-pos)
-(mm-name
+"")))
-(if m-name-pos
+(dd (string-to-number
-(buffer-substring-no-properties
+(if d-pos
-(match-beginning m-name-pos)
+(match-string-no-properties d-pos)
-(match-end m-name-pos))))
+"")))
-(mm (string-to-number
+(y-str (if y-pos
-(if m-pos
+(match-string-no-properties y-pos)))
-(buffer-substring-no-properties
+(yy (if (not y-str)
-(match-beginning m-pos)
+0
-(match-end m-pos))
+(if (and (= (length y-str) 2)
-"")))
+abbreviated-calendar-year)
-(dd (string-to-number
+(let* ((current-y
-(if d-pos
+(extract-calendar-year
-(buffer-substring-no-properties
+(calendar-current-date)))
-(match-beginning d-pos)
+(y (+ (string-to-number y-str)
-(match-end d-pos))
+(* 100
-"")))
+(/ current-y 100)))))
-(y-str (if y-pos
+(if (> (- y current-y) 50)
-(buffer-substring-no-properties
+(- y 100)
-(match-beginning y-pos)
+(if (> (- current-y y) 50)
-(match-end y-pos))))
+(+ y 100)
-(yy (if (not y-str)
+y)))
-0
+(string-to-number y-str)))))
-(if (and (= (length y-str) 2)
+(let ((tmp (diary-pull-attrs (buffer-substring-no-properties
-abbreviated-calendar-year)
+(point) (line-end-position))
-(let* ((current-y
+file-glob-attrs)))
-(extract-calendar-year
+(setq entry (nth 0 tmp)
-(calendar-current-date)))
+marks (nth 1 tmp)))
-(y (+ (string-to-number y-str)
+(if dd-name
-(* 100
+(mark-calendar-days-named
-(/ current-y 100)))))
+(cdr (assoc-string
-(if (> (- y current-y) 50)
+dd-name
-(- y 100)
+(calendar-make-alist
-(if (> (- current-y y) 50)
+calendar-day-name-array
-(+ y 100)
+0 nil calendar-day-abbrev-array) t)) marks)
-y)))
+(if mm-name
-(string-to-number y-str))))
+(setq mm
-(save-excursion
+(if (string-equal mm-name "*") 0
-(setq entry (buffer-substring-no-properties
+(cdr (assoc-string
-(point) (line-end-position))
+mm-name
-temp (diary-pull-attrs entry file-glob-attrs)
+(calendar-make-alist
-entry (nth 0 temp)
+calendar-month-name-array
-marks (nth 1 temp))))
+1 nil calendar-month-abbrev-array) t)))))
-(if dd-name
+(mark-calendar-date-pattern mm dd yy marks))))))
-(mark-calendar-days-named
+(mark-sexp-diary-entries)
-(cdr (assoc-string
+(run-hooks 'nongregorian-diary-marking-hook
-dd-name
+'mark-diary-entries-hook))
-(calendar-make-alist
-calendar-day-name-array
-0 nil calendar-day-abbrev-array) t)) marks)
-(if mm-name
-(setq mm
-(if (string-equal mm-name "*") 0
-(cdr (assoc-string
-mm-name
-(calendar-make-alist
-calendar-month-name-array
-1 nil calendar-month-abbrev-array) t)))))
-(mark-calendar-date-pattern mm dd yy marks))))
-(setq d (cdr d))))
-(mark-sexp-diary-entries)
-(run-hooks 'nongregorian-diary-marking-hook
-'mark-diary-entries-hook)
-(set-syntax-table old-diary-syntax-table)
 (message "Marking diary entries...done")))))
 (defun mark-sexp-diary-entries ()
 "Mark days in the calendar window that have sexp diary entries.
 Each entry in the diary file (or included files) visible in the calendar window
 sexp-mark "(\\)\\|\\("
 (regexp-quote diary-nonmarking-symbol)
 sexp-mark "(diary-remind\\)"))
 (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
 m y first-date last-date mark file-glob-attrs)
-(save-excursion
+(with-current-buffer calendar-buffer
-(set-buffer calendar-buffer)
 (setq m displayed-month)
 (setq y displayed-year))
 (increment-calendar-month m y -1)
 (setq first-date
 (calendar-absolute-from-gregorian (list m 1 y)))
 are obeyed.  You can change the `#include' to some other string by
 changing the variable `diary-include-string'."
 (goto-char (point-min))
 (while (re-search-forward
 (concat
-"\\(\\`\\|\^M\\|\n\\)"
+"\\(?:\\`\\|\^M\\|\n\\)"
 (regexp-quote diary-include-string)
 " \"\\([^\"]*\\)\"")
 nil t)
 (let* ((diary-file (substitute-in-file-name
-(match-string-no-properties 2)))
+(match-string-no-properties 1)))
 (mark-diary-entries-hook 'mark-included-diary-files)
 (dbuff (find-buffer-visiting diary-file)))
 (if (file-exists-p diary-file)
 (if (file-readable-p diary-file)
 (progn
 (goto-char (point-min)))
 (defun mark-calendar-days-named (dayname &optional color)
 "Mark all dates in the calendar window that are day DAYNAME of the week.
 0 means all Sundays, 1 means all Mondays, and so on."
-(save-excursion
+(with-current-buffer calendar-buffer
-(set-buffer calendar-buffer)
 (let ((prev-month displayed-month)
 (prev-year displayed-year)
 (succ-month displayed-month)
 (succ-year displayed-year)
 (last-day)
 (setq day (+ day 7))))))
 (defun mark-calendar-date-pattern (month day year &optional color)
 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
 A value of 0 in any position is a wildcard."
-(save-excursion
+(with-current-buffer calendar-buffer
-(set-buffer calendar-buffer)
 (let ((m displayed-month)
 (y displayed-year))
 (increment-calendar-month m y -1)
 (calendar-for-loop i from 0 to 2 do
 (mark-calendar-month m y month day year color)
 be used instead of a colon (:) to separate the hour and minute parts."
 (let ((case-fold-search nil))
 (cond ((string-match        ; Military time
 	    "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
 s)
-	   (+ (* 100 (string-to-number
+	   (+ (* 100 (string-to-number (match-string 1 s)))
-		      (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)))))
 	  ((string-match        ; Hour only  XXam or XXpm
 	    "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
-	   (+ (* 100 (% (string-to-number
+	   (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
-			   (substring s (match-beginning 1) (match-end 1)))
-			  12))
 	      (if (equal ?a (downcase (aref s (match-beginning 2))))
 		  0 1200)))
 	  ((string-match        ; Hour and minute  XX:XXam or XX:XXpm
 	    "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
-	   (+ (* 100 (% (string-to-number
+	   (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
-			   (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)))
 	      (if (equal ?a (downcase (aref s (match-beginning 3))))
 		  0 1200)))
 	  (t diary-unknown-time)))) ; Unrecognizable
 ;; Unrecognizable
 (condition-case nil
 (eval (car (read-from-string sexp)))
 (error
 (beep)
 (message "Bad sexp at line %d in %s: %s"
-(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)))
 diary-file sexp)
 (sleep-for 2))))))
 (cond ((stringp result) result)
 	  ((and (consp result)
 		(stringp (cdr result))) result)
 `diary-file'.  Adds `diary-redraw-calendar' to
 `write-contents-functions' for FILE, so that the calendar will be
 redrawn with the new entry marked, if necessary."
 (let ((pop-up-frames (window-dedicated-p (selected-window))))
 (find-file-other-window (substitute-in-file-name (or file diary-file))))
-(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))
 (widen)
+(diary-unhide-everything)
 (goto-char (point-max))
 (when (let ((case-fold-search t))
 (search-backward "Local Variables:"
 (max (- (point-max) 3000) (point-min))
 t))
 (beginning-of-line)
 (insert "\n")
-(previous-line 1))
+(forward-line -1))
 (insert
 (if (bolp) "" "\n")
 (if nonmarking diary-nonmarking-symbol "")
 string " "))
 (calendar-read "Repeat every how many days: "
 (lambda (x) (> x 0)))
 (calendar-date-string (calendar-cursor-to-date t) nil t))
 arg)))
+(defvar diary-mode-map
+(let ((map (make-sparse-keymap)))
+(define-key map "\C-c\C-s" 'diary-show-all-entries)
+(define-key map "\C-c\C-q" 'quit-window)
+map)
+"Keymap for `diary-mode'.")
 ;;;###autoload
-(define-derived-mode diary-mode fundamental-mode
+(define-derived-mode diary-mode fundamental-mode "Diary"
-"Diary"
 "Major mode for editing the diary file."
 (set (make-local-variable 'font-lock-defaults)
-'(diary-font-lock-keywords t)))
+'(diary-font-lock-keywords t))
+(add-to-invisibility-spec '(diary . nil))
+(add-hook 'after-save-hook 'diary-redraw-calendar nil t)
+(if diary-header-line-flag
+(setq header-line-format diary-header-line-format)))
 (define-derived-mode fancy-diary-display-mode fundamental-mode
 "Diary"
 "Major mode used while displaying diary entries using Fancy Display."
 (set (make-local-variable 'font-lock-defaults)
 '(fancy-diary-font-lock-keywords t))
-(define-key (current-local-map) "q" 'quit-window))
+(local-set-key "q" 'quit-window))
 (defvar fancy-diary-font-lock-keywords
 (list
 (cons
 '("^[ \t]*[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\)?"
 . font-lock-variable-name-face))
 "Keywords to highlight in fancy diary display")
-(defun font-lock-diary-sexps (limit)
+(defun diary-font-lock-sexps (limit)
 "Recognize sexp diary entry for font-locking."
 (if (re-search-forward
 (concat "^" (regexp-quote diary-nonmarking-symbol)
 "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)")
 limit t)
 	      (forward-sexp 1)
 	      (store-match-data (list start (point)))
 	      t))
 	(error t))))
-(defun font-lock-diary-date-forms (month-array &optional symbol abbrev-array)
+(defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array)
 "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
 If given, optional SYMBOL must be a prefix to entries.
 If optional ABBREV-ARRAY is present, the abbreviations constructed
 from this array by the function `calendar-abbrev-construct' are
 matched (with or without a final `.'), in addition to the full month
 (monthname (format "\\(%s\\|\\*\\)"
 (diary-name-pattern month-array abbrev-array)))
 (month "\\([0-9]+\\|\\*\\)")
 (day "\\([0-9]+\\|\\*\\)")
 (year "-?\\([0-9]+\\|\\*\\)"))
-(mapcar '(lambda (x)
+(mapcar (lambda (x)
 (cons
 (concat "^" (regexp-quote diary-nonmarking-symbol) "?"
 (if symbol (regexp-quote symbol) "") "\\("
 (mapconcat 'eval
 ;; If backup, omit first item (backup)
 ;; and last item (not part of date)
 (if (equal (car x) 'backup)
-(reverse (cdr (reverse (cdr x))))
+(nreverse (cdr (reverse (cdr x))))
 x)
 "")
 ;; With backup, last item is not part of date
 (if (equal (car x) 'backup)
 (concat "\\)" (eval (car (reverse x))))
 (eval-when-compile (require 'cal-hebrew)
 (require 'cal-islam))
 (defvar diary-font-lock-keywords
 (append
-(font-lock-diary-date-forms calendar-month-name-array
+(diary-font-lock-date-forms calendar-month-name-array
 nil calendar-month-abbrev-array)
 (when (or (memq 'mark-hebrew-diary-entries
 nongregorian-diary-marking-hook)
 (memq 'list-hebrew-diary-entries
 nongregorian-diary-listing-hook))
 (require 'cal-hebrew)
-(font-lock-diary-date-forms
+(diary-font-lock-date-forms
 calendar-hebrew-month-name-array-leap-year
 hebrew-diary-entry-symbol))
 (when (or (memq 'mark-islamic-diary-entries
 nongregorian-diary-marking-hook)
 (memq 'list-islamic-diary-entries
 nongregorian-diary-listing-hook))
 (require 'cal-islam)
-(font-lock-diary-date-forms
+(diary-font-lock-date-forms
 calendar-islamic-month-name-array
 islamic-diary-entry-symbol))
 (list
 (cons
 (concat "^" (regexp-quote diary-include-string) ".*$")
 '(1 font-lock-reference-face))
 (cons
 (concat "^" (regexp-quote diary-nonmarking-symbol)
 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
 '(1 font-lock-reference-face))
-'(font-lock-diary-sexps . font-lock-keyword-face)
+'(diary-font-lock-sexps . font-lock-keyword-face)
 '("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"
 . font-lock-function-name-face)))
-"Forms to highlight in diary-mode")
+"Forms to highlight in `diary-mode'.")
 ;; Following code from Dave Love <fx@gnu.org>.
 ;; Import Outlook-format appointments from mail messages in Gnus or
 ;; Rmail using command `diary-from-outlook'.  This, or the specialized
 	  (message "Diary entry added"))))))
 (provide 'diary-lib)
-;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
+;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
 ;;; diary-lib.el ends here

Mercurial > emacs

comparison lisp/calendar/diary-lib.el @ 90228:fa0da9b57058