;; lunar.el Phases of the moon
;; solar.el Sunrise/sunset, equinoxes/solstices
-;; 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
-
;; Technical details of all the calendrical calculations can be found in
+;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
+;; Cambridge University Press (1997).
+;; An earlier version of the technical details appeared in
;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
;; pages 899-928. ``Calendrical Calculations, Part II: Three Historical
;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
;; the message BODY containing your mailing address (snail).
+;; 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:
(defun calendar-version ()
:type 'boolean
:group 'diary)
+(when window-system
+ (add-to-list 'facemenu-unlisted-faces 'diary-face)
+ (defface diary-face
+ '((((class color))
+ (:foreground "red"))
+ (t (:bold t)))
+ "Face for highlighting diary entries."
+ :group 'diary)
+
+ (add-to-list 'facemenu-unlisted-faces 'calendar-today-face)
+ (defface calendar-today-face
+ '((t (:underline t)))
+ "Face for indicating today's date."
+ :group 'diary)
+
+ (add-to-list 'facemenu-unlisted-faces 'holiday-face)
+ (defface holiday-face
+ '((((class color))
+ (:background "pink"))
+ (t (:inverse-video t)))
+ "Face for indicating dates that have holidays."
+ :group 'diary))
+
(defcustom diary-entry-marker
(if (not window-system)
"+"
- (require 'faces)
- (add-to-list 'facemenu-unlisted-faces 'diary-face)
- (make-face 'diary-face)
- (cond ((face-differs-from-default-p 'diary-face))
- ((x-display-color-p) (set-face-foreground 'diary-face "red"))
- (t (copy-face 'bold 'diary-face)))
'diary-face)
- "*Used to mark dates that have diary entries.
-Can be either a single-character string or a face."
+ "*How to mark dates that have diary entries.
+The value can be either a single-character string or a face."
:type '(choice string face)
:group 'diary)
(defcustom calendar-today-marker
(if (not window-system)
"="
- (require 'faces)
- (add-to-list 'facemenu-unlisted-faces 'calendar-today-face)
- (make-face 'calendar-today-face)
- (if (not (face-differs-from-default-p 'calendar-today-face))
- (set-face-underline-p 'calendar-today-face t))
'calendar-today-face)
- "*Used to mark today's date.
-Can be either a single-character string or a face."
+ "*How to mark today's date in the calendar.
+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'
+to request that."
:type '(choice string face)
:group 'calendar)
(defcustom calendar-holiday-marker
(if (not window-system)
"*"
- (require 'faces)
- (add-to-list 'facemenu-unlisted-faces 'holiday-face)
- (make-face 'holiday-face)
- (cond ((face-differs-from-default-p 'holiday-face))
- ((x-display-color-p) (set-face-background 'holiday-face "pink"))
- (t (set-face-background 'holiday-face "black")
- (set-face-foreground 'holiday-face "white")))
'holiday-face)
- "*Used to mark notable dates in the calendar.
-Can be either a single-character string or a face."
+ "*How to mark notable dates in the calendar.
+The value can be either a single-character string or a face."
:type '(choice string face)
:group 'calendar)
;;;###autoload
(defcustom diary-list-include-blanks nil
"*If nil, do not include days with no diary entry in the list of diary entries.
-Such days will then not be shown in the the fancy diary buffer, even if they
+Such days will then not be shown in the fancy diary buffer, even if they
are holidays."
:type 'boolean
:group 'diary)
(defcustom general-holidays
'((holiday-fixed 1 1 "New Year's Day")
(holiday-float 1 1 3 "Martin Luther King Day")
- (holiday-fixed 2 2 "Ground Hog Day")
+ (holiday-fixed 2 2 "Groundhog Day")
(holiday-fixed 2 14 "Valentine's Day")
(holiday-float 2 1 3 "President's Day")
(holiday-fixed 3 17 "St. Patrick's Day")
(defconst fancy-diary-buffer "*Fancy Diary Entries*"
"Name of the buffer used for the optional fancy display of the diary.")
+(defconst other-calendars-buffer "*Other Calendars*"
+ "Name of the buffer used for the display of date on other calendars.")
+
(defconst lunar-phases-buffer "*Phases of Moon*"
"Name of the buffer used for the lunar phases.")
"Move cursor to Julian DATE; echo Julian date unless NOECHO is t."
t)
+(autoload 'calendar-print-julian-date "cal-julian"
+ "Show the Julian calendar equivalent of the date under the cursor."
+ t)
+
(autoload 'calendar-julian-date-string "cal-julian"
"String of Julian date of Gregorian DATE.
Defaults to today's date if DATE is not given.
-Driven by the variable `calendar-date-display-form'."
- t)
+Driven by the variable `calendar-date-display-form'.")
(autoload 'calendar-goto-iso-date "cal-iso"
"Move cursor to ISO date."
Diary entries are included if cal-tex-diary is t.
Holidays are included if `cal-tex-holidays' is t.")
+(autoload 'cal-tex-cursor-filofax-daily "cal-tex"
+ "Day-per-page Filofax style calendar for week indicated by cursor.
+Optional prefix argument specifies number of weeks. Weeks start on Monday.
+Diary entries are included if `cal-tex-diary' is t.
+Holidays are included if `cal-tex-holidays' is t.")
+
(autoload 'cal-tex-cursor-year "cal-tex"
"Make a buffer with LaTeX commands for a year's calendar.
Optional prefix argument specifies number of years.")
indent t)
(calendar-insert-indented "" indent);; Go to proper spot
(calendar-for-loop i from 0 to 6 do
- (insert (substring (aref calendar-day-name-array
- (mod (+ calendar-week-start-day i) 7))
- 0 2))
+ (insert (calendar-day-name (mod (+ calendar-week-start-day i) 7)
+ 2 t))
(insert " "))
(calendar-insert-indented "" 0 t);; Force onto following line
(calendar-insert-indented "" indent);; Go to proper spot
(define-key calendar-mode-map "\e>" 'calendar-end-of-year)
(define-key calendar-mode-map "\C-@" 'calendar-set-mark)
;; Many people are used to typing C-SPC and getting C-@.
- (define-key calendar-mode-map [?\C-\ ] 'calendar-set-mark)
+ (define-key calendar-mode-map [?\C- ] 'calendar-set-mark)
(define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark)
(define-key calendar-mode-map "\e=" 'calendar-count-days-region)
(define-key calendar-mode-map "gd" 'calendar-goto-date)
(define-key calendar-mode-map "gmnh" 'calendar-next-haab-date)
(define-key calendar-mode-map "gmpt" 'calendar-previous-tzolkin-date)
(define-key calendar-mode-map "gmnt" 'calendar-next-tzolkin-date)
+ (define-key calendar-mode-map "A" 'appt-add)
+ (define-key calendar-mode-map "D" 'appt-delete)
(define-key calendar-mode-map "S" 'calendar-sunrise-sunset)
(define-key calendar-mode-map "M" 'calendar-phases-of-moon)
(define-key calendar-mode-map " " 'scroll-other-window)
(define-key calendar-mode-map "pi" 'calendar-print-islamic-date)
(define-key calendar-mode-map "pf" 'calendar-print-french-date)
(define-key calendar-mode-map "pm" 'calendar-print-mayan-date)
+ (define-key calendar-mode-map "po" 'calendar-print-other-dates)
(define-key calendar-mode-map "id" 'insert-diary-entry)
(define-key calendar-mode-map "iw" 'insert-weekly-diary-entry)
(define-key calendar-mode-map "im" 'insert-monthly-diary-entry)
(define-key calendar-mode-map "tw2" 'cal-tex-cursor-week2)
(define-key calendar-mode-map "tw3" 'cal-tex-cursor-week-iso)
(define-key calendar-mode-map "tw4" 'cal-tex-cursor-week-monday)
+ (define-key calendar-mode-map "tfd" 'cal-tex-cursor-filofax-daily)
(define-key calendar-mode-map "tfw" 'cal-tex-cursor-filofax-2week)
(define-key calendar-mode-map "tfW" 'cal-tex-cursor-filofax-week)
(define-key calendar-mode-map "tfy" 'cal-tex-cursor-filofax-year)
(setq buffer-read-only t)
(setq indent-tabs-mode nil)
(update-calendar-mode-line)
+ (if window-system
+ (progn
+ (make-local-hook 'activate-menubar-hook)
+ (add-hook 'activate-menubar-hook 'cal-menu-update nil t)))
(make-local-variable 'calendar-mark-ring)
(make-local-variable 'displayed-month);; Month in middle of window.
(make-local-variable 'displayed-year));; Year in middle of window.
"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))
+ fancy-diary-buffer diary-buffer calendar-buffer
+ other-calendars-buffer))
(buffer-list nil)
b)
(while buffers
"Get out of the calendar window and hide it and related buffers."
(interactive)
(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)
+ (if (or (not diary-buffer)
+ (not (buffer-modified-p diary-buffer))
+ (yes-or-no-p
+ "Diary modified; do you really want to exit the calendar? "))
;; Need to do this multiple times because one time can replace some
;; calendar-related buffers with other calendar-related buffers
(mapcar (lambda (x)
(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); if NODAY is any other non-nil value the value returned is
-(month year) "
+\(month nil year); if NODAY is any other non-nil value the value returned is
+\(month year) "
(let* ((year (calendar-read
"Year (>0): "
'(lambda (x) (> x 0))
(+ (* 12 (- yr2 yr1))
(- mon2 mon1)))
-(defun calendar-day-name (date)
- "Returns a string with the name of the day of the week of DATE."
- (aref calendar-day-name-array (calendar-day-of-week date)))
+(defun calendar-day-name (date &optional width absolute)
+ "Returns a string with the name of the day of the week of DATE.
+If WIDTH is non-nil, return just the first WIDTH characters of the name.
+If ABSOLUTE is non-nil, then DATE is actually the day-of-the-week
+rather than a date."
+ (let ((string (aref calendar-day-name-array
+ (if absolute date (calendar-day-of-week date)))))
+ (cond ((null width) string)
+ (enable-multibyte-characters (truncate-string-to-width string width))
+ (t (substring string 0 width)))))
(defvar calendar-day-name-array
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"])
index))
(append sequence nil))))
-(defun calendar-month-name (month)
- "The name of MONTH."
- (aref calendar-month-name-array (1- month)))
+(defun calendar-month-name (month &optional width)
+ "The name of MONTH.
+If WIDTH is non-nil, return just the first WIDTH characters of the name."
+ (let ((string (aref calendar-month-name-array (1- month))))
+ (if width
+ (let ((i 0) (result "") (pos 0))
+ (while (< i width)
+ (let ((chartext (char-to-string (sref string pos))))
+ (setq pos (+ pos (length chartext)))
+ (setq result (concat result chartext)))
+ (setq i (1+ i)))
+ result)
+ string)))
(defun calendar-day-of-week (date)
"Returns the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."
(if nodayname
nil
(if abbreviate
- (substring (calendar-day-name date) 0 3)
+ (calendar-day-name date 3)
(calendar-day-name date))))
(month (extract-calendar-month date))
(monthname
(if abbreviate
- (substring
- (calendar-month-name month) 0 3)
+ (calendar-month-name month 3)
(calendar-month-name month)))
(day (int-to-string (extract-calendar-day date)))
(month (int-to-string month))
(format "Day %d of %d; %d day%s remaining in the year"
day year days-remaining (if (= days-remaining 1) "" "s"))))
+(defun calendar-print-other-dates ()
+ "Show dates on other calendars for date under the cursor."
+ (interactive)
+ (let* ((date (calendar-cursor-to-date t)))
+ (save-excursion
+ (set-buffer (get-buffer-create other-calendars-buffer))
+ (setq buffer-read-only nil)
+ (calendar-set-mode-line
+ (concat (calendar-date-string date) " (Gregorian)"))
+ (erase-buffer)
+ (insert
+ (mapconcat 'identity
+ (list (calendar-day-of-year-string date)
+ (format "ISO date: %s" (calendar-iso-date-string date))
+ (format "Julian date: %s"
+ (calendar-julian-date-string date))
+ (format
+ "Astronomical (Julian) day number (at noon UTC): %s.0"
+ (calendar-astro-date-string date))
+ (format "Fixed (RD) date: %s"
+ (calendar-absolute-from-gregorian date))
+ (format "Hebrew date (before sunset): %s"
+ (calendar-hebrew-date-string date))
+ (format "Persian date: %s"
+ (calendar-persian-date-string date))
+ (let ((i (calendar-islamic-date-string date)))
+ (if (not (string-equal i ""))
+ (format "Islamic date (before sunset): %s" i)))
+ (format "Chinese date: %s"
+ (calendar-chinese-date-string date))
+ (let ((c (calendar-coptic-date-string date)))
+ (if (not (string-equal c ""))
+ (format "Coptic date: %s" c)))
+ (let ((e (calendar-ethiopic-date-string date)))
+ (if (not (string-equal e ""))
+ (format "Ethiopic date: %s" e)))
+ (let ((f (calendar-french-date-string date)))
+ (if (not (string-equal f ""))
+ (format "French Revolutionary date: %s" f)))
+ (format "Mayan date: %s"
+ (calendar-mayan-date-string date)))
+ "\n"))
+ (goto-char (point-min))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (display-buffer other-calendars-buffer))))
+
(defun calendar-print-day-of-year ()
"Show day number in year/days remaining in year for date under the cursor."
(interactive)