;;; And to many others for bug fixes and suggestions.

;;;

;;;

;;; pending appointment based on their diary file.

;;;

;;; A message will be displayed in the mode line of the Emacs buffer

;;; and (if you request) the terminal will beep and display a message

;;; have a message displayed in a new buffer.

;;;

;;; The variable `appt-message-warning-time' allows the

;;; variable `appt-issue-message' specifies whether the user wants

;;; to be notified of a pending appointment.

;;; In order to use the appt package, you only need

;;; to load it---provided you have appointments.

;;;

;;; Before that, you can also set some options if you want

;;; (setq view-diary-entries-initially t)

;;; (setq appt-issue-message t)

;;; This is an example of what can be in your diary file:

;;; Monday

;;; 9:30am Coffee break

;;; the calendar and diary will be displayed when you enter

;;; Emacs and your appointments list will automatically be created.

;;; You will then be reminded at 9:20am about your coffee break

;;;

;;; Use describe-function on appt-check for a description of other variables

;;; that can be used to personalize the notification system.

;;;###autoload

(defcustom appt-display-diary t

This will occur at midnight when the appointment list is updated."

:type 'boolean

:group 'appt)

"*Number of minutes to wait between checking the appointment list."

:type 'integer

:group 'appt)

(defvar appt-buffer-name " *appt-buf*"

"Name of the appointments buffer.")

(defvar appt-disp-window-function 'appt-disp-window

"Function called to display appointment window.")

(defvar appt-delete-window-function 'appt-delete-window

"Function called to remove appointment window and buffer.")

for a warning to be issued.

The format of the time can be either 24 hour or am/pm.

02/23/89

18:00 Dinner

Thursday

11:45am Lunch meeting.

Function called to display appointment window. You can customize

appt.el by setting this variable to a function different from the

one provided with this package.

`appt-delete-window-function'

Function called to remove appointment window and buffer. You can

customize appt.el by setting this variable to a function different

(cur-min (nth 1 now))

(cur-comp-time (+ (* cur-hour 60) cur-min)))

;; appointments to today's list.

(if (or (null appt-prev-comp-time)

(let ((appt-comp-time (car (car (car appt-time-msg-list)))))

(setq min-to-app (- appt-comp-time cur-comp-time))

(< appt-comp-time cur-comp-time))

(if appt-time-msg-list

(car (car (car appt-time-msg-list))))))

;; If we have an appointment between midnight and

;; we must begin to issue a message before midnight.

;; Midnight is considered 0 minutes and 11:59pm is

;; 1439 minutes. Therefore we must recalculate the minutes

;; minutes after midnight our appointment is.

(if (and (< appt-comp-time appt-message-warning-time)

(setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time))

appt-comp-time))

;; within appt-message-warning time

(when (and (<= min-to-app appt-message-warning-time)

;;; else

(if appt-visible

(car (cdr (car appt-time-msg-list)))))

(if appt-audible

;; before splitting the window.

(if (equal (selected-window) (minibuffer-window))

(select-window (other-window 1))

(if (display-multi-frame-p)

(select-frame (other-frame 1)))))

(let* ((this-buffer (current-buffer))

(this-window (selected-window))

(appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))

(appt-select-lowest-window)

(split-window))

(pop-to-buffer appt-disp-buf))

(concat "-------------------- Appointment in "

min-to-app " minutes. " new-time " %-"))

(erase-buffer)

(select-window this-window)

(if appt-audible

(beep 1))))

(defun appt-delete-window ()

"Function called to undisplay appointment messages.

Usually just deletes the appointment buffer."

(if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)

nil

(error "Unacceptable time-string"))

(let* ((appt-time-string (concat new-appt-time " " new-appt-msg))

(appt-time (list (appt-convert-time new-appt-time)))

(time-msg (cons appt-time (list appt-time-string))))

(setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg)))

;;;###autoload

(defun appt-delete ()

(let* ((tmp-msg-list appt-time-msg-list))

(while tmp-msg-list

(let* ((element (car tmp-msg-list))

;; We want to quote any doublequotes

;; in the string, as well as put

;; doublequotes around it.

(prin1-to-string

(substring-no-properties

" from list? "))

(test-input (y-or-n-p prompt-string)))

(setq tmp-msg-list (cdr tmp-msg-list))

(setq appt-time-msg-list (delq element appt-time-msg-list)))))

(appt-check)

(message "")))

(eval-when-compile (defvar number)

(defvar original-date)

(if diary-entries-list

;; Cycle through the entry-list (diary-entries-list)

;; the entry begins with a time, add it to the

;; appt-time-msg-list. Then sort the list.

(car entry-list) (list (calendar-current-date))))

(setq entry-list (cdr entry-list)))

;; Parse the entries for today.

(calendar-current-date) (car (car entry-list))))

(let ((time-string (cadr (car entry-list))))

(while (string-match

(appt-comp-time (car (car (car appt-time-msg-list)))))

(while (and appt-time-msg-list (< appt-comp-time cur-comp-time))

(if appt-time-msg-list

(setq appt-comp-time (car (car (car appt-time-msg-list))))))))))

(defun appt-sort-list (appt-list)

"Simple sort to put the appointments list APPT-LIST in order.

(min 0))

(string-match ":\\([0-9][0-9]\\)" time2conv)

(match-string 1 time2conv)))

(string-match "[0-9]?[0-9]:" time2conv)

(match-string 0 time2conv)))

;; convert the time appointment time into 24 hour time

(cond ((and (string-match "pm" time2conv) (< hr 12))

(setq hr (+ 12 hr)))

((and (string-match "am" time2conv) (= hr 12))

(setq hr 0)))

;; convert the actual time

;; into minutes for comparison

;; against the actual time.

(setq conv-time (+ (* hr 60) min))

conv-time))

(defvar chinese-calendar-terrestrial-branch

["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"])

'(if (< year 1928)

(+ 465 (/ 40.0 60.0))

480)

(/ year 4) ;; Leap days in prior years

(* 30 (1- month)) ;; Days in prior months this year

day))) ;; Days so far this month

(defun calendar-coptic-from-absolute (date)

"Compute the Coptic equivalent for absolute date DATE.

(defvar calendar-daylight-time-offset

(or (car (cdr calendar-current-time-zone-cache)) 60)

"*Number of minutes difference between daylight savings and standard time.

If the locale never uses daylight savings time, set this to 0.")

(defvar calendar-standard-time-zone-name

(or (car (nthcdr 3 calendar-current-time-zone-cache)) "EDT")

"*Abbreviated name of daylight-savings time zone at `calendar-location-name'.

For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.")

;;;###autoload

(put 'calendar-daylight-savings-starts 'risky-local-variable t)

(defvar calendar-daylight-savings-starts

'(calendar-nth-named-day -1 0 10 year)

If the locale never uses daylight savings time, set this to nil.")

(defvar calendar-daylight-savings-starts-time

(or (car (nthcdr 6 calendar-current-time-zone-cache)) 120)

"*Number of minutes after midnight that daylight savings time starts.")

(defvar calendar-daylight-savings-ends-time

(or (car (nthcdr 7 calendar-current-time-zone-cache))

calendar-daylight-savings-starts-time)

day)))

