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

comparison lisp/calendar/diary-lib.el @ 90237:aa89c814f853

Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-88 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 569-579) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 129-132) - Update from CVS - Merge from emacs--cvs-trunk--0

author	Miles Bader <miles@gnu.org>
date	Fri, 07 Oct 2005 07:15:40 +0000
parents	ee12d75eb214 8c8c651e39cc
children	5e2d3828e89f

comparison

equal deleted inserted replaced

-:7871ecd1281b
+:aa89c814f853
 ;; This can be removed once the kill/yank treatment of invisible text
 ;; (see etc/TODO) is fixed. -- gm
 (defcustom diary-header-line-flag t
-"*If non-nil, `simple-diary-display' will show a header line.
+"If non-nil, `diary-simple-display' will show a header line.
 The format of the header is specified by `diary-header-line-format'."
 :group   'diary
 :type    'boolean
 :version "22.1")
+(defvar diary-selective-display nil)
 (defcustom diary-header-line-format
 '(:eval (calendar-string-spread
-(list (if selective-display
+(list (if diary-selective-display
 "Selective display active - press \"s\" in calendar \
 before edit/copy"
 "Diary"))
 ?\s (frame-width)))
-"*Format of the header line displayed by `simple-diary-display'.
+"Format of the header line displayed by `diary-simple-display'.
 Only used if `diary-header-line-flag' is non-nil."
 :group   'diary
 :type    'sexp
 :version "22.1")
 			 (integer :tag "Friday")
 			 (integer :tag "Saturday")))
 :group 'diary)
 (define-obsolete-function-alias 'list-diary-entries 'diary-list-entries)
-(defun diary-list-entries (date number)
+(defun diary-list-entries (date number &optional list-only)
 "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.
-The list entries have the form ((month day year) string specifier) where
+The list entries have the form ((MONTH DAY YEAR) STRING SPECIFIER) where
-\(month day year) is the date of the entry, string is the entry text, and
+\(MONTH DAY YEAR) is the date of the entry, STRING is the entry text, and
-specifier is the applicability.  If the variable `diary-list-include-blanks'
+SPECIFIER is the applicability.  If the variable `diary-list-include-blanks'
-is t, this list includes a dummy diary entry consisting of the empty string)
+is t, this list includes a dummy diary entry consisting of the empty string
 for a date with no diary entries.
 After the list is prepared, the hooks `nongregorian-diary-listing-hook',
 `list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run.
 These hooks have the following distinct roles:
 nil, simple-diary-display will be used.  Use add-hook to set this to
 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."
+notification function.
+If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
 (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)
 (if (not diary-buffer)
 (set-buffer (find-file-noselect d-file t))
 (set-buffer diary-buffer)
 (or (verify-visited-file-modtime diary-buffer)
 (revert-buffer t t))))
+;; Setup things like the header-line-format and invisibility-spec.
+(when (eq major-mode 'fundamental-mode) (diary-mode))
 ;; d-s-p is passed to the diary display function.
 (let ((diary-saved-point (point)))
 (save-excursion
 (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))
 (with-syntax-table diary-syntax-table
-(let ((buffer-read-only nil)
+(let ((mark (regexp-quote diary-nonmarking-symbol)))
-(diary-modified (buffer-modified-p))
-(mark (regexp-quote diary-nonmarking-symbol)))
-;; First and last characters must be ^M or \n for
-;; selective display to work properly
-(goto-char (1- (point-max)))
-(if (not (looking-at "\^M\\|\n"))
-(progn
-(goto-char (point-max))
-(insert "\^M")))
 (goto-char (point-min))
-(if (not (looking-at "\^M\\|\n"))
+(unless list-only
-(insert "\^M"))
+(let ((ol (make-overlay (point-min) (point-max) nil t nil)))
-(subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
+(set (make-local-variable 'diary-selective-display) t)
+(overlay-put ol 'invisible 'diary)
+(overlay-put ol 'evaporate t)))
 (calendar-for-loop
 i from 1 to number do
 (let ((month (extract-calendar-month date))
 (day (extract-calendar-day date))
 (year (extract-calendar-year date))
 (concat "\\|" (format "%02d" (% year 100)))
 "")))
 (regexp
 (concat
 "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
-(mapconcat 'eval date-form "\\)\\(")
+(mapconcat 'eval date-form "\\)\\(?:")
 "\\)"))
 (case-fold-search t))
 (goto-char (point-min))
 (while (re-search-forward regexp nil t)
 (if backup (re-search-backward "\\<" nil t))
 (setq date-start (point))
 (re-search-forward "\^M\\|\n" nil t 2)
 (while (looking-at " \\|\^I")
 (re-search-forward "\^M\\|\n" nil t))
 (backward-char 1)
-(subst-char-in-region date-start
+(unless list-only
-(point) ?\^M ?\n t)
+(remove-overlays date-start (point)
+'invisible 'diary))
 (setq entry (buffer-substring entry-start (point))
 temp (diary-pull-attrs entry file-glob-attrs)
 entry (nth 0 temp))
 (add-to-diary-list
 date
 (append diary-entries-list
 (list (list date "" "" "" "")))))
 (setq date
 (calendar-gregorian-from-absolute
 (1+ (calendar-absolute-from-gregorian date))))
-(setq entry-found nil)))
+(setq entry-found nil)))))
-(set-buffer-modified-p diary-modified)))
 (goto-char (point-min))
 (run-hooks 'nongregorian-diary-listing-hook
 'list-diary-entries-hook)
-(if diary-display-hook
+(unless list-only
-(run-hooks 'diary-display-hook)
+(if diary-display-hook
-(simple-diary-display))
+(run-hooks 'diary-display-hook)
+(simple-diary-display)))
 (run-hooks 'diary-hook)
 diary-entries-list))))))
 (defun diary-unhide-everything ()
-(setq selective-display nil)
+(kill-local-variable 'diary-selective-display)
-(let ((inhibit-read-only t)
+(remove-overlays (point-min) (point-max) 'invisible 'diary)
-(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';
 (goto-char (point-min))
 (set-buffer-modified-p nil)
 (setq buffer-read-only t)
 (display-buffer holiday-buffer)
 (message  "No diary entries for %s" date-string)))
-(save-excursion;; Prepare the fancy diary buffer.
+(with-current-buffer;; Prepare the fancy diary buffer.
-(set-buffer (make-fancy-diary-buffer))
+(make-fancy-diary-buffer)
 (setq buffer-read-only nil)
 (let ((entry-list diary-entries-list)
 (holiday-list)
 (holiday-list-last-month 1)
 (holiday-list-last-year 1)
 		(save-excursion
 (let* ((marks (nth 4 (car entry-list)))
 (temp-face (make-symbol
 (apply
 'concat "temp-face-"
-(mapcar '(lambda (sym)
+(mapcar (lambda (sym)
 (if (stringp sym)
 sym
 (symbol-name sym)))
 marks))))
 (faceinfo marks))
 (make-face temp-face)
 ;; Remove :face info from the marks,
 ;; copy the face info into temp-face
 (while (setq faceinfo (memq :face faceinfo))
 (copy-face (read (nth 1 faceinfo)) temp-face)
 (setcar faceinfo nil)
 (setcar (cdr faceinfo) nil))
 (setq marks (delq nil marks))
-		  ;; Apply the font aspects
+;; Apply the font aspects.
 (apply 'set-face-attribute temp-face nil marks)
 (search-backward entry)
 (overlay-put
 (make-overlay (match-beginning 0) (match-end 0))
 'face temp-face)))))
 (calendar-set-mode-line date-string)
 (message "Preparing diary...done"))))
 (defun make-fancy-diary-buffer ()
 "Create and return the initial fancy diary buffer."
-(save-excursion
+(with-current-buffer (get-buffer-create fancy-diary-buffer)
-(set-buffer (get-buffer-create fancy-diary-buffer))
 (setq buffer-read-only nil)
 (calendar-set-mode-line "Diary Entries")
 (erase-buffer)
 (set-buffer-modified-p nil)
 (setq buffer-read-only t)
 The hooks given by the variable `print-diary-entries-hook' are called to do
 the actual printing."
 (interactive)
 (if (bufferp (get-buffer fancy-diary-buffer))
-(save-excursion
+(with-current-buffer (get-buffer fancy-diary-buffer)
-(set-buffer (get-buffer fancy-diary-buffer))
 (run-hooks 'print-diary-entries-hook))
 (let ((diary-buffer
 (find-buffer-visiting (substitute-in-file-name diary-file))))
 (if diary-buffer
-(let ((temp-buffer (get-buffer-create "*Printable Diary Entries*"))
+(let ((temp-buffer (get-buffer-create " *Printable Diary Entries*"))
 (heading))
-(save-excursion
+(with-current-buffer diary-buffer
-(set-buffer diary-buffer)
 (setq heading
 (if (not (stringp mode-line-format))
 "All Diary Entries"
 (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
-(substring mode-line-format
+(match-string 1 mode-line-format)))
-(match-beginning 1) (match-end 1))))
+(let ((start (point-min))
-(copy-to-buffer temp-buffer (point-min) (point-max))
+end)
+(while
+(progn
+(setq end (next-single-char-property-change
+start 'invisible))
+(if (get-char-property start 'invisible)
+nil
+(with-current-buffer temp-buffer
+(insert-buffer-substring diary-buffer
+start (or end (point-max)))))
+(setq start end)
+(and end (< end (point-max))))))
 (set-buffer temp-buffer)
-(while (re-search-forward "\^M.*$" nil t)
-(replace-match ""))
 (goto-char (point-min))
 (insert heading "\n"
 (make-string (length heading) ?=) "\n")
 (run-hooks 'print-diary-entries-hook)
 (kill-buffer temp-buffer)))
 (interactive)
 (let ((d-file (diary-check-diary-file))
 (pop-up-frames (window-dedicated-p (selected-window))))
 (with-current-buffer (or (find-buffer-visiting d-file)
 (find-file-noselect d-file t))
+(when (eq major-mode 'fundamental-mode) (diary-mode))
 (diary-unhide-everything)
 (display-buffer (current-buffer)))))
 (defcustom diary-mail-addr
 (if (boundp 'user-mail-address) user-mail-address "")
-"*Email address that `diary-mail-entries' will send email to."
+"Email address that `diary-mail-entries' will send email to."
 :group 'diary
 :type  'string
 :version "20.3")
 (defcustom diary-mail-days 7
-"*Default number of days for `diary-mail-entries' to check."
+"Default number of days for `diary-mail-entries' to check."
 :group 'diary
 :type 'integer
 :version "20.3")
 ;;;###autoload
 (redraw-calendar))
 (let ((marking-diary-entries t)
 file-glob-attrs marks)
 (with-current-buffer (find-file-noselect (diary-check-diary-file) t)
 (save-excursion
+(when (eq major-mode 'fundamental-mode) (diary-mode))
 (setq mark-diary-entries-in-calendar t)
 (message "Marking diary entries...")
 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
 (with-syntax-table diary-syntax-table
 (dolist (date-form diary-date-forms)
 (and (= t1 t2)
 (string-lessp ts1 ts2)))))))
 (defcustom diary-unknown-time
 -9999
-"*Value returned by diary-entry-time when no time is found.
+"Value returned by diary-entry-time when no time is found.
 The default value -9999 causes entries with no recognizable time to be placed
 before those with times; 9999 would place entries with no recognizable time
 after those with times."
 :type 'integer
 :group 'diary
 	  (setq entry (if (consp diary-entry)
 			  (cdr diary-entry)
 			diary-entry))
 (if diary-entry
 	      (progn
-		(subst-char-in-region line-start (point) ?\^M ?\n t)
+(remove-overlays line-start (point) 'invisible 'diary)
 		(if (< 0 (length entry))
 		    (setq temp (diary-pull-attrs entry file-glob-attrs)
 			  entry (nth 0 temp)
 			  marks (nth 1 temp)))))
 	  (add-to-diary-list date
 					  (calendar-last-day-of-month m2 y2)))
 				d2)))))
 	     (cons mark entry)))))
-(defun diary-anniversary (month day year &optional mark)
+(defun diary-anniversary (month day &optional year mark)
 "Anniversary diary entry.
 Entry applies if date is the anniversary of MONTH, DAY, YEAR if
 `european-calendar-style' is nil, and DAY, MONTH, YEAR if
 `european-calendar-style' is t.  Diary entry can contain `%d' or `%d%s'; the
 %d will be replaced by the number of years since the MONTH DAY, YEAR and the
 day))
 (m (if european-calendar-style
 day
 month))
 (y (extract-calendar-year date))
-(diff (- y year)))
+(diff (if year (- y year) 100)))
 (if (and (= m 2) (= d 29) (not (calendar-leap-year-p y)))
 (setq m 3
 d 1))
 (if (and (> diff 0) (calendar-date-equal (list m d y) date))
 (cons mark (format entry diff (diary-ordinal-suffix diff))))))
 (if (= 0 (% days 7))
 (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks"))
 (concat (int-to-string days) (if (= 1 days) " day" " days")))
 " until "
 diary-entry)
-"*Pseudo-pattern giving form of reminder messages in the fancy diary
+"Pseudo-pattern giving form of reminder messages in the fancy diary
 display.
 Used by the function `diary-remind', a pseudo-pattern is a list of
 expressions that can involve the keywords `days' (a number), `date' (a list of
 month, day, year), and `diary-entry' (a string)."
 nil)
 (defun make-diary-entry (string &optional nonmarking file)
 "Insert a diary entry STRING which may be NONMARKING in FILE.
 If omitted, NONMARKING defaults to nil and FILE defaults to
-`diary-file'.  Adds `diary-redraw-calendar' to
+`diary-file'."
-`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 'after-save-hook 'diary-redraw-calendar nil t)
+(when (eq major-mode 'fundamental-mode) (diary-mode))
 (widen)
 (diary-unhide-everything)
 (goto-char (point-max))
 (when (let ((case-fold-search t))
 (search-backward "Local Variables:"
 '(1 diary-face)))
 diary-date-forms)))
 (eval-when-compile (require 'cal-hebrew)
 (require 'cal-islam))
+(defconst diary-time-regexp
+;; Formats that should be accepted:
+;;   10:00 10.00 10h00 10h 10am 10:00am 10.00am
+(concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
+"[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
+"\\)\\([AaPp][Mm]\\)?\\)"))
 (defvar diary-font-lock-keywords
 (append
 (diary-font-lock-date-forms calendar-month-name-array
 nil calendar-month-abbrev-array)
 (cons
 (concat "^" (regexp-quote diary-nonmarking-symbol)
 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
 '(1 font-lock-reference-face))
 '(diary-font-lock-sexps . font-lock-keyword-face)
-'("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"
+(cons
-. font-lock-function-name-face)))
+(concat ;; "^[ \t]+"
+diary-time-regexp "\\(-" diary-time-regexp "\\)?")
+'font-lock-function-name-face)))
 "Forms to highlight in `diary-mode'.")
 ;; Following code from Dave Love <fx@gnu.org>.
 ;; Import Outlook-format appointments from mail messages in Gnus or

Mercurial > emacs

comparison lisp/calendar/diary-lib.el @ 90237:aa89c814f853