-;;; diary.el --- diary functions.
+;;; diary-lib.el --- diary functions.
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995 Free Software
+;; Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Keywords: calendar
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
"Mayan calendar equivalent of date diary entry."
t)
+(autoload 'diary-iso-date "cal-iso"
+ "ISO calendar equivalent of date diary entry."
+ t)
+
(autoload 'diary-julian-date "cal-julian"
"Julian calendar equivalent of date diary entry."
t)
"Astronomical (Julian) day number diary entry."
t)
-(autoload 'diary-chinese-date "cal-chinese"
+(autoload 'diary-chinese-date "cal-china"
"Chinese calendar equivalent of date diary entry."
t)
-(autoload 'diary-islamic-date "cal-islamic"
+(autoload 'diary-islamic-date "cal-islam"
"Islamic calendar equivalent of date diary entry."
t)
-(autoload 'list-islamic-diary-entries "cal-islamic"
+(autoload 'list-islamic-diary-entries "cal-islam"
"Add any Islamic date entries from the diary file to `diary-entries-list'."
t)
-(autoload 'mark-islamic-diary-entries "cal-islamic"
+(autoload 'mark-islamic-diary-entries "cal-islam"
"Mark days in the calendar window that have Islamic date diary entries."
t)
-(autoload 'mark-islamic-calendar-date-pattern "cal-islamic"
+(autoload 'mark-islamic-calendar-date-pattern "cal-islam"
"Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR."
t)
"Ethiopic calendar equivalent of date diary entry."
t)
+(autoload 'diary-persian-date "cal-persia"
+ "Persian calendar equivalent of date diary entry."
+ t)
+
(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry." t)
(autoload 'diary-sunrise-sunset "solar"
(d-file (substitute-in-file-name diary-file)))
(message "Preparing diary...")
(save-excursion
- (let ((diary-buffer (get-file-buffer d-file)))
- (set-buffer (if diary-buffer
- diary-buffer
- (find-file-noselect d-file t))))
+ (let ((diary-buffer (find-buffer-visiting d-file)))
+ (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))))
(setq selective-display t)
(setq selective-display-ellipses nil)
(setq old-diary-syntax-table (syntax-table))
(subst-char-in-region date-start
(point) ?\^M ?\n t)
(add-to-diary-list
- date (buffer-substring entry-start (point)))))))
+ date
+ (buffer-substring-no-properties
+ entry-start (point)))))))
(setq d (cdr d)))
(or entry-found
(not diary-list-include-blanks)
" \"\\([^\"]*\\)\"")
nil t)
(let ((diary-file (substitute-in-file-name
- (buffer-substring (match-beginning 2) (match-end 2))))
+ (buffer-substring-no-properties
+ (match-beginning 2) (match-end 2))))
(diary-list-include-blanks nil)
(list-diary-entries-hook 'include-other-diary-files)
(diary-display-hook 'ignore)
(setq diary-entries-list
(append diary-entries-list
(list-diary-entries original-date number)))
- (kill-buffer (get-file-buffer diary-file)))
+ (kill-buffer (find-buffer-visiting diary-file)))
(beep)
(message "Can't read included diary file %s" diary-file)
(sleep-for 2))
(and (not (cdr diary-entries-list))
(string-equal (car (cdr (car diary-entries-list))) "")))
(if (<= (length msg) (frame-width))
- (message msg)
+ (message "%s" msg)
(set-buffer (get-buffer-create holiday-buffer))
(setq buffer-read-only nil)
(calendar-set-mode-line date-string)
(concat "Diary for " date-string
(if holiday-list ": " "")
(mapconcat 'identity holiday-list "; ")))
- (display-buffer (get-file-buffer d-file))
+ (display-buffer (find-buffer-visiting d-file))
(message "Preparing diary...done"))))
(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.
- (set-buffer (get-file-buffer (substitute-in-file-name diary-file)))
+ (set-buffer (find-buffer-visiting (substitute-in-file-name diary-file)))
(let ((diary-modified (buffer-modified-p)))
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
(setq selective-display nil)
(concat date-string (if holiday-list ":" ""))
(mapconcat 'identity holiday-list "; "))))
(if (<= (length msg) (frame-width))
- (message msg)
+ (message "%s" msg)
(set-buffer (get-buffer-create holiday-buffer))
(setq buffer-read-only nil)
(calendar-set-mode-line date-string)
d)))
(insert (if (= (point) (point-min)) "" ?\n) date-string)
(if date-holiday-list (insert ": "))
- (let ((l (current-column)))
- (insert (mapconcat 'identity date-holiday-list
- (concat "\n" (make-string l ? )))))
- (let ((l (current-column)))
- (insert ?\n (make-string l ?=) ?\n)))))
+ (let* ((l (current-column))
+ (longest 0))
+ (insert (mapconcat '(lambda (x)
+ (if (< longest (length x))
+ (setq longest (length x)))
+ x)
+ date-holiday-list
+ (concat "\n" (make-string l ? ))))
+ (insert ?\n (make-string (+ l longest) ?=) ?\n)))))
(if (< 0 (length (car (cdr (car entry-list)))))
(insert (car (cdr (car entry-list))) ?\n))
(setq entry-list (cdr entry-list))))
(set-buffer (get-buffer fancy-diary-buffer))
(run-hooks 'print-diary-entries-hook))
(let ((diary-buffer
- (get-file-buffer (substitute-in-file-name diary-file))))
+ (find-buffer-visiting (substitute-in-file-name diary-file))))
(if diary-buffer
(let ((temp-buffer (get-buffer-create "*Printable Diary Entries*"))
(heading))
(if (and d-file (file-exists-p d-file))
(if (file-readable-p d-file)
(save-excursion
- (let ((diary-buffer (get-file-buffer d-file)))
+ (let ((diary-buffer (find-buffer-visiting d-file)))
(set-buffer (if diary-buffer
diary-buffer
(find-file-noselect d-file t)))
(while (re-search-forward regexp nil t)
(let* ((dd-name
(if d-name-pos
- (buffer-substring
+ (buffer-substring-no-properties
(match-beginning d-name-pos)
(match-end d-name-pos))))
(mm-name
(if m-name-pos
- (buffer-substring
+ (buffer-substring-no-properties
(match-beginning m-name-pos)
(match-end m-name-pos))))
(mm (string-to-int
(if m-pos
- (buffer-substring
+ (buffer-substring-no-properties
(match-beginning m-pos)
(match-end m-pos))
"")))
(dd (string-to-int
(if d-pos
- (buffer-substring
+ (buffer-substring-no-properties
(match-beginning d-pos)
(match-end d-pos))
"")))
(y-str (if y-pos
- (buffer-substring
+ (buffer-substring-no-properties
(match-beginning y-pos)
(match-end y-pos))))
(yy (if (not y-str)
(list m (calendar-last-day-of-month m y) y)))
(goto-char (point-min))
(while (re-search-forward s-entry nil t)
- (if (char-equal (preceding-char) ?()
+ (if (char-equal (preceding-char) ?\()
(setq marking-diary-entry t)
(setq marking-diary-entry nil))
(re-search-backward "(")
(entry-start)
(line-start))
(forward-sexp)
- (setq sexp (buffer-substring sexp-start (point)))
+ (setq sexp (buffer-substring-no-properties sexp-start (point)))
(save-excursion
(re-search-backward "\^M\\|\n\\|\\`")
(setq line-start (point)))
(while (looking-at " \\|\^I")
(re-search-forward "\^M\\|\n" nil t))
(backward-char 1)
- (setq entry (buffer-substring entry-start (point)))
+ (setq entry (buffer-substring-no-properties entry-start (point)))
(while (string-match "[\^M]" entry)
(aset entry (match-beginning 0) ?\n )))
(calendar-for-loop date from first-date to last-date do
" \"\\([^\"]*\\)\"")
nil t)
(let ((diary-file (substitute-in-file-name
- (buffer-substring (match-beginning 2) (match-end 2))))
+ (buffer-substring-no-properties
+ (match-beginning 2) (match-end 2))))
(mark-diary-entries-hook 'mark-included-diary-files))
(if (file-exists-p diary-file)
(if (file-readable-p diary-file)
(progn
(mark-diary-entries)
- (kill-buffer (get-file-buffer diary-file)))
+ (kill-buffer (find-buffer-visiting diary-file)))
(beep)
(message "Can't read included diary file %s" diary-file)
(sleep-for 2))
For example, returns 1325 for 1:25pm. Returns -9999 if no time is recognized.
The recognized forms are XXXX or X:XX or XX:XX (military time), XXam or XXpm,
and XX:XXam or XX:XXpm."
- (cond ((string-match;; Military time
- "^[ \t]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s)
- (+ (* 100 (string-to-int
- (substring s (match-beginning 1) (match-end 1))))
- (string-to-int (substring s (match-beginning 2) (match-end 2)))))
- ((string-match;; Hour only XXam or XXpm
- "^[ \t]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
- (+ (* 100 (% (string-to-int
- (substring s (match-beginning 1) (match-end 1)))
- 12))
- (if (string-equal "a"
- (substring s (match-beginning 2) (match-end 2)))
- 0 1200)))
- ((string-match;; Hour and minute XX:XXam or XX:XXpm
- "^[ \t]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
- (+ (* 100 (% (string-to-int
- (substring s (match-beginning 1) (match-end 1)))
- 12))
- (string-to-int (substring s (match-beginning 2) (match-end 2)))
- (if (string-equal "a"
- (substring s (match-beginning 3) (match-end 3)))
- 0 1200)))
- (t -9999)));; Unrecognizable
+ (let ((case-fold-search nil))
+ (cond ((string-match;; Military time
+ "^[ \t]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s)
+ (+ (* 100 (string-to-int
+ (substring s (match-beginning 1) (match-end 1))))
+ (string-to-int (substring s (match-beginning 2) (match-end 2)))))
+ ((string-match;; Hour only XXam or XXpm
+ "^[ \t]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
+ (+ (* 100 (% (string-to-int
+ (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]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
+ (+ (* 100 (% (string-to-int
+ (substring s (match-beginning 1) (match-end 1)))
+ 12))
+ (string-to-int (substring s (match-beginning 2) (match-end 2)))
+ (if (equal ?a (downcase (aref s (match-beginning 3))))
+ 0 1200)))
+ (t -9999))));; Unrecognizable
(defun list-sexp-diary-entries (date)
"Add sexp entries for DATE from the diary file to `diary-entries-list'.
can be lists of integers, the constant t, or an integer.
The constant t means all values.
- %%(diary-float MONTH DAYNAME N) text
+ %%(diary-float MONTH DAYNAME N &optional DAY) text
Entry will appear on the Nth DAYNAME of MONTH.
(DAYNAME=0 means Sunday, 1 means Monday, and so on;
if N is negative it counts backward from the end of
the month. MONTH can be a list of months, a single
- month, or t to specify all months.
+ month, or t to specify all months. Optional DAY means
+ Nth DAYNAME of MONTH on or after/before DAY. DAY defaults
+ to 1 if N>0 and the last day of the month if N<0.
%%(diary-block M1 D1 Y1 M2 D2 Y2) text
Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
%%(diary-omer)
Diary entries giving the omer count will be made every day
- from Passover to Shavuoth. Note that since there is no text,
+ from Passover to Shavuot. Note that since there is no text,
it makes sense only if the fancy diary display is used.
Marking these entries is *extremely* time consuming, so these entries are
(entry-start)
(line-start))
(forward-sexp)
- (setq sexp (buffer-substring sexp-start (point)))
+ (setq sexp (buffer-substring-no-properties sexp-start (point)))
(save-excursion
(re-search-backward "\^M\\|\n\\|\\`")
(setq line-start (point)))
(while (looking-at " \\|\^I")
(re-search-forward "\^M\\|\n" nil t))
(backward-char 1)
- (setq entry (buffer-substring entry-start (point)))
+ (setq entry (buffer-substring-no-properties entry-start (point)))
(while (string-match "[\^M]" entry)
(aset entry (match-beginning 0) ?\n )))
(let ((diary-entry (diary-sexp-entry sexp entry date)))
(if (and (<= date1 d) (<= d date2))
entry)))
-(defun diary-float (month dayname n)
+(defun diary-float (month dayname n &optional day)
"Floating diary entry--entry applies if date is the nth dayname of month.
Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, the constant
t, or an integer. The constant t means all months. If N is negative, count
-backward from the end of the month."
- (let ((m (extract-calendar-month date))
- (y (extract-calendar-year date)))
- (if (and
- (or (and (listp month) (memq m month))
- (equal m month)
- (eq month t))
- (calendar-date-equal date (calendar-nth-named-day n dayname m y)))
- entry)))
+backward from the end of the month.
+
+An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY."
+;; This is messy because the diary entry may apply, but the date on which it
+;; is based can be in a different month/year. For example, asking for the
+;; first Monday after December 30. For large values of |n| the problem is
+;; more grotesque.
+ (and (= dayname (calendar-day-of-week date))
+ (let* ((m (extract-calendar-month date))
+ (d (extract-calendar-day date))
+ (y (extract-calendar-year date))
+ (limit; last (n>0) or first (n<0) possible base date for entry
+ (calendar-nth-named-absday (- n) dayname m y d))
+ (last-abs (if (> n 0) limit (+ limit 6)))
+ (first-abs (if (> n 0) (- limit 6) limit))
+ (last (calendar-gregorian-from-absolute last-abs))
+ (first (calendar-gregorian-from-absolute first-abs))
+ ; m1, d1 is first possible base date
+ (m1 (extract-calendar-month first))
+ (d1 (extract-calendar-day first))
+ (y1 (extract-calendar-year first))
+ ; m2, d2 is last possible base date
+ (m2 (extract-calendar-month last))
+ (d2 (extract-calendar-day last))
+ (y2 (extract-calendar-year last)))
+ (if (or (and (= m1 m2) ; only possible base dates in one month
+ (or (and (listp month) (memq m1 month))
+ (eq month t)
+ (= m1 month))
+ (let ((d (or day (if (> n 0)
+ 1
+ (calendar-last-day-of-month m1 y1)))))
+ (and (<= d1 d) (<= d d2))))
+ ;; only possible base dates straddle two months
+ (and (< m1 m2)
+ (or
+ ;; m1, d1 works is a base date
+ (and
+ (or (and (listp month) (memq m1 month))
+ (eq month t)
+ (= m1 month))
+ (<= d1 (or day (if (> n 0)
+ 1
+ (calendar-last-day-of-month m1 y1)))))
+ ;; m2, d2 works is a base date
+ (and (or (and (listp month) (memq m2 month))
+ (eq month t)
+ (= m2 month))
+ (<= (or day (if (> n 0)
+ 1
+ (calendar-last-day-of-month m2 y2)))
+ d2)))))
+ entry))))
(defun diary-anniversary (month day year)
"Anniversary diary entry.
"Day of year and number of days remaining in the year of date diary entry."
(calendar-day-of-year-string date))
-(defvar diary-remind-message
+(defcustom diary-remind-message
'("Reminder: Only "
(if (= 0 (% days 7))
(concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks"))
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).")
+month, day, year), and `diary-entry' (a string)."
+ :type 'sexp
+ :group 'diary)
(defun diary-remind (sexp days &optional marking)
"Provide a reminder of a diary entry.
(calendar-date-string (calendar-cursor-to-date t) nil t))
arg)))
-(provide 'diary)
+(provide 'diary-lib)
-;;; diary.el ends here
+;;; diary-lib.el ends here