(if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday

(memq (% alternative-day 7) (list 0 3 5))

(1+ alternative-day)

alternative-day)))

(defun hebrew-calendar-days-in-year (year)

(list (calendar-gregorian-from-absolute (+ abs-r-h 22))

"Simchat Torah")))

(optional

(list (calendar-gregorian-from-absolute

(calendar-dayname-on-or-before 6 (- abs-r-h 4)))

"Selichot (night)")

(filter-visible-calendar-holidays mandatory)))

(if all-hebrew-calendar-holidays

(setq output-list

(filter-visible-calendar-holidays optional)

output-list)))

output-list)))

(list (calendar-gregorian-from-absolute (+ abs-p 50))

"Shavuot")))

(optional

(list (calendar-gregorian-from-absolute

(calendar-dayname-on-or-before 6 (- abs-p 43)))

"Shabbat Shekalim")

(filter-visible-calendar-holidays mandatory)))

(if all-hebrew-calendar-holidays

(setq output-list

(filter-visible-calendar-holidays optional)

output-list)))

output-list)))

(list 5 9 (+ displayed-year 3760)))))

(filter-visible-calendar-holidays

(list (calendar-gregorian-from-absolute

(if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))

"Tzom Tammuz")

(mark (regexp-quote diary-nonmarking-symbol)))

(calendar-for-loop i from 1 to number do

(let* ((d diary-date-forms)

(calendar-absolute-from-gregorian gdate)))

(month (extract-calendar-month hdate))

(day (extract-calendar-day hdate))

(setq mm 0)

(setq

mm

(assoc-ignore-case

mm-name

(calendar-make-alist

(make-diary-entry

(concat

hebrew-diary-entry-symbol

(calendar-hebrew-from-absolute

(calendar-absolute-from-gregorian

(calendar-cursor-to-date t)))

(make-diary-entry

(concat

hebrew-diary-entry-symbol

(calendar-hebrew-from-absolute

(calendar-absolute-from-gregorian

(calendar-cursor-to-date t)))))

(make-diary-entry

(concat

hebrew-diary-entry-symbol

(calendar-hebrew-from-absolute

(calendar-absolute-from-gregorian

(calendar-cursor-to-date t)))))

"Omer count diary entry.

Entry applies if date is within 50 days after Passover.

use when highlighting the day in the calendar."

(let* ((passover

(calendar-absolute-from-hebrew

(week (/ omer 7))

(day (% omer 7)))

(if (and (> omer 0) (< omer 50))

(format "Day %d%s of the omer (until sunset)"

omer

(if (zerop week)

Hebrew calendar yahrzeit is determined. If `european-calendar-style' is t, the

order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR.

use when highlighting the day in the calendar."

(let* ((h-date (calendar-hebrew-from-absolute

(calendar-absolute-from-gregorian

"Rosh Hodesh diary entry.

Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.

use when highlighting the day in the calendar."

(let* ((d (calendar-absolute-from-gregorian date))

(h-date (calendar-hebrew-from-absolute d))

(h-yesterday (extract-calendar-day

(calendar-hebrew-from-absolute (1- d)))))

(if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))

(format

"Rosh Hodesh %s"

(if (= h-day 30)

(format "%s (second day)" this-month)

this-month))))

(if (= (% d 7) 6) ;; Saturday--check for Shabbat Mevarchim

(cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))

(format "Mevarchim Rosh Hodesh %s (%s)"

(aref h-month-names

(defun diary-parasha (&optional mark)

"Parasha diary entry--entry applies if date is a Saturday.

use when highlighting the day in the calendar."

(let ((d (calendar-absolute-from-gregorian date)))

(if (= (% d 7) 6) ;; Saturday

(mark (regexp-quote diary-nonmarking-symbol)))

(calendar-for-loop i from 1 to number do

(let* ((d diary-date-forms)

(calendar-absolute-from-gregorian gdate)))

(month (extract-calendar-month idate))

(day (extract-calendar-day idate))

(make-diary-entry

(concat

islamic-diary-entry-symbol

(calendar-islamic-from-absolute

(calendar-absolute-from-gregorian

(calendar-cursor-to-date t)))

(make-diary-entry

(concat

islamic-diary-entry-symbol

(calendar-islamic-from-absolute

(calendar-absolute-from-gregorian

(calendar-cursor-to-date t)))))

(make-diary-entry

(concat

islamic-diary-entry-symbol

(calendar-islamic-from-absolute

(calendar-absolute-from-gregorian

(calendar-cursor-to-date t)))))

(defun calendar-iso-date-string (&optional date)

"String of ISO date of Gregorian DATE.

Defaults to today's date if DATE is not given."

(or date (calendar-current-date))))

(day (% d 7))

(iso-date (calendar-iso-from-absolute d)))

(mapcar 'list (append month-array nil))

nil t)

(calendar-make-alist month-array 1))))

(if (and (zerop (% year 4)) (= month 2))

29

(aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))

(day (calendar-read

(format "Julian calendar day (%d-%d): "

(if (and (= year 1) (= month 1)) 3 1) last)

(and (< (if (and (= year 1) (= month 1)) 2 0) x)

(<= x last))))))

(list (list month day year))))

365)))

(defun calendar-next-haab-date (haab-date &optional noecho)

Echo Mayan date if NOECHO is t."

(interactive (list (calendar-read-mayan-haab-date)))

(calendar-goto-date

(or noecho (calendar-print-mayan-date)))

(defun calendar-previous-haab-date (haab-date &optional noecho)

Echo Mayan date if NOECHO is t."

(interactive (list (calendar-read-mayan-haab-date)))

(calendar-goto-date

260)))

(defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)

Echo Mayan date if NOECHO is t."

(interactive (list (calendar-read-mayan-tzolkin-date)))

(calendar-goto-date

(or noecho (calendar-print-mayan-date)))

(defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)

Echo Mayan date if NOECHO is t."

(interactive (list (calendar-read-mayan-tzolkin-date)))

(calendar-goto-date

(defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)

"Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE.

Latest such date on or before DATE.

(let* ((haab-difference

(calendar-mayan-haab-difference

(calendar-mayan-haab-from-absolute 0)

(haab-day (calendar-read

"Haab kin (0-19): "

'(lambda (x) (and (>= x 0) (< x 20)))))

(and (< haab-day 5) '("Uayeb"))))

(haab-month (cdr

(assoc-ignore-case

(tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))

(tzolkin-name (cdr

(assoc-ignore-case

(mapcar 'list tzolkin-name-list)

nil t)

(calendar-make-alist tzolkin-name-list 1)))))

(defun calendar-mayan-date-string (&optional date)

"String of Mayan date of Gregorian DATE.

Defaults to today's date if DATE is not given."

(or date (calendar-current-date))))

(tzolkin (calendar-mayan-tzolkin-from-absolute d))

(haab (calendar-mayan-haab-from-absolute d))

(let (lc)

(while (not lc)

(let ((datum

(read-string "Mayan long count (baktun.katun.tun.uinal.kin): "

(calendar-mayan-long-count-to-string

(calendar-mayan-long-count-from-absolute

(calendar-gregorian-from-absolute

(calendar-absolute-from-mayan-long-count date)))

(or noecho (calendar-print-mayan-date)))

(defun calendar-mayan-long-count-common-era (lc)

"T if long count represents date in the Common Era."

(let ((base (calendar-mayan-long-count-from-absolute 1)))

(autoload 'calendar-iso-from-absolute "cal-iso" nil t)

;;;

;;;

(defcustom cal-tex-which-days '(0 1 2 3 4 5 6)

;;;

(defvar cal-tex-day-prefix "\\caldate{%s}{%s}"

The holidays, diary entries, bottom string, and the text follow.")

(defvar cal-tex-day-name-format "\\myday{%s}%%"

"The format for LaTeX code for a day name. The names are taken from

calendar-day-name-array.")

"\\def\\calmonth#1#2%

{\\begin{center}%

\\Huge\\bf\\uppercase{#1} #2 \\\\[1cm]%

\\vspace*{-1.5cm}%

%

"

"\\def\\calmonth#1#2#3#4%

{\\begin{center}%

\\Huge\\bf #1 #2---#3 #4\\\\[1cm]%

\\vspace*{-1.5cm}%

%

"

(cal-tex-end-document)))

(run-hooks 'cal-tex-hook))

"Insert LaTeX commands for a range of days in monthly calendars.

LaTeX commands are inserted for the days of the MONTH in YEAR.

Diary entries on DIARY-LIST are included. Holidays on HOLIDAYS are included.

(calendar-for-loop i from 1 to last do

(setq date (list month i year))

(if (memq (calendar-day-of-week date) cal-tex-which-days)

(insert (format day-format (cal-tex-month-name month) i))

(cal-tex-arg (cal-tex-latexify-list diary-list date))

(cal-tex-arg (cal-tex-latexify-list holidays date))

"Insert the names of the days at top of a monthly calendar."

(calendar-for-loop i from 0 to 6 do

(if (memq i cal-tex-which-days)

(cal-tex-LaTeXify-string

(mod (+ calendar-week-start-day i) 7))))))

(cal-tex-comment)))

(defun cal-tex-insert-month-header (n month year end-month end-year)

"Create a title for a calendar.

MONTH YEAR and ending with END-MONTH END-YEAR."

(let ((month-name (cal-tex-month-name month))

(end-month-name (cal-tex-month-name end-month)))

(if (= 1 n)

(insert (format "\\calmonth{%s}{%s}\n\\vspace*{-0.5cm}"

(insert (format "\\calmonth{%s}{%s}{%s}{%s}\n\\vspace*{-0.5cm}"

month-name year end-month-name end-year))))

(cal-tex-comment))

(- (calendar-day-of-week (list month 1 year))

calendar-week-start-day)

7)))

(if (memq i cal-tex-which-days)

(insert (format day-format " " " ") "{}{}{}{}%\n"))))))

(- (calendar-day-of-week (list month last-day year))

calendar-week-start-day)

7)))

(if (memq i cal-tex-which-days)

(insert (format day-format "" "") "{}{}{}{}%\n"))))))

(defun cal-tex-number-weeks (month year n)

"Determine the number of weeks in a range of dates.

this is only an upper bound."

(let ((d (list month 1 year)))

(increment-calendar-month month year (1- n))

(cal-tex-e-center)

(cal-tex-hspace "-.2in")

(cal-tex-b-parbox "l" "7in")

(cal-tex-week-hours date holidays "3.1")

(setq date (cal-tex-incr-date date)))

(cal-tex-e-parbox)

(cal-tex-e-center)

(cal-tex-hspace "-.2in")

(cal-tex-b-parbox "l" "\\textwidth")

(cal-tex-week-hours date holidays "5")

(setq date (cal-tex-incr-date date)))

(cal-tex-e-parbox)

(insert "}")

(cal-tex-nl)

(cal-tex-b-parbox "l" "\\textwidth")

(cal-tex-week-hours date holidays "5")

(setq date (cal-tex-incr-date date)))

(cal-tex-e-parbox)

(cal-tex-nl ".5cm")

(cal-tex-e-center)

(cal-tex-b-parbox "l" "\\textwidth")

(cal-tex-b-parbox "t" "\\textwidth")

(cal-tex-b-parbox "t" "\\textwidth")

(cal-tex-rule "0pt" "\\textwidth" ".2mm")

(cal-tex-end-document)

(run-hooks 'cal-tex-hook)))

"\\newcommand{\\hourbox}[2]%

{\\makebox[2em]{\\rule{0cm}{#2ex}#1}\\rule{3in}{.15mm}}\n"

"One hour and a line on the right.")

(defun cal-tex-week-hours (date holidays height)

(let ((month (extract-calendar-month date))

(day (extract-calendar-day date))

(year (extract-calendar-year date))

(calendar-for-loop i from 8 to 12 do

(insert (format "{\\large\\sf %d}\\\\\n" i)))

(calendar-for-loop i from 1 to 5 do

(if cal-tex-24 (+ i 12) i))))))

(cal-tex-nl ".5cm")

(if weekend

(progn

(cal-tex-vspace "1cm")

(insert "\\ \\vfill")

dayname1 month1 day1 year1))

(cal-tex-rule "0pt" "7.5cm" ".5mm")

(cal-tex-nl "1.5cm")

(cal-tex-month-name (extract-calendar-month d))

(extract-calendar-year d))))))

(insert "%\n")

(if (= (mod i 2) 1)

(insert "\\rightday")

(insert "\\leftday"))

(defun cal-tex-cursor-filofax-week (&optional arg)

"One-week-at-a-glance Filofax style calendar for week indicated by cursor.

Optional prefix argument specifies number of weeks.

Diary entries are included if `cal-tex-diary' is t.

Holidays are included if `cal-tex-holidays' is t."

(interactive "p")

(cal-tex-month-name (extract-calendar-month d))

(extract-calendar-year d))))))

(insert "%\n")

(insert "\\leftday")

(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))

(cal-tex-arg (int-to-string (extract-calendar-day date)))

(cal-tex-month-name (extract-calendar-month d))

(extract-calendar-year d))))))

(insert "%\n")

(insert "\\rightday")

(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))

(cal-tex-arg (int-to-string (extract-calendar-day date)))

(cal-tex-arg (eval cal-tex-daily-string))

(insert "%\n")

(setq date (cal-tex-incr-date date)))

(insert "\\weekend")

(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))

(cal-tex-arg (int-to-string (extract-calendar-day date)))

(defun cal-tex-cursor-filofax-daily (&optional arg)

"Day-per-page Filofax style calendar for week indicated by cursor.

Diary entries are included if `cal-tex-diary' is t.

Holidays are included if `cal-tex-holidays' is t.

Pages are ruled if `cal-tex-rules' is t."

(cal-tex-b-document)

(cal-tex-cmd "\\pagestyle{empty}")

(calendar-for-loop i from 1 to n do

(let ((odd (/= 0 (% j 2))))

(insert (if odd "\\righthead" "\\lefthead"))

(cal-tex-arg (calendar-date-string date))

(cal-tex-newpage)

(setq date (cal-tex-incr-date date)))

(insert "%\n")

(insert "\\lefthead")

(cal-tex-arg (calendar-date-string date))

(insert "\\weekend")

(cal-tex-hfill)

(insert "}")

(cal-tex-banner "end of cal-tex-daily-page")))

;;;

;;; Mini calendars

;;;

(setq str

(concat str

(cal-tex-LaTeXify-string

(mod (+ calendar-week-start-day i) 7))

0 2))

(if (/= i 6)

(defun cal-tex-end-document ()

"Finish the LaTeX document.

informative header, and run HOOK."

(cal-tex-e-document)

(latex-mode)

(pop-to-buffer cal-tex-buffer)

(cal-tex-comment " This buffer was produced by cal-tex.el.")

(cal-tex-comment " To print a calendar, type")

(cal-tex-comment " M-x tex-buffer RET")

(defun cal-tex-insert-preamble (weeks landscape size &optional append)

"Initialize the output buffer.

Use pointsize SIZE. Optional argument APPEND, if t, means add to end of

without erasing current contents."

(let ((width "18cm")

(if (not append)

(progn

(cal-tex-preamble size)

(progn

(cal-tex-cmd "\\oddsidemargin -1.75cm")

(cal-tex-cmd "\\def\\holidaymult{.06}"))

(/ 1.1 (length cal-tex-which-days))))

(cal-tex-cmd "\\setlength{\\cellheight}" height)

(insert (format "\\setlength{\\cellheight}{%f\\cellheight}\n"

(cal-tex-cmd "\\ \\par")

(cal-tex-vspace "-3cm")))

(defvar cal-tex-LaTeX-subst-list

'(("\"". "``")

("\"". "''");; Quote changes meaning when list is reversed.

("$" . "\\$")

("#" . "\\#")

("_" . "\\_")

(defun cal-tex-nl (&optional skip comment)

"End a line with \\. If SKIP, then add that much spacing.

Add COMMENT if present"

(insert "[" skip "]"))

(cal-tex-comment comment))

(defun cal-tex-arg (&optional text)

"Insert optional TEXT surrounded by braces."

(insert "{")

(defvar calendar-frame nil "Frame in which to display the calendar.")

(defvar diary-frame nil "Frame in which to display the diary.")

;; This should not specify the font. That's up to the user.

;; Certainly it should not specify auto-lower and auto-raise

;; since most users won't like that.

(unsplittable . t) (minibuffer . nil))

"Parameters of the diary frame, if the diary is in its own frame.

Location and color should be set in .Xdefaults.")

(defvar calendar-frame-parameters

'((name . "Calendar") (title . "Calendar") (minibuffer . nil)

(height . 10) (width . 80) (unsplittable . t) (vertical-scroll-bars . nil))

(minibuffer . nil))

"Parameters of the frame that displays both the calendar and the diary.

Location and color should be set in .Xdefaults.")

(defvar calendar-after-frame-setup-hooks nil

"Hooks to be run just after setting up a calendar frame.

Can be used to change frame parameters, such as font, color, location, etc.")

(defun calendar-one-frame-setup (&optional arg)

"Start calendar and display it in a dedicated frame together with the diary."

(if (not (display-multi-frame-p))

'("[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"

. font-lock-function-name-face)))

"Forms to highlight in diary-mode")

(provide 'diary-lib)

(name (if (string-equal choice "Equinoxes/Solstices")

choice

(if (member choice '("Ask" ""))

(format "%s Holidays" choice)))))

(list start-year end-year which name)))

(message "Computing holidays...")

(filter-visible-calendar-holidays mandatory)))

(if all-christian-calendar-holidays

(setq output-list

(filter-visible-calendar-holidays optional)

output-list)))

output-list)))

(increment-calendar-month end-month end-year 3)

(increment-calendar-month start-month start-year -1)

(let* ((end-date (list (list end-month 1 end-year)))

(calendar-last-day-of-month

start-month start-year)

start-year)))

(defun diary-phases-of-moon (&optional mark)

"Moon phases diary entry.

use when highlighting the day in the calendar."

(let* ((index (* 4

(truncate

'("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice")

"List of season changes for the southern hemisphere.")

"Sidereal time at Greenwich at midnight (universal time).")

(defvar solar-northern-spring-or-summer-season nil

(condition-case nil

(tan (degrees-to-radians (mod x 360.0)))

(solar-tangent-degrees x)))

(defun solar-xy-to-quadrant (x y)

"Determines the quadrant of the point X, Y."

(if (> x 0)

(floor (* 60 (- time (floor time))))))

(defun solar-exact-local-noon (date)

The date may be different from the one asked for, but it will be the right

local date. The second component of date should be an integer."

(te (solar-time-equation date ut)))

(setq ut (- ut te))

(if (>= ut 24)

(setq nd (list (car date) (+ 1 (car (cdr date)))

(car (cdr (cdr date)))))

(setq ut (- ut 24))))

(if (< ut 0)

(setq nd (list (car date) (- (car (cdr date)) 1)

(car (cdr (cdr date)))))

(setq ut (+ ut 24))))

(defun solar-julian-ut-centuries (date)

"Number of Julian centuries elapsed since 1 Jan, 2000 at noon U.T. for Gregorian DATE."

(calendar-absolute-from-gregorian '(1 1.5 2000)))

36525.0))

(defun solar-ephemeris-time(time)

"Ephemeris Time at moment TIME.

(setq end-long long)))

(/ (+ start end) 2.0)))

(time latitude longitude for-sunrise-sunset)

"Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE.

(* (solar-tangent-degrees de)

(solar-cosine-degrees latitude)))

(solar-sin-degrees ah)))

(+ (* (solar-sin-degrees latitude) (solar-sin-degrees de))

(* (solar-cosine-degrees latitude)

(solar-cosine-degrees de)

time. For instance, the pair corresponding to November 28, 1995 at 16 UT is

\(-0.040945 16), -0.040945 being the number of julian centuries elapsed between

Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT."

(ec (solar-ecliptic-coordinates tm for-sunrise-sunset)))

(list (solar-right-ascension (car ec) (car (cdr ec)))

(solar-declination (car ec) (car (cdr ec))))))

since January 1st, 2000, at 12 ET."

(let* ((l (+ 280.46645

(* 36000.76983 time)

(ml (+ 218.3165

(m (+ 357.52910

(* 35999.05030 time)

(* -0.0001559 time time)

(i (+ 23.43929111 (* -0.013004167 time)

(* -0.00000016389 time time)

(c (+ (* (+ 1.914600

(* -0.004817 time)

(* -0.000014 time time))

(* (+ 0.019993 (* -0.000101 time))

(solar-sin-degrees (* 2 m)))

(* 0.000290

(omega (+ 125.04

(* -1934.136 time))) ; longitude of moon's ascending node

; on the ecliptic

(* -0.00478

(solar-sin-degrees omega)))) ; apparent longitude of sun

(y (if (not for-sunrise-sunset)

(solar-tangent-degrees (/ i 2)))

nil))

(time-eq (if (not for-sunrise-sunset)

(/ (* 12 (+ (* y (solar-sin-degrees (* 2 l)))

(* -2 ecc (solar-sin-degrees m))

(solar-cosine-degrees (* 2 l)))

(* -0.5 y y (solar-sin-degrees (* 4 l)))

(* -1.25 ecc ecc (solar-sin-degrees (* 2 m)))))

(nut-i (solar-ecliptic-coordinates et nil))

(nut (car (cdr (cdr (cdr nut-i))))) ; nutation

(i (car (cdr nut-i)))) ; inclination

(/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0)

24.0)

24.0)))

"Type \\[delete-other-windows] to remove temp window."

"Type \\[switch-to-buffer] RET to remove temp window.")

"Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window."))))))

(defun calendar-sunrise-sunset ()

"Local time of sunrise and sunset for date under cursor.

Accurate to a few seconds."

"Local time of candle lighting diary entry--applies if date is a Friday.

No diary entry if there is no sunset on that date.

use when highlighting the day in the calendar."

(if (not (and calendar-latitude calendar-longitude calendar-time-zone))

(solar-setup))

(defun solar-equinoxes/solstices (k year)

"Date of equinox/solstice K for YEAR.

K=0, spring equinox; K=1, summer solstice; K=2, fall equinox;

RESULT is a gregorian local date.

Accurate to less than a minute between 1951 and 2050."

(W (- (* 35999.373 T) 2.47))

(Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W))

(* 0.0007 (solar-cosine-degrees (* 2 W)))))

(+ (* (car (cdr (cdr x))) T)

solar-seasons-data)))

(JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda)))

; ephemeris time correction

(JD (- JDE (/ correction 86400)))

(date (calendar-gregorian-from-absolute (floor (- JD 1721424.5))))

; from Meeus, 1991, page 166

(defun solar-mean-equinoxes/solstices (k year)

K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter

solstice. These formulas are only to be used between 1000 BC and 3000 AD."

(let ((y (/ year 1000.0))

(if calendar-time-zone calendar-daylight-savings-ends))

(calendar-time-zone (if calendar-time-zone calendar-time-zone 0))

(k (1- (/ m 3)))

(d1 (list (car d0) (floor (car (cdr d0))) (car (cdr (cdr d0)))))

(h0 (* 24 (- (car (cdr d0)) (floor (car (cdr d0))))))

(adj (dst-adjust-time d1 h0))

The first time that a user clocks in each day, this function will be

called to determine what the length of the current workday is. If

the return value is nil, or equal to `timeclock-workday', nothing special

however, a record will be output to the timelog file to note the fact that

that day has a different length from the norm."

:type '(choice (const nil) function)