Commit bf0cce5a authored by Glenn Morris's avatar Glenn Morris
Browse files

(calendar-today-marker, initial-calendar-window-hook)

(today-visible-calendar-hook, today-invisible-calendar-hook)
(diary-file, calendar-basic-setup, calendar-star-date)
(calendar-mark-today): Doc fixes.
(today-visible-calendar-hook): Add options.
(calendar-in-read-only-buffer): New macro.
(calendar-basic-setup): Adapt for change in calendar-read-date.
Place holiday let inside if.
(calendar-day-name-array, calendar-month-name-array): Make defcustoms.
(calendar-read-date): Set day to 1 rather than nil in the NODAY case.
(calendar-print-other-dates): Use one let rather than many.
Use calendar-in-read-only-buffer to replace previous code and disable undo.
parent 318a5488
...@@ -252,8 +252,7 @@ The value can be either a single-character string or a face." ...@@ -252,8 +252,7 @@ The value can be either a single-character string or a face."
(defcustom calendar-today-marker (if (display-color-p) 'calendar-today "=") (defcustom calendar-today-marker (if (display-color-p) 'calendar-today "=")
"How to mark today's date in the calendar. "How to mark today's date in the calendar.
The value can be either a single-character string or a face. The value can be either a single-character string or a face.
Marking today's date is done only if you set up `today-visible-calendar-hook' Used by `calendar-mark-today'."
to request that."
:type '(choice string face) :type '(choice string face)
:group 'calendar) :group 'calendar)
...@@ -288,48 +287,33 @@ This is the place to add key bindings to `calendar-mode-map'." ...@@ -288,48 +287,33 @@ This is the place to add key bindings to `calendar-mode-map'."
:group 'calendar-hooks) :group 'calendar-hooks)
(defcustom initial-calendar-window-hook nil (defcustom initial-calendar-window-hook nil
"List of functions to be called when the calendar window is first opened. "List of functions to be called when the calendar window is created.
The functions invoked are called after the calendar window is opened, but Qutting the calendar and re-entering it will cause these functions
once opened is never called again. Leaving the calendar with the `q' command to be called again."
and reentering it will cause these functions to be called again."
:type 'hook :type 'hook
:group 'calendar-hooks) :group 'calendar-hooks)
(defcustom today-visible-calendar-hook nil (defcustom today-visible-calendar-hook nil
"List of functions called whenever the current date is visible. "List of functions called whenever the current date is visible.
This can be used, for example, to replace today's date with asterisks; a To mark today's date, add the function `calendar-mark-today'.
function `calendar-star-date' is included for this purpose: To replace the date with asterisks, add the function `calendar-star-date'.
(setq today-visible-calendar-hook 'calendar-star-date)
It can also be used to mark the current date with `calendar-today-marker'; See also `today-invisible-calendar-hook'.
a function is also provided for this:
(setq today-visible-calendar-hook 'calendar-mark-today) Changing characters in the calendar buffer, except via the provided
functions, may cause the calendar movement commands to fail."
The corresponding variable `today-invisible-calendar-hook' is the list of
functions called when the calendar function was called when the current
date is not visible in the window.
Other than the use of the provided functions, the changing of any
characters in the calendar buffer by the hooks may cause the failure of the
functions that move by days and weeks."
:type 'hook :type 'hook
:options '(calendar-mark-today calendar-star-date)
:group 'calendar-hooks) :group 'calendar-hooks)
(defcustom today-invisible-calendar-hook nil (defcustom today-invisible-calendar-hook nil
"List of functions called whenever the current date is not visible. "List of functions called whenever the current date is not visible.
See also `today-visible-calendar-hook'."
The corresponding variable `today-visible-calendar-hook' is the list of
functions called when the calendar function was called when the current
date is visible in the window.
Other than the use of the provided functions, the changing of any
characters in the calendar buffer by the hooks may cause the failure of the
functions that move by days and weeks."
:type 'hook :type 'hook
:group 'calendar-hooks) :group 'calendar-hooks)
(defcustom calendar-move-hook nil (defcustom calendar-move-hook nil
"List of functions called whenever the cursor moves in the calendar. "List of functions called whenever the cursor moves in the calendar.
For example, For example,
(add-hook 'calendar-move-hook (lambda () (diary-view-entries 1))) (add-hook 'calendar-move-hook (lambda () (diary-view-entries 1)))
...@@ -439,13 +423,14 @@ Diary entries based on the Hebrew, the Islamic and/or the Baha'i ...@@ -439,13 +423,14 @@ Diary entries based on the Hebrew, the Islamic and/or the Baha'i
calendar are also possible, but because these are somewhat slow, they calendar are also possible, but because these are somewhat slow, they
are ignored unless you set the `nongregorian-diary-listing-hook' and are ignored unless you set the `nongregorian-diary-listing-hook' and
the `nongregorian-diary-marking-hook' appropriately. See the the `nongregorian-diary-marking-hook' appropriately. See the
documentation for these functions for details. documentation of these hooks for details.
Diary files can contain directives to include the contents of other files; for Diary files can contain directives to include the contents of other files; for
details, see the documentation for the variable `list-diary-entries-hook'." details, see the documentation for the variable `list-diary-entries-hook'."
:type 'file :type 'file
:group 'diary) :group 'diary)
;; FIXME do these have to be single characters?
(defcustom diary-nonmarking-symbol "&" (defcustom diary-nonmarking-symbol "&"
"Symbol indicating that a diary entry is not to be marked in the calendar." "Symbol indicating that a diary entry is not to be marked in the calendar."
:type 'string :type 'string
...@@ -466,6 +451,8 @@ details, see the documentation for the variable `list-diary-entries-hook'." ...@@ -466,6 +451,8 @@ details, see the documentation for the variable `list-diary-entries-hook'."
:type 'string :type 'string
:group 'diary) :group 'diary)
;; FIXME explain range. FIXME tweak range to always be +-50 of
;; present, if not already.
(defcustom abbreviated-calendar-year t (defcustom abbreviated-calendar-year t
"Interpret a two-digit year DD in a diary entry as either 19DD or 20DD. "Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
For the Gregorian calendar; similarly for the Hebrew, Islamic and For the Gregorian calendar; similarly for the Hebrew, Islamic and
...@@ -651,6 +638,7 @@ See the documentation of the function `calendar-date-string'." ...@@ -651,6 +638,7 @@ See the documentation of the function `calendar-date-string'."
(update-calendar-mode-line)) (update-calendar-mode-line))
;; FIXME move to diary-lib and adjust appt. ;; FIXME move to diary-lib and adjust appt.
;; Add appt-make-list as an option?
(defcustom diary-hook nil (defcustom diary-hook nil
"List of functions called after the display of the diary. "List of functions called after the display of the diary.
Can be used for appointment notification." Can be used for appointment notification."
...@@ -1225,6 +1213,22 @@ inclusive. The standard macro `dotimes' is preferable in most cases." ...@@ -1225,6 +1213,22 @@ inclusive. The standard macro `dotimes' is preferable in most cases."
,index (1+ ,index))) ,index (1+ ,index)))
sum)) sum))
(defmacro calendar-in-read-only-buffer (buffer &rest body)
"Switch to BUFFER and executes the forms in BODY.
First creates or erases BUFFER as needed. Leaves BUFFER read-only,
with disabled undo. Leaves point at point-min, displays BUFFER."
(declare (indent 1) (debug t))
`(progn
(set-buffer (get-buffer-create ,buffer))
(setq buffer-read-only nil
buffer-undo-list t)
(erase-buffer)
,@body
(goto-char (point-min))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(display-buffer ,buffer)))
;; The following are in-line for speed; they can be called thousands of times ;; The following are in-line for speed; they can be called thousands of times
;; when looking up holidays or processing the diary. Here, for example, are ;; when looking up holidays or processing the diary. Here, for example, are
;; the numbers of calls to calendar/diary/holiday functions in preparing the ;; the numbers of calls to calendar/diary/holiday functions in preparing the
...@@ -1257,7 +1261,8 @@ inclusive. The standard macro `dotimes' is preferable in most cases." ...@@ -1257,7 +1261,8 @@ inclusive. The standard macro `dotimes' is preferable in most cases."
"Extract the month part of DATE which has the form (month day year)." "Extract the month part of DATE which has the form (month day year)."
(car date)) (car date))
;; Note gives wrong answer for result of (calendar-read-date 'noday). ;; Note gives wrong answer for result of (calendar-read-date 'noday),
;; but that is only used by `calendar-other-month'.
(defsubst extract-calendar-day (date) (defsubst extract-calendar-day (date)
"Extract the day part of DATE which has the form (month day year)." "Extract the day part of DATE which has the form (month day year)."
(cadr date)) (cadr date))
...@@ -1381,15 +1386,12 @@ After loading the calendar, the hooks given by the variable ...@@ -1381,15 +1386,12 @@ After loading the calendar, the hooks given by the variable
`calendar-load-hook' are run. This is the place to add key bindings to the `calendar-load-hook' are run. This is the place to add key bindings to the
`calendar-mode-map'. `calendar-mode-map'.
After preparing the calendar window initially, the hooks given by the variable
`initial-calendar-window-hook' are run.
The hooks given by the variable `today-visible-calendar-hook' are run The hooks given by the variable `today-visible-calendar-hook' are run
every time the calendar window gets scrolled, if the current date is visible every time the calendar window gets scrolled, if the current date is visible
in the window. If it is not visible, the hooks given by the variable in the window. If it is not visible, the hooks given by the variable
`today-invisible-calendar-hook' are run. Thus, for example, setting `today-invisible-calendar-hook' are run.
`today-visible-calendar-hook' to 'calendar-star-date will cause today's date
to be replaced by asterisks to highlight it whenever it is in the window." Finally this command runs `initial-calendar-window-hook'."
(interactive "P") (interactive "P")
(set-buffer (get-buffer-create calendar-buffer)) (set-buffer (get-buffer-create calendar-buffer))
(calendar-mode) (calendar-mode)
...@@ -1399,9 +1401,6 @@ to be replaced by asterisks to highlight it whenever it is in the window." ...@@ -1399,9 +1401,6 @@ to be replaced by asterisks to highlight it whenever it is in the window."
(calendar-current-date))) (calendar-current-date)))
(month (extract-calendar-month date)) (month (extract-calendar-month date))
(year (extract-calendar-year date))) (year (extract-calendar-year date)))
;; (calendar-read-date t) returns a date with day = nil, which is
;; not a valid date for the visible test in the diary section.
(if arg (setcar (cdr date) 1))
(increment-calendar-month month year (- calendar-offset)) (increment-calendar-month month year (- calendar-offset))
;; Display the buffer before calling generate-calendar-window so that it ;; Display the buffer before calling generate-calendar-window so that it
;; can get a chance to adjust the window sizes to the frame size. ;; can get a chance to adjust the window sizes to the frame size.
...@@ -1409,10 +1408,11 @@ to be replaced by asterisks to highlight it whenever it is in the window." ...@@ -1409,10 +1408,11 @@ to be replaced by asterisks to highlight it whenever it is in the window."
(generate-calendar-window month year) (generate-calendar-window month year)
(if (and view-diary-entries-initially (calendar-date-is-visible-p date)) (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
(diary-view-entries))) (diary-view-entries)))
(let* ((diary-buffer (get-file-buffer diary-file)) (if view-calendar-holidays-initially
(diary-window (if diary-buffer (get-buffer-window diary-buffer))) (let* ((diary-buffer (get-file-buffer diary-file))
(split-height-threshold (if diary-window 2 1000))) (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
(if view-calendar-holidays-initially (split-height-threshold (if diary-window 2 1000)))
;; FIXME display buffer?
(calendar-list-holidays))) (calendar-list-holidays)))
(run-hooks 'initial-calendar-window-hook)) (run-hooks 'initial-calendar-window-hook))
...@@ -2075,12 +2075,21 @@ is a string to insert in the minibuffer before reading." ...@@ -2075,12 +2075,21 @@ is a string to insert in the minibuffer before reading."
"*Length of abbreviations to be used for day and month names. "*Length of abbreviations to be used for day and month names.
See also `calendar-day-abbrev-array' and `calendar-month-abbrev-array'.") See also `calendar-day-abbrev-array' and `calendar-month-abbrev-array'.")
(defvar calendar-day-name-array ;; FIXME does it have to start from Sunday?
(defcustom calendar-day-name-array
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
"*Array of capitalized strings giving, in order, the day names. "Array of capitalized strings giving, in order, the day names.
The first two characters of each string will be used to head the The first two characters of each string will be used to head the
day columns in the calendar. See also the variable day columns in the calendar. See also the variable
`calendar-day-abbrev-array'.") `calendar-day-abbrev-array'."
:group 'calendar
:type '(vector (string :tag "Sunday")
(string :tag "Monday")
(string :tag "Tuesday")
(string :tag "Wednesday")
(string :tag "Thursday")
(string :tag "Friday")
(string :tag "Saturday")))
(defvar calendar-day-abbrev-array (defvar calendar-day-abbrev-array
[nil nil nil nil nil nil nil] [nil nil nil nil nil nil nil]
...@@ -2093,11 +2102,24 @@ you may use such in the diary file. If any element of this array ...@@ -2093,11 +2102,24 @@ you may use such in the diary file. If any element of this array
is nil, then the abbreviation will be constructed as the first is nil, then the abbreviation will be constructed as the first
`calendar-abbrev-length' characters of the corresponding full name.") `calendar-abbrev-length' characters of the corresponding full name.")
(defvar calendar-month-name-array (defcustom calendar-month-name-array
["January" "February" "March" "April" "May" "June" ["January" "February" "March" "April" "May" "June"
"July" "August" "September" "October" "November" "December"] "July" "August" "September" "October" "November" "December"]
"*Array of capitalized strings giving, in order, the month names. "Array of capitalized strings giving, in order, the month names.
See also the variable `calendar-month-abbrev-array'.") See also the variable `calendar-month-abbrev-array'."
:group 'calendar
:type '(vector (string :tag "January")
(string :tag "February")
(string :tag "March")
(string :tag "April")
(string :tag "May")
(string :tag "June")
(string :tag "July")
(string :tag "August")
(string :tag "September")
(string :tag "October")
(string :tag "November")
(string :tag "December")))
(defvar calendar-month-abbrev-array (defvar calendar-month-abbrev-array
[nil nil nil nil nil nil nil nil nil nil nil nil] [nil nil nil nil nil nil nil nil nil nil nil nil]
...@@ -2143,7 +2165,7 @@ If FILTER is provided, apply it to each key in the alist." ...@@ -2143,7 +2165,7 @@ If FILTER is provided, apply it to each key in the alist."
(defun calendar-read-date (&optional noday) (defun calendar-read-date (&optional noday)
"Prompt for Gregorian date. Return a list (month day year). "Prompt for Gregorian date. Return a list (month day year).
If optional NODAY is t, does not ask for day, but just returns If optional NODAY is t, does not ask for day, but just returns
\(month nil year); if NODAY is any other non-nil value the value returned is \(month 1 year); if NODAY is any other non-nil value the value returned is
\(month year)" \(month year)"
(let* ((year (calendar-read (let* ((year (calendar-read
"Year (>0): " "Year (>0): "
...@@ -2161,7 +2183,7 @@ If optional NODAY is t, does not ask for day, but just returns ...@@ -2161,7 +2183,7 @@ If optional NODAY is t, does not ask for day, but just returns
(last (calendar-last-day-of-month month year))) (last (calendar-last-day-of-month month year)))
(if noday (if noday
(if (eq noday t) (if (eq noday t)
(list month nil year) (list month 1 year)
(list month year)) (list month year))
(list month (list month
(calendar-read (format "Day (1-%d): " last) (calendar-read (format "Day (1-%d): " last)
...@@ -2261,7 +2283,7 @@ interpreted as BC; -1 being 1 BC, and so on." ...@@ -2261,7 +2283,7 @@ interpreted as BC; -1 being 1 BC, and so on."
(day (extract-calendar-day date)) (day (extract-calendar-day date))
(year (extract-calendar-year date))) (year (extract-calendar-year date)))
(and (<= 1 month) (<= month 12) (and (<= 1 month) (<= month 12)
;; (calendar-read-date t) returns a date with day = nil. ;; (calendar-read-date t) used to return a date with day = nil.
;; Should not be valid (?), since many funcs prob assume integer. ;; Should not be valid (?), since many funcs prob assume integer.
;; (calendar-read-date 'noday) returns (month year), which ;; (calendar-read-date 'noday) returns (month year), which
;; currently results in extract-calendar-year returning nil. ;; currently results in extract-calendar-year returning nil.
...@@ -2332,8 +2354,7 @@ MARK defaults to `diary-entry-marker'." ...@@ -2332,8 +2354,7 @@ MARK defaults to `diary-entry-marker'."
(defun calendar-star-date () (defun calendar-star-date ()
"Replace the date under the cursor in the calendar window with asterisks. "Replace the date under the cursor in the calendar window with asterisks.
This function can be used with the `today-visible-calendar-hook' run after the You might want to add this function to `today-visible-calendar-hook'."
calendar window has been prepared."
(let ((inhibit-read-only t) (let ((inhibit-read-only t)
(modified (buffer-modified-p))) (modified (buffer-modified-p)))
(forward-char 1) (forward-char 1)
...@@ -2348,12 +2369,9 @@ calendar window has been prepared." ...@@ -2348,12 +2369,9 @@ calendar window has been prepared."
(defun calendar-mark-today () (defun calendar-mark-today ()
"Mark the date under the cursor in the calendar window. "Mark the date under the cursor in the calendar window.
The date is marked with `calendar-today-marker'. This function can be used with The date is marked with `calendar-today-marker'. You might want to add
the `today-visible-calendar-hook' run after the calendar window has been this function to `today-visible-calendar-hook'."
prepared." (mark-visible-calendar-date (calendar-cursor-to-date) calendar-today-marker))
(mark-visible-calendar-date
(calendar-cursor-to-date)
calendar-today-marker))
(defun calendar-date-compare (date1 date2) (defun calendar-date-compare (date1 date2)
"Return t if DATE1 is before DATE2, nil otherwise. "Return t if DATE1 is before DATE2, nil otherwise.
...@@ -2430,51 +2448,51 @@ Defaults to today's date if DATE is not given." ...@@ -2430,51 +2448,51 @@ Defaults to today's date if DATE is not given."
(defun calendar-print-other-dates () (defun calendar-print-other-dates ()
"Show dates on other calendars for date under the cursor." "Show dates on other calendars for date under the cursor."
(interactive) (interactive)
(let ((date (calendar-cursor-to-date t))) (let ((date (calendar-cursor-to-date t))
(with-current-buffer (get-buffer-create other-calendars-buffer) odate)
(let ((inhibit-read-only t) (calendar-in-read-only-buffer other-calendars-buffer
(modified (buffer-modified-p))) (calendar-set-mode-line (format "%s (Gregorian)"
(calendar-set-mode-line (calendar-date-string date)))
(concat (calendar-date-string date) " (Gregorian)")) (apply
(erase-buffer) 'insert
(apply (delq nil
'insert (list
(delq nil (calendar-day-of-year-string date) "\n"
(list (format "ISO date: %s\n" (calendar-iso-date-string date))
(calendar-day-of-year-string date) "\n" (format "Julian date: %s\n"
(format "ISO date: %s\n" (calendar-iso-date-string date)) (calendar-julian-date-string date))
(format "Julian date: %s\n" (format "Astronomical (Julian) day number (at noon UTC): %s.0\n"
(calendar-julian-date-string date)) (calendar-astro-date-string date))
(format "Astronomical (Julian) day number (at noon UTC): %s.0\n" (format "Fixed (RD) date: %s\n"
(calendar-astro-date-string date)) (calendar-absolute-from-gregorian date))
(format "Fixed (RD) date: %s\n" (format "Hebrew date (before sunset): %s\n"
(calendar-absolute-from-gregorian date)) (calendar-hebrew-date-string date))
(format "Hebrew date (before sunset): %s\n" (format "Persian date: %s\n"
(calendar-hebrew-date-string date)) (calendar-persian-date-string date))
(format "Persian date: %s\n" (unless (string-equal
(calendar-persian-date-string date)) (setq odate (calendar-islamic-date-string date))
(let ((i (calendar-islamic-date-string date))) "")
(unless (string-equal i "") (format "Islamic date (before sunset): %s\n" odate))
(format "Islamic date (before sunset): %s\n" i))) (unless (string-equal
(let ((b (calendar-bahai-date-string date))) (setq odate (calendar-bahai-date-string date))
(unless (string-equal b "") "")
(format "Baha'i date (before sunset): %s\n" b))) (format "Baha'i date (before sunset): %s\n" odate))
(format "Chinese date: %s\n" (format "Chinese date: %s\n"
(calendar-chinese-date-string date)) (calendar-chinese-date-string date))
(let ((c (calendar-coptic-date-string date))) (unless (string-equal
(unless (string-equal c "") (setq odate (calendar-coptic-date-string date))
(format "Coptic date: %s\n" c))) "")
(let ((e (calendar-ethiopic-date-string date))) (format "Coptic date: %s\n" odate))
(unless (string-equal e "") (unless (string-equal
(format "Ethiopic date: %s\n" e))) (setq odate (calendar-ethiopic-date-string date))
(let ((f (calendar-french-date-string date))) "")
(unless (string-equal f "") (format "Ethiopic date: %s\n" e))
(format "French Revolutionary date: %s\n" f))) (unless (string-equal
(format "Mayan date: %s\n" (setq odate (calendar-french-date-string date))
(calendar-mayan-date-string date))))) "")
(goto-char (point-min)) (format "French Revolutionary date: %s\n" odate))
(restore-buffer-modified-p modified)) (format "Mayan date: %s\n"
(display-buffer other-calendars-buffer)))) (calendar-mayan-date-string date))))))))
(defun calendar-print-day-of-year () (defun calendar-print-day-of-year ()
"Show day number in year/days remaining in year for date under the cursor." "Show day number in year/days remaining in year for date under the cursor."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment