;;; diary-lib.el --- diary functions
;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; This collection of functions implements the diary features as described
;; in calendar.el.
-;; Comments, corrections, and improvements should be sent to
-;; Edward M. Reingold Department of Computer Science
-;; (217) 333-6733 University of Illinois at Urbana-Champaign
-;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
-;; Urbana, Illinois 61801
-
;;; Code:
(require 'calendar)
(let ((diary-file d-file))
(diary-view-entries arg)))
-(autoload 'check-calendar-holidays "holidays"
+(autoload 'calendar-check-holidays "holidays"
"Check the list of holidays for any that occur on DATE.
The value returned is a list of strings of relevant holiday descriptions.
The holidays are those in the list `calendar-holidays'.")
(autoload 'diary-bahai-date "cal-bahai"
"Baha'i calendar equivalent of date diary entry.")
-(autoload 'list-bahai-diary-entries "cal-bahai"
+(autoload 'diary-bahai-list-entries "cal-bahai"
"Add any Baha'i date entries from the diary file to `diary-entries-list'.")
-(autoload 'mark-bahai-diary-entries "cal-bahai"
+(autoload 'diary-bahai-mark-entries "cal-bahai"
"Mark days in the calendar window that have Baha'i date diary entries.")
-(autoload 'mark-bahai-calendar-date-pattern "cal-bahai"
+(autoload 'calendar-bahai-mark-date-pattern "cal-bahai"
"Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR.")
(autoload 'diary-hebrew-date "cal-hebrew"
:group 'diary
:type 'boolean
:initialize 'custom-initialize-default
+ ;; FIXME overkill.
:set 'diary-set-maybe-redraw
:version "22.1")
Only used if `diary-header-line-flag' is non-nil."
:group 'diary
:type 'sexp
+ :initialize 'custom-initialize-default
+ ;; FIXME overkill.
+ :set 'diary-set-maybe-redraw
:version "22.1")
(defvar diary-saved-point) ; internal
(or (verify-visited-file-modtime diary-buffer)
(revert-buffer t t))))
;; Setup things like the header-line-format and invisibility-spec.
- ;; This used to only run if the major-mode was default-major-mode,
- ;; but that meant eg changes to header-line-format did not
- ;; take effect from one diary invocation to the next.
- (diary-mode)
+ (if (eq major-mode default-major-mode)
+ (diary-mode)
+ ;; This kludge is to make customizations to
+ ;; diary-header-line-flag after diary has been displayed
+ ;; take effect. Unconditionally calling (diary-mode)
+ ;; clobbers file local variables.
+ ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00363.html
+ ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-04/msg00404.html
+ (if (eq major-mode 'diary-mode)
+ (setq header-line-format (and diary-header-line-flag
+ diary-header-line-format))))
;; d-s-p is passed to the diary display function.
(let ((diary-saved-point (point)))
(save-excursion
(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))
- (entry-found (list-sexp-diary-entries date)))
- (dolist (date-form diary-date-forms)
- (let*
- ((backup (when (eq (car date-form) 'backup)
- (setq date-form (cdr date-form))
- t))
- (dayname
- (format "%s\\|%s\\.?"
- (calendar-day-name date)
- (calendar-day-name date 'abbrev)))
- (monthname
- (format "\\*\\|%s\\|%s\\.?"
- (calendar-month-name month)
- (calendar-month-name month 'abbrev)))
- (month (concat "\\*\\|0*" (int-to-string month)))
- (day (concat "\\*\\|0*" (int-to-string day)))
- (year
- (concat
- "\\*\\|0*" (int-to-string year)
- (if abbreviated-calendar-year
- (concat "\\|" (format "%02d" (% year 100)))
- "")))
- (regexp
- (concat
- "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
- (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))
- (if (and (or (char-equal (preceding-char) ?\^M)
- (char-equal (preceding-char) ?\n))
- (not (looking-at " \\|\^I")))
- ;; Diary entry that consists only of date.
- (backward-char 1)
- ;; Found a nonempty diary entry--make it
- ;; visible and add it to the list.
- (setq entry-found t)
- (let ((entry-start (point))
- date-start temp)
- (re-search-backward "\^M\\|\n\\|\\`")
- (setq date-start (point))
- ;; When selective display (rather than
- ;; overlays) was used, diary file used to
- ;; start in a blank line and end in a
- ;; newline. Now that neither of these
- ;; need be true, 'move handles the latter
- ;; and 1/2 kludge the former.
- (re-search-forward
- "\^M\\|\n" nil 'move
- (if (and (bobp) (not (looking-at "\^M\\|\n")))
- 1
- 2))
- (while (looking-at " \\|\^I")
- (re-search-forward "\^M\\|\n" nil 'move))
- (unless (and (eobp) (not (bolp)))
- (backward-char 1))
- (unless list-only
- (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
- entry
- (buffer-substring
- (1+ date-start) (1- entry-start))
- (copy-marker entry-start) (nth 1 temp)))))))
- (or entry-found
- (not diary-list-include-blanks)
- (add-to-diary-list date "" "" "" ""))
- (setq date
- (calendar-gregorian-from-absolute
- (1+ (calendar-absolute-from-gregorian date))))
- (setq entry-found nil)))))
+ (dotimes (idummy number)
+ (let ((month (extract-calendar-month date))
+ (day (extract-calendar-day date))
+ (year (extract-calendar-year date))
+ (entry-found (list-sexp-diary-entries date)))
+ (dolist (date-form diary-date-forms)
+ (let*
+ ((backup (when (eq (car date-form) 'backup)
+ (setq date-form (cdr date-form))
+ t))
+ (dayname
+ (format "%s\\|%s\\.?"
+ (calendar-day-name date)
+ (calendar-day-name date 'abbrev)))
+ (monthname
+ (format "\\*\\|%s\\|%s\\.?"
+ (calendar-month-name month)
+ (calendar-month-name month 'abbrev)))
+ (month (concat "\\*\\|0*" (int-to-string month)))
+ (day (concat "\\*\\|0*" (int-to-string day)))
+ (year
+ (concat
+ "\\*\\|0*" (int-to-string year)
+ (if abbreviated-calendar-year
+ (concat "\\|" (format "%02d" (% year 100)))
+ "")))
+ (regexp
+ (concat
+ "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
+ (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))
+ (if (and (or (char-equal (preceding-char) ?\^M)
+ (char-equal (preceding-char) ?\n))
+ (not (looking-at " \\|\^I")))
+ ;; Diary entry that consists only of date.
+ (backward-char 1)
+ ;; Found a nonempty diary entry--make it
+ ;; visible and add it to the list.
+ (setq entry-found t)
+ (let ((entry-start (point))
+ date-start temp)
+ (re-search-backward "\^M\\|\n\\|\\`")
+ (setq date-start (point))
+ ;; When selective display (rather than
+ ;; overlays) was used, diary file used to
+ ;; start in a blank line and end in a
+ ;; newline. Now that neither of these
+ ;; need be true, 'move handles the latter
+ ;; and 1/2 kludge the former.
+ (re-search-forward
+ "\^M\\|\n" nil 'move
+ (if (and (bobp) (not (looking-at "\^M\\|\n")))
+ 1
+ 2))
+ (while (looking-at " \\|\^I")
+ (re-search-forward "\^M\\|\n" nil 'move))
+ (unless (and (eobp) (not (bolp)))
+ (backward-char 1))
+ (unless list-only
+ (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
+ entry
+ (buffer-substring
+ (1+ date-start) (1- entry-start))
+ (copy-marker entry-start) (nth 1 temp)))))))
+ (or entry-found
+ (not diary-list-include-blanks)
+ (add-to-diary-list date "" "" "" ""))
+ (setq date
+ (calendar-gregorian-from-absolute
+ (1+ (calendar-absolute-from-gregorian date))))
+ (setq entry-found nil)))))
(goto-char (point-min))
(run-hooks 'nongregorian-diary-listing-hook
'list-diary-entries-hook)
(unless list-only
(if diary-display-hook
- (run-hooks 'diary-display-hook)
- (simple-diary-display)))
+ (run-hooks 'diary-display-hook)
+ (simple-diary-display)))
(run-hooks 'diary-hook)
diary-entries-list))))))
(defun simple-diary-display ()
"Display the diary buffer if there are any relevant entries or holidays."
(let* ((holiday-list (if holidays-in-diary-buffer
- (check-calendar-holidays original-date)))
+ (calendar-check-holidays original-date)))
(hol-string (format "%s%s%s"
date-string
(if holiday-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)))
+ (calendar-check-holidays original-date)))
(msg (format "No diary entries for %s %s"
(concat date-string (if holiday-list ":" ""))
(mapconcat 'identity holiday-list "; "))))
(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)
- (increment-calendar-month m y 1)))))
+ (dotimes (idummy 3)
+ (mark-calendar-month m y month day year color)
+ (increment-calendar-month m y 1)))))
(defun mark-calendar-month (month year p-month p-day p-year &optional color)
"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.