;; 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)
+;;;###autoload
+(defcustom calendar-remove-frame-by-deleting nil
+ "*Determine how the calendar mode removes a frame no longer needed.
+If nil, make an icon of the frame. If non-nil, delete the frame."
+ :type 'boolean
+ :group 'view)
+
(when window-system
(add-to-list 'facemenu-unlisted-faces 'diary-face)
(defface diary-face
:type 'hook
:group 'calendar-hooks)
+;;;###autoload
+(defcustom calendar-move-hook nil
+ "*List of functions called whenever the cursor moves in the calendar.
+
+For example,
+
+ (add-hook 'calendar-move-hook (lambda () (view-diary-entries 1)))
+
+redisplays the diary for whatever date the cursor is moved to."
+ :type 'hook
+ :group 'calendar-hooks)
+
;;;###autoload
(defcustom diary-file "~/diary"
"*Name of the file in which one's personal diary of dates is kept.
(defcustom european-date-diary-pattern
'((day "/" month "[^/0-9]")
(day "/" month "/" year "[^0-9]")
- (backup day " *" monthname "\\W+\\<[^*0-9]")
+ (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)")
(day " *" monthname " *" year "[^0-9]")
(dayname "\\W"))
"*List of pseudo-patterns describing the European patterns of date used.
;;;###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.")
(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."
- (` (let (( macro-y (+ (* (, yr) 12) (, mon) -1 (, n) )))
- (setq (, mon) (1+ (% macro-y 12) ))
- (setq (, yr) (/ macro-y 12)))))
+ `(let ((macro-y (+ (* ,yr 12) ,mon -1 ,n)))
+ (setq ,mon (1+ (% macro-y 12)))
+ (setq ,yr (/ macro-y 12))))
(defmacro calendar-for-loop (var from init to final do &rest body)
"Execute a for loop."
- (` (let (( (, var) (1- (, init)) ))
- (while (>= (, final) (setq (, var) (1+ (, var))))
- (,@ body)))))
+ `(let ((,var (1- ,init)))
+ (while (>= ,final (setq ,var (1+ ,var)))
+ ,@body)))
(defmacro calendar-sum (index initial condition expression)
"For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
- (` (let (( (, index) (, initial))
- (sum 0))
- (while (, condition)
- (setq sum (+ sum (, expression) ))
- (setq (, index) (1+ (, index))))
- sum)))
+ `(let ((,index ,initial)
+ (sum 0))
+ (while ,condition
+ (setq sum (+ sum ,expression))
+ (setq ,index (1+ ,index)))
+ sum))
;; 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
(autoload 'calendar-two-frame-setup "cal-x"
"Start calendar and diary in separate, dedicated frames.")
-
+
;;;###autoload
(defvar calendar-setup nil
"The frame set up of the calendar.
The choices are `one-frame' (calendar and diary together in one separate,
-dedicated frame) or `two-frames' (calendar and diary in separate, dedicated
-frames); with any other value the current frame is used.")
+dedicated frame), `two-frames' (calendar and diary in separate, dedicated
+frames), `calendar-only' (calendar in a separate, dedicated frame); with
+any other value the current frame is used.")
;;;###autoload
(defun calendar (&optional arg)
(interactive "P")
(cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg))
((equal calendar-setup 'two-frames) (calendar-two-frame-setup arg))
+ ((equal calendar-setup 'calendar-only)
+ (calendar-only-one-frame-setup arg))
(t (calendar-basic-setup arg))))
(defun calendar-basic-setup (&optional arg)
"String of Chinese date of Gregorian date."
t)
-(autoload 'calendar-absolute-from-astro
+(autoload 'calendar-absolute-from-astro "cal-julian"
"Absolute date of astronomical (Julian) day number D."
- "cal-julian")
+ t )
(autoload 'calendar-astro-from-absolute "cal-julian"
"Astronomical (Julian) day number of absolute date D.")
"String of astronomical (Julian) day number of Gregorian date."
t)
-(autoload 'calendar-goto-astro-date "cal-julian"
+(autoload 'calendar-goto-astro-day-number "cal-julian"
"Move cursor to astronomical (Julian) day number."
t)
+(autoload 'calendar-print-astro-day-number "cal-julian"
+ "Show the astro date equivalents of date."
+ t)
+
(autoload 'calendar-julian-from-absolute "cal-julian"
"Compute the Julian (month day year) corresponding to the absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
Optional prefix argument specifies number of weeks.
Holidays are included if `cal-tex-holidays' is t.")
-(autoload 'cal-tex-cursor-week2 "cal-tex"
+(autoload 'cal-tex-cursor-week2 "cal-tex"
"Make a buffer with LaTeX commands for a two-page one-week calendar.
It applies to the week that point is in.
Optional prefix argument specifies number of weeks.
(autoload 'cal-tex-cursor-filofax-week "cal-tex"
"One-week-at-a-glance Filofax style calendar for week indicated by cursor.
Optional prefix argument specifies number of weeks.
-Weeks start on Monday.
+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-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.
+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.")
(defun redraw-calendar ()
"Redraw the calendar display."
(interactive)
- (let ((cursor-date (calendar-cursor-to-date)))
+ (let ((cursor-date (calendar-cursor-to-nearest-date)))
(generate-calendar-window displayed-month displayed-year)
(calendar-cursor-to-visible-date cursor-date)))
(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 "Aa" 'appt-add)
+ (define-key calendar-mode-map "Ad" '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)
(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? ")))
- (beep)
+ (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)
(window-frame window))))))
nil)
((and window-system (window-dedicated-p window))
- (iconify-frame (window-frame window)))
+ (if calendar-remove-frame-by-deleting
+ (delete-frame (window-frame window))
+ (iconify-frame (window-frame window))))
((not (and (select-window window) (one-window-p window)))
(delete-window window))
(t (set-buffer buffer)
(calendar-current-date)))))
(month-array calendar-month-name-array)
(completion-ignore-case t)
- (month (cdr (assoc
- (capitalize
+ (month (cdr (assoc-ignore-case
(completing-read
"Month name: "
(mapcar 'list (append month-array nil))
- nil t))
- (calendar-make-alist month-array 1 'capitalize))))
+ nil t)
+ (calendar-make-alist month-array 1))))
(last (calendar-last-day-of-month month year)))
(if noday
(if (eq noday t)
(t (substring string 0 width)))))
(defvar 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.")
(defvar calendar-month-name-array
["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.")
(defun calendar-make-alist (sequence &optional start-index filter)
"Make an assoc list corresponding to SEQUENCE.
(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)
HCoop / bpt / emacs.git / blobdiff