;;; diary-lib.el --- diary functions
;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;;; Code:
(require 'calendar)
-(require 'diary-loaddefs)
+(eval-and-compile (load "diary-loaddefs" nil t))
(defgroup diary nil
"Emacs diary."
"Face used for buttons in the fancy diary display."
:version "22.1"
:group 'calendar-faces)
-;; Backward-compatibility alias. FIXME make obsolete.
-(put 'diary-button-face 'face-alias 'diary-button)
+
+(define-obsolete-face-alias 'diary-button-face 'diary-button "22.1")
;; Face markup of calendar and diary displays: Any entry line that
;; ends with [foo:value] where foo is a face attribute (except :box
(define-obsolete-variable-alias 'diary-display-hook 'diary-display-function
"23.1")
-(defcustom diary-display-function 'diary-simple-display
+(defcustom diary-display-function 'diary-fancy-display
"Function used to display the diary.
-The default is `diary-simple-display'; `diary-fancy-display' is
-an alternative.
+The two standard options are `diary-fancy-display' and `diary-simple-display'.
For historical reasons, `nil' is the same as `diary-simple-display'
\(so you must use `ignore' for no display). Also for historical
entry for the given date. This can be used, for example, to
produce a different buffer for display (perhaps combined with
holidays), or hard copy output."
- :type '(choice (const diary-simple-display :tag "Basic display")
- (const diary-fancy-display :tag "Fancy display")
+ :type '(choice (const diary-fancy-display :tag "Fancy display")
+ (const diary-simple-display :tag "Basic display")
(const ignore :tag "No display")
(const nil :tag "Obsolete way to choose basic display")
(hook :tag "Obsolete form with list of display functions"))
:initialize 'custom-initialize-default
:set 'diary-set-maybe-redraw
- :version "23.1"
+ :version "23.2" ; simple->fancy
:group 'diary)
(define-obsolete-variable-alias 'list-diary-entries-hook
(defun diary-set-header (symbol value)
"Set SYMBOL's value to VALUE, and redraw the diary header if necessary."
(let ((oldvalue (symbol-value symbol))
- (dbuff (and diary-file
- (find-buffer-visiting
- (substitute-in-file-name diary-file)))))
+ (dbuff (and diary-file (find-buffer-visiting diary-file))))
(custom-set-default symbol value)
(and dbuff
(not (equal value oldvalue))
"Some text is hidden - press \"s\" in calendar \
before edit/copy"
"Diary"))
- ?\s (frame-width)))
+ ?\s (window-width)))
"Format of the header line displayed by `diary-simple-display'.
Only used if `diary-header-line-flag' is non-nil."
:group 'diary
(defun diary-live-p ()
"Return non-nil if the diary is being displayed."
(or (get-buffer diary-fancy-buffer)
- (and diary-file
- (find-buffer-visiting (substitute-in-file-name diary-file)))))
+ (and diary-file (find-buffer-visiting diary-file))))
;;;###cal-autoload
(defun diary-set-maybe-redraw (symbol value)
(defun diary-check-diary-file ()
"Check that the file specified by `diary-file' exists and is readable.
If so, return the expanded file name, otherwise signal an error."
- (let ((d-file (substitute-in-file-name diary-file)))
- (if (and d-file (file-exists-p d-file))
- (if (file-readable-p d-file)
- d-file
- (error "Diary file `%s' is not readable" diary-file))
- (error "Diary file `%s' does not exist" diary-file))))
+ (if (and diary-file (file-exists-p diary-file))
+ (if (file-readable-p diary-file)
+ diary-file
+ (error "Diary file `%s' is not readable" diary-file))
+ (error "Diary file `%s' does not exist" diary-file)))
;;;###autoload
(defun diary (&optional arg)
;; regexp moves us past the end of date, onto the next line.
;; Trailing whitespace after date not allowed (see diary-file).
(if (and (bolp) (not (looking-at "[ \t]")))
- ;; Diary entry that consists only of date.
+ ;; Diary entry that consists only of date.
(backward-char 1)
;; Found a nonempty diary entry--make it
;; visible and add it to the list.
(when (> number 0)
(let* ((original-date date) ; save for possible use in the hooks
(date-string (calendar-date-string date))
- (d-file (substitute-in-file-name diary-file))
- (diary-buffer (find-buffer-visiting d-file))
+ (diary-buffer (find-buffer-visiting diary-file))
diary-entries-list file-glob-attrs)
(message "Preparing diary...")
- (save-excursion
+ (save-current-buffer
(if (not diary-buffer)
- (set-buffer (find-file-noselect d-file t))
+ (set-buffer (find-file-noselect diary-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.
- (if (eq major-mode default-major-mode)
+ (if (eq major-mode (default-value 'major-mode))
(diary-mode)
;; This kludge is to make customizations to
;; diary-header-line-flag after diary has been displayed
;; d-s-p is passed to the diary display function.
(let ((diary-saved-point (point)))
(save-excursion
- (setq file-glob-attrs (cadr (diary-pull-attrs nil "")))
- (with-syntax-table diary-syntax-table
+ (save-restriction
+ (widen) ; bug#5093
+ (setq file-glob-attrs (cadr (diary-pull-attrs nil "")))
+ (with-syntax-table diary-syntax-table
+ (goto-char (point-min))
+ (unless list-only
+ (let ((ol (make-overlay (point-min) (point-max) nil t nil)))
+ (set (make-local-variable 'diary-selective-display) t)
+ (overlay-put ol 'invisible 'diary)
+ (overlay-put ol 'evaporate t)))
+ (dotimes (idummy number)
+ (let ((sexp-found (diary-list-sexp-entries date))
+ (entry-found (diary-list-entries-2
+ date diary-nonmarking-symbol
+ file-glob-attrs list-only)))
+ (if diary-list-include-blanks
+ (or sexp-found entry-found
+ (diary-add-to-list date "" "" "" "")))
+ (setq date
+ (calendar-gregorian-from-absolute
+ (1+ (calendar-absolute-from-gregorian date)))))))
(goto-char (point-min))
+ (run-hooks 'diary-nongregorian-listing-hook
+ 'diary-list-entries-hook)
(unless list-only
- (let ((ol (make-overlay (point-min) (point-max) nil t nil)))
- (set (make-local-variable 'diary-selective-display) t)
- (overlay-put ol 'invisible 'diary)
- (overlay-put ol 'evaporate t)))
- (dotimes (idummy number)
- (let ((sexp-found (diary-list-sexp-entries date))
- (entry-found (diary-list-entries-2
- date diary-nonmarking-symbol
- file-glob-attrs list-only)))
- (if diary-list-include-blanks
- (or sexp-found entry-found
- (diary-add-to-list date "" "" "" "")))
- (setq date
- (calendar-gregorian-from-absolute
- (1+ (calendar-absolute-from-gregorian date)))))))
- (goto-char (point-min))
- (run-hooks 'diary-nongregorian-listing-hook
- 'diary-list-entries-hook)
- (unless list-only
- (if (and diary-display-function
- (listp diary-display-function))
- ;; Backwards compatibility.
- (run-hooks 'diary-display-function)
- (funcall (or diary-display-function
- 'diary-simple-display))))
- (run-hooks 'diary-hook)
- diary-entries-list))))))
+ (if (and diary-display-function
+ (listp diary-display-function))
+ ;; Backwards compatibility.
+ (run-hooks 'diary-display-function)
+ (funcall (or diary-display-function
+ 'diary-simple-display))))
+ (run-hooks 'diary-hook)
+ diary-entries-list)))))))
(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries "22.1")
(defun diary-unhide-everything ()
"Show all invisible text in the diary."
(kill-local-variable 'diary-selective-display)
- (remove-overlays (point-min) (point-max) 'invisible 'diary)
+ (save-restriction ; bug#5477
+ (widen)
+ (remove-overlays (point-min) (point-max) 'invisible 'diary))
(kill-local-variable 'mode-line-format))
(defvar original-date) ; bound in diary-list-entries
(while (re-search-forward
(format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
nil t)
- (let ((diary-file (substitute-in-file-name
- (match-string-no-properties 1)))
- (diary-list-include-blanks nil)
+ (let ((diary-file (match-string-no-properties 1))
(diary-list-entries-hook 'diary-include-other-diary-files)
(diary-display-function 'ignore)
- (diary-hook nil))
+ diary-hook diary-list-include-blanks)
(if (file-exists-p diary-file)
(if (file-readable-p diary-file)
(unwind-protect
;; to display the diary.
(let* ((pop-up-frames (or pop-up-frames
(window-dedicated-p (selected-window))))
- (dbuff (find-buffer-visiting (substitute-in-file-name diary-file)))
+ (dbuff (find-buffer-visiting diary-file))
(empty (diary-display-no-entries)))
;; This may be too wide, but when simple diary is used there is
;; nowhere else for the holidays to go. Also, it is documented in
(define-obsolete-function-alias 'simple-diary-display
'diary-simple-display "23.1")
-(define-button-type 'diary-entry
- 'action #'diary-goto-entry
- 'face 'diary-button)
+(define-button-type 'diary-entry 'action #'diary-goto-entry
+ 'face 'diary-button 'help-echo "Find this diary entry"
+ 'follow-link t)
(defun diary-goto-entry (button)
"Jump to the diary entry for the BUTTON at point."
(file-exists-p file)
(find-file-other-window file)
(progn
- (when (eq major-mode default-major-mode) (diary-mode))
+ (when (eq major-mode (default-value 'major-mode)) (diary-mode))
(goto-char (point-min))
(if (re-search-forward (format "%s.*\\(%s\\)"
(regexp-quote (nth 2 locator))
This is an option for `diary-display-function'."
;; Turn off selective-display in the diary file's buffer.
- (with-current-buffer
- (find-buffer-visiting (substitute-in-file-name diary-file))
+ (with-current-buffer (find-buffer-visiting diary-file)
(diary-unhide-everything))
(unless (car (diary-display-no-entries)) ; no entries
;; Prepare the fancy diary buffer.
this-loc marks temp-face)
(unless (zerop (length this-entry))
(if (setq this-loc (nth 3 entry))
- (insert-button (concat this-entry "\n")
+ (insert-button this-entry
;; (MARKER FILENAME SPECIFIER LITERAL)
'locator (list (car this-loc)
(cadr this-loc)
(or (nth 2 this-loc)
(nth 1 entry)))
:type 'diary-entry)
- (insert this-entry ?\n))
+ (insert this-entry))
+ (insert ?\n)
;; Doesn't make sense to check font-lock-mode - see
;; comments above diary-entry-marker in calendar.el.
(and ; font-lock-mode
(overlay-put
(make-overlay (match-beginning 0) (match-end 0))
'face temp-face)))))))
- (diary-fancy-display-mode)
+ ;; FIXME can't remember what this check was for.
+ ;; To prevent something looping, or a minor optimization?
+ (if (eq major-mode 'diary-fancy-display-mode)
+ (run-hooks 'diary-fancy-display-mode-hook)
+ (diary-fancy-display-mode))
(calendar-set-mode-line date-string)
(message "Preparing diary...done"))))
(if diary-buffer
(with-current-buffer diary-buffer
(run-hooks 'diary-print-entries-hook))
- (or (setq diary-buffer
- (find-buffer-visiting (substitute-in-file-name diary-file)))
+ (or (setq diary-buffer (find-buffer-visiting diary-file))
(error "You don't have a diary buffer!"))
;; Name affects printing?
(setq temp-buffer (get-buffer-create " *Printable Diary Entries*"))
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 (or pop-up-frames
- (window-dedicated-p (selected-window)))))
+ (let* ((d-file (diary-check-diary-file))
+ (pop-up-frames (or pop-up-frames
+ (window-dedicated-p (selected-window))))
+ (win (selected-window))
+ (height (window-height)))
(with-current-buffer (or (find-buffer-visiting d-file)
(find-file-noselect d-file t))
- (when (eq major-mode default-major-mode) (diary-mode))
+ (when (eq major-mode (default-value 'major-mode)) (diary-mode))
(diary-unhide-everything)
- (display-buffer (current-buffer)))))
+ (display-buffer (current-buffer))
+ (when (and (/= height (window-height win))
+ (with-current-buffer (window-buffer win)
+ (derived-mode-p 'calendar-mode)))
+ (fit-window-to-buffer win)))))
(define-obsolete-function-alias 'show-all-diary-entries
'diary-show-all-entries "22.1")
(buffer-substring-no-properties
(point) (line-end-position))
file-glob-attrs)))
- (if dd-name
+ ;; Only mark all days of a given name if the pattern
+ ;; contains no more specific elements.
+ (if (and dd-name (not (or d-pos m-pos y-pos)))
(calendar-mark-days-named
(cdr (assoc-string dd-name
(calendar-make-alist
file-glob-attrs)
(with-current-buffer (find-file-noselect (diary-check-diary-file) t)
(save-excursion
- (when (eq major-mode default-major-mode) (diary-mode))
+ (when (eq major-mode (default-value 'major-mode)) (diary-mode))
(setq calendar-mark-diary-entries-flag t)
(message "Marking diary entries...")
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(while (re-search-forward
(format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
nil t)
- (let* ((diary-file (substitute-in-file-name
- (match-string-no-properties 1)))
+ (let* ((diary-file (match-string-no-properties 1))
(diary-mark-entries-hook 'diary-mark-included-diary-files)
(dbuff (find-buffer-visiting diary-file)))
(if (file-exists-p diary-file)
The function FROMABS converts absolute dates to the appropriate date system.
The function TOABS carries out the inverse operation. Optional argument
COLOR is passed to `calendar-mark-visible-date' as MARK."
- (save-excursion
- (set-buffer calendar-buffer)
+ (with-current-buffer calendar-buffer
(if (and (not (zerop month)) (not (zerop day)))
(if (not (zerop year))
;; Fully specified date.
sexp-start sexp entry specifier entry-start line-start
diary-entry temp literal)
(goto-char (point-min))
- (save-excursion
- (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))))
+ (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(while (re-search-forward s-entry nil t)
(backward-char 1)
(setq sexp-start (point))
`diary-file'."
(let ((pop-up-frames (or pop-up-frames
(window-dedicated-p (selected-window)))))
- (find-file-other-window (substitute-in-file-name (or file diary-file))))
- (when (eq major-mode default-major-mode) (diary-mode))
+ (find-file-other-window (or file diary-file)))
+ (when (eq major-mode (default-value 'major-mode)) (diary-mode))
(widen)
(diary-unhide-everything)
(goto-char (point-max))
(setq end (line-beginning-position 2)))
(font-lock-default-fontify-region beg end verbose))
+(defvar diary-fancy-overriding-map (let ((map (make-sparse-keymap)))
+ (define-key map "q" 'quit-window)
+ map)
+ "Keymap overriding minor-mode maps in `diary-fancy-display-mode'.")
+
(define-derived-mode diary-fancy-display-mode fundamental-mode
"Diary"
"Major mode used while displaying diary entries using Fancy Display."
t nil nil nil
(font-lock-fontify-region-function
. diary-fancy-font-lock-fontify-region-function)))
- (local-set-key "q" 'quit-window))
+ (local-set-key "q" 'quit-window)
+ (set (make-local-variable 'minor-mode-overriding-map-alist)
+ (list (cons t diary-fancy-overriding-map)))
+ (view-mode 1))
(define-obsolete-function-alias 'fancy-diary-display-mode
'diary-fancy-display-mode "23.1")
;; `diary-outlook-formats'.
(defvar subject) ; bound in diary-from-outlook-gnus
+(defvar body)
(defun diary-from-outlook-internal (&optional test-only)
"Snarf a diary entry from a message assumed to be from MS Outlook.
HCoop / bpt / emacs.git / blobdiff