mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-25 10:47:00 +00:00
Code Issues Releases Activity

Lots of minor fixes and code polishing. Exit-calendar code rewritten.

Browse Source
This commit is contained in:
Edward M. Reingold 1994-10-26 15:26:22 +00:00
parent 38971c4157
commit cba0c2538d
1 changed files with 149 additions and 402 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

529
lisp/calendar/calendar.el
View File

@ -108,6 +108,13 @@
"*The day of the week on which a week in the calendar begins.
0 means Sunday (default), 1 means Monday, and so on.")
;;;###autoload
(defvar calendar-offset 0
"*The offset of the principal month from the center of the calendar window.
0 means the principal month is in the center (default), -1 means on the left,
+1 means on the right. Larger (or smaller) values push the principal month off
the screen.")
;;;###autoload
(defvar view-diary-entries-initially nil
"*Non-nil means display current date's diary entries on entry.
@ -923,6 +930,9 @@ with descriptive strings such as
(defconst fancy-diary-buffer "*Fancy Diary Entries*"
"Name of the buffer used for the optional fancy display of the diary.")
(defconst lunar-phases-buffer "*Phases of Moon*"
"Name of the buffer used for the lunar phases.")
(defmacro increment-calendar-month (mon yr n)
"Move the variables MON and YR to the month and year by N months.
Forward if N is positive or backward if N is negative."
@ -945,10 +955,9 @@ Forward if N is positive or backward if N is negative."
(setq (, index) (1+ (, index))))
sum)))
;; The following macros are for speed; the code would be clearer if they
;; were functions, but they can be called thousands of times 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 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
;; the numbers of calls to calendar/diary/holiday functions in preparing the
;; fancy diary display, for a moderately complex diary file, with functions
;; used instead of macros. There were a total of 10000 such calls:
;;
@ -974,123 +983,68 @@ Forward if N is positive or backward if N is negative."
;; .
;;
;; The use of these seven macros eliminates the overhead of 92% of the function
;; calls; it's faster this way. For clarity, the defun form of each is given
;; in comments after the defmacro form.
;; calls; it's faster this way.
(defmacro extract-calendar-month (date)
(defsubst extract-calendar-month (date)
"Extract the month part of DATE which has the form (month day year)."
(` (car (, date))))
;;(defun extract-calendar-month (date)
;; "Extract the month part of DATE which has the form (month day year)."
;; (car date))
(car date))
(defmacro extract-calendar-day (date)
(defsubst extract-calendar-day (date)
"Extract the day part of DATE which has the form (month day year)."
(` (car (cdr (, date)))))
;;(defun extract-calendar-day (date)
;; "Extract the day part of DATE which has the form (month day year)."
;; (car (cdr date)))
(car (cdr date)))
(defmacro extract-calendar-year (date)
(defsubst extract-calendar-year (date)
"Extract the year part of DATE which has the form (month day year)."
(` (car (cdr (cdr (, date))))))
;;(defun extract-calendar-year (date)
;; "Extract the year part of DATE which has the form (month day year)."
;; (car (cdr (cdr date))))
(car (cdr (cdr date))))
(defmacro calendar-leap-year-p (year)
(defsubst calendar-leap-year-p (year)
"Returns t if YEAR is a Gregorian leap year."
(` (and
(zerop (% (, year) 4))
(or (not (zerop (% (, year) 100)))
(zerop (% (, year) 400))))))
;;(defun calendar-leap-year-p (year)
;; "Returns t if YEAR is a Gregorian leap year."
;; (and
;; (zerop (% year 4))
;; (or ((not (zerop (% year 100))))
;; (zerop (% year 400)))))
;;
(and (zerop (% year 4))
(or (not (zerop (% year 100)))
(zerop (% year 400)))))
;; The foregoing is a bit faster, but not as clear as the following:
;;
;;(defmacro calendar-leap-year-p (year)
;; "Returns t if YEAR is a Gregorian leap year."
;; (` (or
;; (and (= (% (, year) 4) 0)
;; (/= (% (, year) 100) 0))
;; (= (% (, year) 400) 0))))
;;(defun calendar-leap-year-p (year)
;;(defsubst calendar-leap-year-p (year)
;; "Returns t if YEAR is a Gregorian leap year."
;; (or
;; (and (= (% year 4) 0)
;; (/= (% year 100) 0))
;; (= (% year 400) 0)))
(defmacro calendar-last-day-of-month (month year)
(defsubst calendar-last-day-of-month (month year)
"The last day in MONTH during YEAR."
(` (if (and
(= (, month) 2)
(, (macroexpand (` (calendar-leap-year-p (, year))))))
(if (and (= month 2) (calendar-leap-year-p year))
29
(aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- (, month))))))
;;(defun calendar-last-day-of-month (month year)
;; "The last day in MONTH during YEAR."
;; (if (and (= month 2) (calendar-leap-year-p year))
;; 29
;; (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
(aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
(defmacro calendar-day-number (date)
;; An explanation of the calculation can be found in PascAlgorithms by
;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
(defsubst calendar-day-number (date)
"Return the day number within the year of the date DATE.
For example, (calendar-day-number '(1 1 1987)) returns the value 1,
while (calendar-day-number '(12 31 1980)) returns 366."
;;
;; An explanation of the calculation can be found in PascAlgorithms by
;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
;;
(` (let* ((month (, (macroexpand (` (extract-calendar-month (, date))))))
(day (, (macroexpand (` (extract-calendar-day (, date))))))
(year (, (macroexpand (` (extract-calendar-year (, date))))))
(let* ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(day-of-year (+ day (* 31 (1- month)))))
(if (> month 2)
(progn
(setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
(if (, (macroexpand (` (calendar-leap-year-p year))))
(if (calendar-leap-year-p year)
(setq day-of-year (1+ day-of-year)))))
day-of-year)))
;;(defun calendar-day-number (date)
;; "Return the day number within the year of the date DATE.
;;For example, (calendar-day-number '(1 1 1987)) returns the value 1,
;;while (calendar-day-number '(12 31 1980)) returns 366."
;; (let* ((month (extract-calendar-month date))
;; (day (extract-calendar-day date))
;; (year (extract-calendar-year date))
;; (day-of-year (+ day (* 31 (1- month)))))
;; (if (> month 2)
;; (progn
;; (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
;; (if (calendar-leap-year-p year)
;; (setq day-of-year (1+ day-of-year)))))
;; day-of-year))
day-of-year))
(defmacro calendar-absolute-from-gregorian (date)
(defsubst calendar-absolute-from-gregorian (date)
"The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
The Gregorian date Sunday, December 31, 1 BC is imaginary."
(` (let ((prior-years
(1- (, (macroexpand (` (extract-calendar-year (, date))))))))
(+ (, (macroexpand (` (calendar-day-number (, date)))));; Days this year
(let ((prior-years (1- (extract-calendar-year date))))
(+ (calendar-day-number date);; Days this year
(* 365 prior-years);; + Days in prior years
(/ prior-years 4);; + Julian leap years
(- (/ prior-years 100));; - century years
(/ prior-years 400)))));; + Gregorian leap years
;;(defun calendar-absolute-from-gregorian (date)
;; "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
;;The Gregorian date Sunday, December 31, 1 BC is imaginary."
;; (let ((prior-years (1- (extract-calendar-year date))))
;; (+ (calendar-day-number date);; Days this year
;; (* 365 prior-years);; + Days in prior years
;; (/ prior-years 4);; + Julian leap years
;; (- (/ prior-years 100));; - century years
;; (/ prior-years 400))));; + Gregorian leap years
(/ prior-years 400))));; + Gregorian leap years
;;;###autoload
(defun calendar (&optional arg)
@ -1142,29 +1096,16 @@ to be replaced by asterisks to highlight it whenever it is in the window."
(interactive "P")
(set-buffer (get-buffer-create calendar-buffer))
(calendar-mode)
;;; (setq calendar-window-configuration (current-window-configuration))
(let* ((completion-ignore-case t)
(pop-up-windows t)
(split-height-threshold 1000)
(date (calendar-current-date))
(month
(if arg
(cdr (assoc
(capitalize
(completing-read
"Month name: "
(mapcar 'list (append calendar-month-name-array nil))
nil t))
(calendar-make-alist calendar-month-name-array)))
(extract-calendar-month date)))
(year
(if arg
(calendar-read
"Year (>0): "
'(lambda (x) (> x 0))
(int-to-string (extract-calendar-year date)))
(extract-calendar-year date))))
(date (if arg
(calendar-read-date t)
(calendar-current-date)))
(month (extract-calendar-month date))
(year (extract-calendar-year date)))
(pop-to-buffer calendar-buffer)
(increment-calendar-month month year (- calendar-offset))
(generate-calendar-window month year)
(if (and view-diary-entries-initially (calendar-date-is-visible-p date))
(view-diary-entries
@ -1535,7 +1476,7 @@ the inserted text. Value is always t."
(define-key calendar-mode-map "iid" 'insert-islamic-diary-entry)
(define-key calendar-mode-map "iim" 'insert-monthly-islamic-diary-entry)
(define-key calendar-mode-map "iiy" 'insert-yearly-islamic-diary-entry)
(define-key calendar-mode-map "?" 'describe-calendar-mode))
(define-key calendar-mode-map "?" 'calendar-goto-info-node))
(defun describe-calendar-mode ()
"Create a help buffer with a brief description of the calendar-mode."
@ -1556,234 +1497,29 @@ the inserted text. Value is always t."
(list
(substitute-command-keys "\\<calendar-mode-map>\\[scroll-calendar-left]")
"Calendar"
(substitute-command-keys "\\<calendar-mode-map>\\[describe-calendar-mode] help/\\[calendar-other-month] other/\\[calendar-goto-today] today")
(substitute-command-keys "\\<calendar-mode-map>\\[calendar-goto-info-node] info/\\[calendar-other-month] other/\\[calendar-goto-today] today")
'(calendar-date-string (calendar-current-date) t)
(substitute-command-keys "\\<calendar-mode-map>\\[scroll-calendar-right]"))
"The mode line of the calendar buffer.")
(defun calendar-goto-info-node ()
"Go to the info node for the calendar."
(interactive)
(require 'info)
(let ((where (Info-find-emacs-command-nodes 'calendar)))
(if (not where)
(error "Couldn't find documentation for the calendar.")
(save-window-excursion (info))
(pop-to-buffer "*info*")
(Info-find-node (car (car where)) (car (cdr (car where)))))))
(defun calendar-mode ()
"A major mode for the calendar window.
The commands for cursor movement are:\\<calendar-mode-map>
For a complete description, type \
\\<calendar-mode-map>\\[calendar-goto-info-node] from within the calendar.
\\[calendar-forward-day] one day forward \\[calendar-backward-day] one day backward
\\[calendar-forward-week] one week forward \\[calendar-backward-week] one week backward
\\[calendar-forward-month] one month forward \\[calendar-backward-month] one month backward
\\[calendar-forward-year] one year forward \\[calendar-backward-year] one year backward
\\[calendar-beginning-of-week] beginning of week \\[calendar-end-of-week] end of week
\\[calendar-beginning-of-month] beginning of month \\[calendar-end-of-month] end of month
\\[calendar-beginning-of-year] beginning of year \\[calendar-end-of-year] end of year
\\[calendar-goto-date] go to date
\\[calendar-goto-julian-date] go to Julian date \\[calendar-goto-astro-day-number] go to astronomical (Julian) day number
\\[calendar-goto-hebrew-date] go to Hebrew date \\[calendar-goto-islamic-date] go to Islamic date
\\[calendar-goto-iso-date] go to ISO date \\[calendar-goto-french-date] go to French Revolutionary date
\\[calendar-goto-mayan-long-count-date] go to Mayan Long Count date
\\[calendar-next-haab-date] go to next occurrence of Mayan Haab date
\\[calendar-previous-haab-date] go to previous occurrence of Mayan Haab date
\\[calendar-next-tzolkin-date] go to next occurrence of Mayan Tzolkin date
\\[calendar-previous-tzolkin-date] go to previous occurrence of Mayan Tzolkin date
\\[calendar-next-calendar-round-date] go to next occurrence of Mayan Calendar Round date
\\[calendar-previous-calendar-round-date] go to previous occurrence of Mayan Calendar Round date
You can mark a date in the calendar and switch the point and mark:
\\[calendar-set-mark] mark date \\[calendar-exchange-point-and-mark] exchange point and mark
You can determine the number of days (inclusive) between the point and mark by
\\[calendar-count-days-region] count days in the region
The commands for calendar movement are:
\\[scroll-calendar-right] scroll one month right \\[scroll-calendar-left] scroll one month left
\\[scroll-calendar-right-three-months] scroll 3 months right \\[scroll-calendar-left-three-months] scroll 3 months left
\\[calendar-goto-today] display current month \\[calendar-other-month] display another month
Whenever it makes sense, the above commands take prefix arguments that
multiply their affect. For convenience, the digit keys and the minus sign
are bound to digit-argument, so they need not be prefixed with ESC.
If the calendar window somehow becomes corrupted, it can be regenerated with
\\[redraw-calendar] redraw the calendar
The following commands deal with holidays and other notable days:
\\[calendar-cursor-holidays] give holidays for the date specified by the cursor
\\[mark-calendar-holidays] mark notable days
\\[calendar-unmark] unmark dates
\\[list-calendar-holidays] display notable days
The command M-x holidays causes the notable dates for the current month, and
the preceding and succeeding months, to be displayed, independently of the
calendar.
The following commands control the diary:
\\[mark-diary-entries] mark diary entries \\[calendar-unmark] unmark dates
\\[view-diary-entries] display diary entries \\[show-all-diary-entries] show all diary entries
\\[print-diary-entries] print diary entries
Displaying the diary entries causes the diary entries from the diary file
\(for the date indicated by the cursor in the calendar window) to be
displayed in another window. This function takes an integer argument that
specifies the number of days of calendar entries to be displayed, starting
with the date indicated by the cursor.
The command \\[print-diary-entries] prints the diary buffer (as it appears)
on the line printer.
The command M-x diary causes the diary entries for the current date to be
displayed, independently of the calendar. The number of days of entries is
governed by number-of-diary-entries.
The format of the entries in the diary file is described in the
documentation string for the variable `diary-file'.
When diary entries are in view in the window, they can be edited. It is
important to keep in mind that the buffer displayed contains the entire
diary file, but with portions of it concealed from view. This means, for
instance, that the forward-char command can put the cursor at what appears
to be the end of the line, but what is in reality the middle of some
concealed line. BE CAREFUL WHEN EDITING THE DIARY ENTRIES! (Inserting
additional lines or adding/deleting characters in the middle of a visible
line will not cause problems; watch out for end-of-line, however--it may
put you at the end of a concealed line far from where the cursor appears to
be!) BEFORE EDITING THE DIARY IT IS BEST TO DISPLAY THE ENTIRE FILE WITH
show-all-diary-entries. BE SURE TO WRITE THE FILE BEFORE EXITING FROM THE
CALENDAR.
The following commands assist in making diary entries:
\\[insert-diary-entry] insert a diary entry for the selected date
\\[insert-weekly-diary-entry] insert a diary entry for the selected day of the week
\\[insert-monthly-diary-entry] insert a diary entry for the selected day of the month
\\[insert-yearly-diary-entry] insert a diary entry for the selected day of the year
\\[insert-block-diary-entry] insert a diary entry for the block days between point and mark
\\[insert-anniversary-diary-entry] insert an anniversary diary entry for the selected date
\\[insert-cyclic-diary-entry] insert a cyclic diary entry
There are corresponding commands to assist in making Hebrew- or Islamic-date
diary entries:
\\[insert-hebrew-diary-entry] insert a diary entry for the Hebrew date corresponding
to the selected date
\\[insert-monthly-hebrew-diary-entry] insert a diary entry for the day of the Hebrew month
corresponding to the selected day
\\[insert-yearly-hebrew-diary-entry] insert a diary entry for the day of the Hebrew year
corresponding to the selected day
\\[insert-islamic-diary-entry] insert a diary entry for the Islamic date corresponding
to the selected date
\\[insert-monthly-islamic-diary-entry] insert a diary entry for the day of the Islamic month
corresponding to the selected day
\\[insert-yearly-islamic-diary-entry] insert a diary entry for the day of the Islamic year
corresponding to the selected day
All of the diary entry commands make nonmarking entries when given a prefix
argument; with no prefix argument, the diary entries are marking.
The day number in the year and the number of days remaining in the year can be
determined by
\\[calendar-print-day-of-year] show day number and the number of days remaining in the year
Equivalent dates on the ISO commercial, Julian, Hebrew, Islamic, French
Revolutionary, and Mayan calendars can be determined by
\\[calendar-print-iso-date] show equivalent date on the ISO commercial calendar
\\[calendar-print-julian-date] show equivalent date on the Julian calendar
\\[calendar-print-hebrew-date] show equivalent date on the Hebrew calendar
\\[calendar-print-islamic-date] show equivalent date on the Islamic calendar
\\[calendar-print-french-date] show equivalent date on the French Revolutionary calendar
\\[calendar-print-mayan-date] show equivalent date on the Mayan calendar
The astronomical (Julian) day number of a date is found with
\\[calendar-print-astro-day-number] show equivalent astronomical (Julian) day number
To find the times of sunrise and sunset and lunar phases use
\\[calendar-sunrise-sunset] show times of sunrise and sunset
\\[calendar-phases-of-moon] show times of quarters of the moon
The times given apply to location `calendar-location-name' at latitude
`calendar-latitude', longitude `calendar-longitude'; set these variables for
your location. The following variables are also consulted, and you must set
them if your system does not initialize them properly: `calendar-time-zone',
`calendar-daylight-time-offset', `calendar-standard-time-zone-name',
`calendar-daylight-time-zone-name', `calendar-daylight-savings-starts',
`calendar-daylight-savings-ends', `calendar-daylight-savings-starts-time',
`calendar-daylight-savings-ends-time'.
To exit from the calendar use
\\[exit-calendar] exit from calendar
Set `view-diary-entries-initially' to a non-nil value to display
diary entries for the current date in
another window when the calendar is first displayed, if the current date is
visible. The variable `number-of-diary-entries' controls number of days of
diary entries that to display initially or with the command M-x
diary. For example, the default value 1 says to display only the current
day's diary entries. The value 2 says to display both the
current day's and the next day's entries.
The value can also be a vector such as [0 2 2 2 2 4 1]; this value
says to display no diary entries on Sunday, the display the entries
for the current date and the day after on Monday through Thursday,
display Friday through Monday's entries on Friday, and display only
Saturday's entries on Saturday.
Set `view-calendar-holidays-initially' to a non-nil value to display
holidays for the current three month period on entry to the calendar.
Set `mark-diary-entries-in-calendar' to a non-nil value to mark in the
calendar all the dates that have diary entries. The variable
`diary-entry-marker' controls how to mark them.
The variable `calendar-load-hook', whose default value is nil, is list of
functions to be called when the calendar is first loaded.
The variable `initial-calendar-window-hook', whose default value is nil, is
list of functions to be called when the calendar window is first opened. The
functions invoked are called after the calendar window is opened, but once
opened is never called again. Leaving the calendar with the `q' command and
reentering it will cause these functions to be called again.
The variable `today-visible-calendar-hook', whose default value is nil, is the
list of functions called after the calendar buffer has been prepared with the
calendar when the current date is visible in the window. This can be used,
for example, to replace today's date with asterisks; a function
calendar-star-date is included for this purpose:
(setq today-visible-calendar-hook 'calendar-star-date)
It could also be used to mark the current date; a function is also provided
for this:
(setq today-visible-calendar-hook 'calendar-mark-today)
The variable `today-invisible-calendar-hook', whose default value is nil, is
the list of functions called after the calendar buffer has been prepared with
the calendar when the current date is not visible in the window.
The variable `diary-display-hook' is the list of functions called after the
diary buffer is prepared. The default value simply displays the diary file
using selective-display to conceal irrelevant diary entries. An alternative
function `fancy-diary-display' is provided that, when used as the
`diary-display-hook', causes a noneditable buffer to be prepared with a neatly
organized day-by-day listing of relevant diary entries, together with any
known holidays. The inclusion of the holidays slows this fancy display of the
diary; to speed it up, set the variable `holidays-in-diary-buffer' to nil.
The variable `print-diary-entries-hook' is the list of functions called after
a temporary buffer is prepared with the diary entries currently visible in the
diary buffer. The default value of this hook adds a heading (composed from
the diary buffer's mode line), does the printing with the command lpr-buffer,
and kills the temporary buffer. Other uses might include, for example,
rearranging the lines into order by day and time.
The Gregorian calendar is assumed."
\\<calendar-mode-map>\\{calendar-mode-map}"
(kill-all-local-variables)
(setq major-mode 'calendar-mode)
@ -1830,34 +1566,63 @@ concatenated and the result truncated."
(calendar-string-spread
calendar-mode-line-format ? (frame-width))))))
(defun calendar-window-list ()
"List of all calendar-related windows."
(let ((calendar-buffers (calendar-buffer-list))
list)
(walk-windows '(lambda (w)
(if (memq (window-buffer w) calendar-buffers)
(setq list (cons w list))))
nil t)
list))
(defun calendar-buffer-list ()
"List of all calendar-related buffers."
(let* ((diary-buffer (get-file-buffer diary-file))
(buffers (list "*Yahrzeits*" lunar-phases-buffer holiday-buffer
fancy-diary-buffer diary-buffer calendar-buffer))
(buffer-list nil)
b)
(while buffers
(setq b (car buffers))
(setq b (cond ((stringp b) (get-buffer b))
((bufferp b) b)
(t nil)))
(if b (setq buffer-list (cons b buffer-list)))
(setq buffers (cdr buffers)))
buffer-list))
(defun exit-calendar ()
"Delete the calendar window, and bury the calendar and related buffers."
"Get out of the calendar window and hide it and related buffers."
(interactive)
(let ((diary-buffer (get-file-buffer diary-file))
(d-buffer (get-buffer fancy-diary-buffer))
(h-buffer (get-buffer holiday-buffer)))
(if (not diary-buffer)
(progn
;; Restoring the configuration is undesirable because
;; it restores the value of point in other windows.
;;; (set-window-configuration calendar-window-configuration)
(or (one-window-p t)
(delete-window))
(bury-buffer calendar-buffer)
(if d-buffer (bury-buffer d-buffer))
(if h-buffer (bury-buffer h-buffer)))
(if (or (not (buffer-modified-p diary-buffer))
(yes-or-no-p "Diary modified; do you really want to exit the calendar? "))
(progn
;;; (set-window-configuration calendar-window-configuration)
(or (one-window-p t)
(delete-window))
(bury-buffer calendar-buffer)
(if d-buffer (bury-buffer d-buffer))
(if h-buffer (bury-buffer h-buffer))
(set-buffer diary-buffer)
(set-buffer-modified-p nil)
(bury-buffer diary-buffer))))))
(let* ((diary-buffer (get-file-buffer diary-file)))
(if (and diary-buffer (buffer-modified-p diary-buffer)
(not
(yes-or-no-p
"Diary modified; do you really want to exit the calendar? ")))
(error)
;; Need to do this multiple times because one time can replace some
;; calendar-related buffers with other calendar-related buffers
(mapcar (lambda (x)
(mapcar 'calendar-hide-window (calendar-window-list)))
(calendar-window-list)))))
(defun calendar-hide-window (window)
"Hide WINDOW if it is calendar-related."
(let ((buffer (if (window-live-p window) (window-buffer window))))
(if (memq buffer (calendar-buffer-list))
(cond
((and window-system
(eq 'icon (cdr (assoc 'visibility
(frame-parameters
(window-frame window))))))
nil)
((and window-system (window-dedicated-p window))
(iconify-frame (window-frame window)))
((not (and (select-window window) (one-window-p window)))
(delete-window window))
(t (set-buffer buffer)
(bury-buffer))))))
(defun calendar-goto-today ()
"Reposition the calendar window so the current date is visible."
@ -1945,27 +1710,16 @@ position of the cursor with respect to the calendar as well as possible."
(scroll-calendar-left (* -3 arg)))
(defun calendar-current-date ()
"Returns the current date in a list (month day year).
If in the calendar buffer, also sets the current date local variables."
(let* ((date (current-time-string))
(garbage
(string-match
"^\\([A-Z][a-z]*\\) *\\([A-Z][a-z]*\\) *\\([0-9]*\\) .* \\([0-9]*\\)$"
date))
(month
(cdr (assoc
(substring date (match-beginning 2) (match-end 2))
'(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4)
("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8)
("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)))))
(day
(string-to-int (substring date (match-beginning 3) (match-end 3))))
(year
(string-to-int (substring date (match-beginning 4) (match-end 4)))))
(list month day year)))
"Returns the current date in a list (month day year)."
(let ((s (current-time-string)))
(list (length (member (substring s 4 7)
'("Dec" "Nov" "Oct" "Sep" "Aug" "Jul"
"Jun" "May" "Apr" "Mar" "Feb" "Jan")))
(string-to-number (substring s 8 10))
(string-to-number (substring s 20 24)))))
(defun calendar-cursor-to-date (&optional error)
"Returns a list of the month, day, and year of current cursor position.
"Returns a list (month day year) of current cursor position.
If cursor is not on a specific date, signals an error if optional parameter
ERROR is t, otherwise just returns nil."
(let* ((segment (/ (current-column) 25))
@ -2222,20 +1976,8 @@ Gregorian date Sunday, December 31, 1 BC."
(defun calendar-other-month (month year)
"Display a three-month calendar centered around MONTH and YEAR."
(interactive
(let* ((completion-ignore-case t)
(month (cdr (assoc
(capitalize
(completing-read
"Month name: "
(mapcar 'list (append calendar-month-name-array nil))
nil t))
(calendar-make-alist calendar-month-name-array))))
(year (calendar-read
"Year (>0): "
'(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year (calendar-current-date))))))
(list month year)))
(let* ((completion-ignore-case t))
(calendar-read-date t)))
(if (and (= month displayed-month)
(= year displayed-year))
nil
@ -2307,8 +2049,10 @@ is a string to insert in the minibuffer before reading."
(setq value (read-minibuffer prompt initial-contents)))
value))
(defun calendar-read-date ()
"Prompt for Gregorian date. Returns a list (month day year)."
(defun calendar-read-date (&optional noday)
"Prompt for Gregorian date. Returns a list (month day year).
If optional NODAY is t, does not ask for day, but just returns
(month nil year)."
(let* ((year (calendar-read
"Year (>0): "
'(lambda (x) (> x 0))
@ -2323,11 +2067,14 @@ is a string to insert in the minibuffer before reading."
(mapcar 'list (append month-array nil))
nil t))
(calendar-make-alist month-array 1 'capitalize))))
(last (calendar-last-day-of-month month year))
(last (calendar-last-day-of-month month year)))
(list month
(if noday
nil
(day (calendar-read
(format "Day (1-%d): " last)
'(lambda (x) (and (< 0 x) (<= x last))))))
(list month day year)))
year)))
(defun calendar-goto-date (date)
"Move cursor to DATE."