I will be committing theses changes this weekend.
Jeff
ChangeLog addition:
2006-08-18 Jeff Miller <jeff.miller(a)xemacs.org>
Further syncs with Emacs CVS
2002-11-08 John Wiegley <johnw(a)gnu.org>
* calendar/timeclock.el (timeclock-modeline-display): Use assq as
well as memq to find `global-mode-string' within
`mode-line-format'. The structure of that variable has changed in
21.3.
2002-08-30 Edward M. Reingold <reingold(a)emr.cs.iit.edu>
* calendar/diary-lib.el (diary-mail-entries): Don't overwrite
user's value of diary-list-include-blanks, but generate message
instead if there are no entries.
2002-08-06 Sam Steingold <sds(a)gnu.org>
* calendar/diary-lib.el (diary-mail-entries):
(diary-modified, diary-entries-list, displayed-year)
(displayed-month, entry, date, number, date-string, d-file)
(original-date): Defvar without binding to avoid compiler warnings.
* calendar/diary-lib.el (diary-mail-entries): Use `compose-mail'
and `mail-user-agent' instead of straight sendmail.
2002-07-22 Alan Shutko <ats(a)acm.org>
* calendar/solar.el (diary-sabbath-candles): Add optional MARK
parameter, specifying what face or character to use in the
calendar display. These will now return (MARK . ENTRY).
* calendar/lunar.el (diary-phases-of-moon): Add optional MARK
parameter, specifying what face or character to use in the
calendar display. These will now return (MARK . ENTRY).
* calendar/cal-hebrew.el (diary-omer, diary-yahrzeit)
(diary-rosh-hodesh, diary-parasha, diary-parasha): Add optional
MARK parameter, specifying what face or character to use in the
calendar display. These will now return (MARK . ENTRY).
* calendar/diary-lib.el (mark-sexp-diary-entries): Retrieve mark
from diary-sexp-entry and pass it to mark-visible-calendar-date.
(list-sexp-diary-entries): Update doc string for new docs for ....
If diary-sexp-entry returns a cons, only add the text to the diary
list.
(diary-sexp-entry): Allow sexps to return a cons of the form (MARK
. STRING) to specify what face or character mark should be used in
the calendar display.
(diary-date, diary-block, diary-float, diary-anniversary)
(diary-cyclic): Add optional MARK parameter, specifying what face
or character to use in the calendar display. These will now
return (MARK . ENTRY).
* calendar/diary-lib.el (check-calendar-holidays, diary-iso-date)
(calendar-holiday-list, diary-french-date, diary-mayan-date)
(diary-julian-date, diary-astro-day-number, diary-chinese-date)
(diary-islamic-date, list-islamic-diary-entries)
(mark-islamic-diary-entries, mark-islamic-calendar-date-pattern)
(diary-hebrew-date, diary-omer, diary-yahrzeit, diary-parasha)
(diary-rosh-hodesh, list-hebrew-diary-entries)
(mark-hebrew-diary-entries, mark-hebrew-calendar-date-pattern)
(diary-coptic-date, diary-persian-date, diary-phases-of-moon)
(diary-sunrise-sunset, diary-sabbath-candles):
Remove interactive flag from autoloads.
2002-07-13 Glenn Morris <gmorris(a)ast.cam.ac.uk>
* calendar/timeclock.el (timeclock-in): Handle the case where no
log file exists (ie the very first call).
2002-04-22 Edward M. Reingold <reingold(a)emr.cs.iit.edu>
* diary-lib.el (include-other-diary-files): Allow modifying
included buffer, to turn off selective display.
calendar source patch:
Diff command: cvs -q diff -uN
Files affected: timeclock.el solar.el lunar.el diary-lib.el cal-hebrew.el
Index: cal-hebrew.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-hebrew.el,v
retrieving revision 1.5
diff -u -b -w -u -r1.5 cal-hebrew.el
--- cal-hebrew.el 2006/08/04 20:23:50 1.5
+++ cal-hebrew.el 2006/08/19 00:02:18
@@ -898,9 +898,12 @@
"Hebrew calendar equivalent of date diary entry."
(format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
-(defun diary-omer ()
+(defun diary-omer (&optional mark)
"Omer count diary entry.
-Entry applies if date is within 50 days after Passover."
+Entry applies if date is within 50 days after Passover.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."
(let* ((passover
(calendar-absolute-from-hebrew
(list 1 15 (+ (extract-calendar-year date) 3760))))
@@ -908,6 +911,7 @@
(week (/ omer 7))
(day (% omer 7)))
(if (and (> omer 0) (< omer 50))
+ (cons mark
(format "Day %d%s of the omer (until sunset)"
omer
(if (zerop week)
@@ -918,15 +922,18 @@
(if (zerop day)
""
(format " and %d day%s"
- day (if (= day 1) "" "s")))))))))
+ day (if (= day 1) "" "s"))))))))))
-(defun diary-yahrzeit (death-month death-day death-year)
+(defun diary-yahrzeit (death-month death-day death-year &optional mark)
"Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
to be the name of the person. Date of death is on the *civil* calendar;
although the date of death is specified by the civil calendar, the proper
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."
+order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."
(let* ((h-date (calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(if european-calendar-style
@@ -940,6 +947,7 @@
(diff (- yr h-year))
(y (hebrew-calendar-yahrzeit h-date yr)))
(if (and (> diff 0) (or (= y d) (= y (1+ d))))
+ (cons mark
(format "Yahrzeit of %s%s: %d%s anniversary"
entry
(if (= y d) "" " (evening)")
@@ -947,11 +955,14 @@
(cond ((= (% diff 10) 1) "st")
((= (% diff 10) 2) "nd")
((= (% diff 10) 3) "rd")
- (t "th"))))))
+ (t "th")))))))
-(defun diary-rosh-hodesh ()
+(defun diary-rosh-hodesh (&optional mark)
"Rosh Hodesh diary entry.
-Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
+Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."
(let* ((d (calendar-absolute-from-gregorian date))
(h-date (calendar-hebrew-from-absolute d))
(h-month (extract-calendar-month h-date))
@@ -967,6 +978,7 @@
(h-yesterday (extract-calendar-day
(calendar-hebrew-from-absolute (1- d)))))
(if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
+ (cons mark
(format
"Rosh Hodesh %s"
(if (= h-day 30)
@@ -978,8 +990,9 @@
(aref h-month-names h-month))
(if (= h-yesterday 30)
(format "%s (second day)" this-month)
- this-month)))
+ this-month))))
(if (= (% d 7) 6);; Saturday--check for Shabbat Mevarchim
+ (cons mark
(cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
(format "Mevarchim Rosh Hodesh %s (%s)"
(aref h-month-names
@@ -995,17 +1008,21 @@
"tomorrow"
(aref calendar-day-name-array (- 29 h-day)))
(aref calendar-day-name-array
- (% (- 30 h-day) 7)))))
+ (% (- 30 h-day) 7))))))
(if (and (= h-day 29) (/= h-month 6))
+ (cons mark
(format "Erev Rosh Hodesh %s"
(aref h-month-names
(if (= h-month
(hebrew-calendar-last-month-of-year
h-year))
- 0 h-month))))))))
+ 0 h-month)))))))))
+
+(defun diary-parasha (&optional mark)
+ "Parasha diary entry--entry applies if date is a Saturday.
-(defun diary-parasha ()
- "Parasha diary entry--entry applies if date is a Saturday."
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."
(let ((d (calendar-absolute-from-gregorian date)))
(if (= (% d 7) 6);; Saturday
(let*
@@ -1034,6 +1051,7 @@
(/ (- d first-saturday) 7))
(parasha (aref year-format saturday)))
(if parasha
+ (cons mark
(format
"Parashat %s"
(if (listp parasha);; Israel differs from diaspora
@@ -1043,7 +1061,7 @@
(hebrew-calendar-parasha-name (cdr parasha)))
(format "%s (Israel)"
(hebrew-calendar-parasha-name (cdr parasha))))
- (hebrew-calendar-parasha-name parasha))))))))
+ (hebrew-calendar-parasha-name parasha)))))))))
(defvar hebrew-calendar-parashiot-names
["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth"
Index: diary-lib.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/diary-lib.el,v
retrieving revision 1.6
diff -u -b -w -u -r1.6 diary-lib.el
--- diary-lib.el 2006/08/04 20:23:50 1.6
+++ diary-lib.el 2006/08/19 00:02:18
@@ -91,108 +91,83 @@
(autoload 'check-calendar-holidays "holidays"
"Check the list of holidays for any that occur on DATE.
The value returned is a list of strings of relevant holiday descriptions.
-The holidays are those in the list `calendar-holidays'."
- t)
+The holidays are those in the list `calendar-holidays'.")
(autoload 'calendar-holiday-list "holidays"
"Form the list of holidays that occur on dates in the calendar window.
-The holidays are those in the list `calendar-holidays'."
- t)
+The holidays are those in the list `calendar-holidays'.")
(autoload 'diary-french-date "cal-french"
- "French calendar equivalent of date diary entry."
- t)
+ "French calendar equivalent of date diary entry.")
(autoload 'diary-mayan-date "cal-mayan"
- "Mayan calendar equivalent of date diary entry."
- t)
+ "Mayan calendar equivalent of date diary entry.")
(autoload 'diary-iso-date "cal-iso"
- "ISO calendar equivalent of date diary entry."
- t)
+ "ISO calendar equivalent of date diary entry.")
(autoload 'diary-julian-date "cal-julian"
- "Julian calendar equivalent of date diary entry."
- t)
+ "Julian calendar equivalent of date diary entry.")
(autoload 'diary-astro-day-number "cal-julian"
- "Astronomical (Julian) day number diary entry."
- t)
+ "Astronomical (Julian) day number diary entry.")
(autoload 'diary-chinese-date "cal-china"
- "Chinese calendar equivalent of date diary entry."
- t)
+ "Chinese calendar equivalent of date diary entry.")
(autoload 'diary-islamic-date "cal-islam"
- "Islamic calendar equivalent of date diary entry."
- t)
+ "Islamic calendar equivalent of date diary entry.")
(autoload 'list-islamic-diary-entries "cal-islam"
- "Add any Islamic date entries from the diary file to `diary-entries-list'."
- t)
+ "Add any Islamic date entries from the diary file to `diary-entries-list'.")
(autoload 'mark-islamic-diary-entries "cal-islam"
- "Mark days in the calendar window that have Islamic date diary entries."
- t)
+ "Mark days in the calendar window that have Islamic date diary entries.")
(autoload 'mark-islamic-calendar-date-pattern "cal-islam"
- "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR."
- t)
+ "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.")
(autoload 'diary-hebrew-date "cal-hebrew"
- "Hebrew calendar equivalent of date diary entry."
- t)
+ "Hebrew calendar equivalent of date diary entry.")
(autoload 'diary-omer "cal-hebrew"
- "Omer count diary entry."
- t)
+ "Omer count diary entry.")
(autoload 'diary-yahrzeit "cal-hebrew"
- "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before."
- t)
+ "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.")
(autoload 'diary-parasha "cal-hebrew"
- "Parasha diary entry--entry applies if date is a Saturday."
- t)
+ "Parasha diary entry--entry applies if date is a Saturday.")
(autoload 'diary-rosh-hodesh "cal-hebrew"
- "Rosh Hodesh diary entry."
- t)
+ "Rosh Hodesh diary entry.")
(autoload 'list-hebrew-diary-entries "cal-hebrew"
- "Add any Hebrew date entries from the diary file to `diary-entries-list'."
- t)
+ "Add any Hebrew date entries from the diary file to `diary-entries-list'.")
(autoload 'mark-hebrew-diary-entries "cal-hebrew"
- "Mark days in the calendar window that have Hebrew date diary entries."
- t)
+ "Mark days in the calendar window that have Hebrew date diary entries.")
(autoload 'mark-hebrew-calendar-date-pattern "cal-hebrew"
- "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR."
- t)
+ "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.")
(autoload 'diary-coptic-date "cal-coptic"
- "Coptic calendar equivalent of date diary entry."
- t)
+ "Coptic calendar equivalent of date diary entry.")
(autoload 'diary-ethiopic-date "cal-coptic"
- "Ethiopic calendar equivalent of date diary entry."
- t)
+ "Ethiopic calendar equivalent of date diary entry.")
(autoload 'diary-persian-date "cal-persia"
- "Persian calendar equivalent of date diary entry."
- t)
+ "Persian calendar equivalent of date diary entry.")
-(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry." t)
+(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry.")
(autoload 'diary-sunrise-sunset "solar"
- "Local time of sunrise and sunset as a diary entry."
- t)
+ "Local time of sunrise and sunset as a diary entry.")
(autoload 'diary-sabbath-candles "solar"
"Local time of candle lighting diary entry--applies if date is a Friday.
-No diary entry if there is no sunset on that date."
- t)
+No diary entry if there is no sunset on that date.")
(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table))
"The syntax table used when parsing dates in the diary file.
@@ -202,6 +177,17 @@
(modify-syntax-entry ?* "w" diary-syntax-table)
(modify-syntax-entry ?: "w" diary-syntax-table)
+(defvar diary-modified)
+(defvar diary-entries-list)
+(defvar displayed-year)
+(defvar displayed-month)
+(defvar entry)
+(defvar date)
+(defvar number)
+(defvar date-string)
+(defvar d-file)
+(defvar original-date)
+
;;;###autoload
(defun list-diary-entries (date number)
"Create and display a buffer containing the relevant lines in diary-file.
@@ -239,8 +225,8 @@
(if (< 0 number)
(let* ((original-date date);; save for possible use in the hooks
- (old-diary-syntax-table)
- (diary-entries-list)
+ old-diary-syntax-table
+ diary-entries-list
(date-string (calendar-date-string date))
(d-file (substitute-in-file-name diary-file)))
(message "Preparing diary...")
@@ -389,7 +375,8 @@
(list-diary-entries original-date number)))
(save-excursion
(set-buffer (find-buffer-visiting diary-file))
- (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
+ (let ((inhibit-read-only t))
+ (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))
(setq selective-display nil)
(set-buffer-modified-p diary-modified)))
(beep)
@@ -644,13 +631,13 @@
(if ndays ndays diary-mail-days))
(set-buffer fancy-diary-buffer)
(buffer-substring (point-min) (point-max)))))
- (mail)
- (mail-to) (insert diary-mail-addr)
- (mail-subject) (insert "Diary entries generated "
- (calendar-date-string (calendar-current-date)))
- (mail-text) (insert text)
- (mail-send-and-exit nil)))
-
+ (compose-mail diary-mail-addr
+ (if (string-equal text "")
+ "No entries found"
+ (concat "Diary entries generated "
+ (calendar-date-string (calendar-current-date)))))
+ (insert text)
+ (funcall (get mail-user-agent 'sendfunc))))
(defun diary-name-pattern (string-array &optional fullname)
"Convert a STRING-ARRAY, an array of strings to a pattern.
@@ -811,7 +798,8 @@
(m)
(y)
(first-date)
- (last-date))
+ (last-date)
+ (mark))
(save-excursion
(set-buffer calendar-buffer)
(setq m displayed-month)
@@ -859,10 +847,12 @@
(while (string-match "[\^M]" entry)
(aset entry (match-beginning 0) ?\n )))
(calendar-for-loop date from first-date to last-date do
- (if (diary-sexp-entry sexp entry
- (calendar-gregorian-from-absolute date))
+ (if (setq mark (diary-sexp-entry sexp entry
+ (calendar-gregorian-from-absolute date)))
(mark-visible-calendar-date
- (calendar-gregorian-from-absolute date))))))))
+ (calendar-gregorian-from-absolute date)
+ (if (consp mark)
+ (car mark)))))))))
(defun mark-included-diary-files ()
"Mark the diary entries from other diary files with those of the diary file.
@@ -965,9 +955,9 @@
:version "20.3")
(defun diary-entry-time (s)
- "Time at the beginning of the string S in a military-style integer. For
-example, returns 1325 for 1:25pm. Returns `diary-unknown-time' (default value
--9999) if no time is recognized. The recognized forms are XXXX, X:XX, or
+ "Return time at the beginning of the string S as a military-style integer.
+For example, returns 1325 for 1:25pm.
+Returns `diary-unknown-time' (default value -9999) if no time is recognized. The recognized forms are XXXX, X:XX, or
XX:XX (military time), and XXam, XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm,
or XX:XXPM."
(let ((case-fold-search nil))
@@ -1022,27 +1012,34 @@
A number of built-in functions are available for this type of diary entry:
- %%(diary-date MONTH DAY YEAR) text
+ %%(diary-date MONTH DAY YEAR &optional MARK) text
Entry applies if date is MONTH, DAY, YEAR if
`european-calendar-style' is nil, and DAY, MONTH, YEAR if
`european-calendar-style' is t. DAY, MONTH, and YEAR
can be lists of integers, the constant t, or an integer.
- The constant t means all values.
+ The constant t means all values. An optional parameter
+ MARK specifies a face or single-character string to use
+ when highlighting the day in the calendar.
- %%(diary-float MONTH DAYNAME N &optional DAY) text
+
+ %%(diary-float MONTH DAYNAME N &optional DAY MARK) text
Entry will appear on the Nth DAYNAME of MONTH.
(DAYNAME=0 means Sunday, 1 means Monday, and so on;
if N is negative it counts backward from the end of
the month. MONTH can be a list of months, a single
month, or t to specify all months. Optional DAY means
Nth DAYNAME of MONTH on or after/before DAY. DAY defaults
- to 1 if N>0 and the last day of the month if N<0.
+ to 1 if N>0 and the last day of the month if N<0. An
+ optional parameter MARK specifies a face or single-character
+ string to use when highlighting the day in the calendar.
- %%(diary-block M1 D1 Y1 M2 D2 Y2) text
+ %%(diary-block M1 D1 Y1 M2 D2 Y2 &optional MARK) text
Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
inclusive. (If `european-calendar-style' is t, the
order of the parameters should be changed to D1, M1, Y1,
- D2, M2, Y2.)
+ D2, M2, Y2.) An optional parameter MARK specifies a face
+ or single-character string to use when highlighting the
+ day in the calendar.
%%(diary-countdown BEFORE AFTER M1 D1 Y1) text
Entry will appear on dates between BEFORE days before
@@ -1051,7 +1048,7 @@
parameters should be changed to BEFORE, AFTER, D1, M1,
Y1.)
- %%(diary-anniversary MONTH DAY YEAR) text
+ %%(diary-anniversary MONTH DAY YEAR &optional MARK) text
Entry will appear on anniversary dates of MONTH DAY, YEAR.
(If `european-calendar-style' is t, the order of the
parameters should be changed to DAY, MONTH, YEAR.) Text
@@ -1059,16 +1056,20 @@
of years since the MONTH DAY, YEAR and %s will be replaced
by the ordinal ending of that number (that is, `st', `nd',
`rd' or `th', as appropriate. The anniversary of February
- 29 is considered to be March 1 in a non-leap year.
+ 29 is considered to be March 1 in a non-leap year. An
+ optional parameter MARK specifies a face or single-character
+ string to use when highlighting the day in the calendar.
- %%(diary-cyclic N MONTH DAY YEAR) text
+ %%(diary-cyclic N MONTH DAY YEAR &optional MARK) text
Entry will appear every N days, starting MONTH DAY, YEAR.
(If `european-calendar-style' is t, the order of the
parameters should be changed to N, DAY, MONTH, YEAR.) Text
can contain %d or %d%s; %d will be replaced by the number
of repetitions since the MONTH DAY, YEAR and %s will
be replaced by the ordinal ending of that number (that is,
- `st', `nd', `rd' or `th', as appropriate.
+ `st', `nd', `rd' or `th', as appropriate. An optional
+ parameter MARK specifies a face or single-character string
+ to use when highlighting the day in the calendar.
%%(diary-remind SEXP DAYS &optional MARKING) text
Entry is a reminder for diary sexp SEXP. DAYS is either a
@@ -1193,7 +1194,11 @@
(let ((diary-entry (diary-sexp-entry sexp entry date)))
(if diary-entry
(subst-char-in-region line-start (point) ?\^M ?\n t))
- (add-to-diary-list date diary-entry specifier)
+ (add-to-diary-list date
+ (if (consp diary-entry)
+ (cdr diary-entry)
+ diary-entry)
+ specifier)
(setq entry-found (or entry-found diary-entry)))))
entry-found))
@@ -1217,18 +1222,22 @@
lines)))
diary-file sexp)
(sleep-for 2))))))
- (if (stringp result)
- result
- (if result
- entry
- nil))))
+ (cond ((stringp result) result)
+ ((and (consp result)
+ (stringp (cdr result))) result)
+ (result entry)
+ (t nil))))
+
-(defun diary-date (month day year)
+(defun diary-date (month day year &optional mark)
"Specific date(s) diary entry.
Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil,
and DAY, MONTH, YEAR if `european-calendar-style' is t. DAY, MONTH, and YEAR
can be lists of integers, the constant t, or an integer. The constant t means
-all values."
+all values.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."
(let* ((dd (if european-calendar-style
month
day))
@@ -1250,12 +1259,16 @@
(eq year t)))
entry)))
-(defun diary-block (m1 d1 y1 m2 d2 y2)
+(defun diary-block (m1 d1 y1 m2 d2 y2 &optional mark )
"Block diary entry.
Entry applies if date is between, or on one of, two dates.
The order of the parameters is
M1, D1, Y1, M2, D2, Y2 if `european-calendar-style' is nil, and
-D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t."
+D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."
+
(let ((date1 (calendar-absolute-from-gregorian
(if european-calendar-style
(list d1 m1 y1)
@@ -1266,7 +1279,7 @@
(list m2 d2 y2))))
(d (calendar-absolute-from-gregorian date)))
(if (and (<= date1 d) (<= d date2))
- entry)))
+ (cons mark entry))))
(defun diary-countdown (before after m1 d1 y1)
"Countdown diary entry.
@@ -1290,13 +1303,15 @@
diff (if (= diff 1) "" "s")) entry))
(t nil))))
-(defun diary-float (month dayname n &optional day)
+(defun diary-float (month dayname n &optional day mark)
"Floating diary entry--entry applies if date is the nth dayname of month.
Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, the constant
t, or an integer. The constant t means all months. If N is negative, count
backward from the end of the month.
-An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY."
+An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY.
+Optional MARK specifies a face or single-character string to use when
+highlighting the day in the calendar."
;; This is messy because the diary entry may apply, but the date on which it
;; is based can be in a different month/year. For example, asking for the
;; first Monday after December 30. For large values of |n| the problem is
@@ -1350,10 +1365,10 @@
1
(calendar-last-day-of-month m2 y2)))
d2)))))
- entry))))
+ (cons mark entry)))))
-(defun diary-anniversary (month day year)
+(defun diary-anniversary (month day year &optional mark)
"Anniversary diary entry.
Entry applies if date is the anniversary of MONTH, DAY, YEAR if
`european-calendar-style' is nil, and DAY, MONTH, YEAR if
@@ -1361,7 +1376,10 @@
%d will be replaced by the number of years since the MONTH DAY, YEAR and the
%s will be replaced by the ordinal ending of that number (that is, `st', `nd',
`rd' or `th', as appropriate. The anniversary of February 29 is considered
-to be March 1 in non-leap years."
+to be March 1 in non-leap years.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."
(let* ((d (if european-calendar-style
month
day))
@@ -1374,15 +1392,18 @@
(setq m 3
d 1))
(if (and (> diff 0) (calendar-date-equal (list m d y) date))
- (format entry diff (diary-ordinal-suffix diff)))))
+ (cons mark (format entry diff (diary-ordinal-suffix diff))))))
-(defun diary-cyclic (n month day year)
+(defun diary-cyclic (n month day year &optional mark)
"Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR.
ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of
repetitions since the MONTH DAY, YEAR and %s will be replaced by the
ordinal ending of that number (that is, `st', `nd', `rd' or `th', as
-appropriate."
+appropriate.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."
(let* ((d (if european-calendar-style
month
day))
@@ -1394,7 +1415,7 @@
(list m d year))))
(cycle (/ diff n)))
(if (and (>= diff 0) (zerop (% diff n)))
- (format entry cycle (diary-ordinal-suffix cycle)))))
+ (cons mark (format entry cycle (diary-ordinal-suffix cycle))))))
(defun diary-ordinal-suffix (n)
"Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)"
Index: lunar.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/lunar.el,v
retrieving revision 1.5
diff -u -b -w -u -r1.5 lunar.el
--- lunar.el 2006/07/31 02:38:09 1.5
+++ lunar.el 2006/08/19 00:02:18
@@ -238,8 +238,11 @@
(displayed-year (extract-calendar-year date)))
(calendar-phases-of-moon))))
-(defun diary-phases-of-moon ()
- "Moon phases diary entry."
+(defun diary-phases-of-moon (&optional mark)
+ "Moon phases diary entry.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."
(let* ((index (* 4
(truncate
(* 12.3685
@@ -252,8 +255,8 @@
(setq index (1+ index))
(setq phase (lunar-phase index)))
(if (calendar-date-equal (car phase) date)
- (concat (lunar-phase-name (car (cdr (cdr phase)))) " "
- (car (cdr phase))))))
+ (cons mark (concat (lunar-phase-name (car (cdr (cdr phase)))) " "
+ (car (cdr phase)))))))
;; For the Chinese calendar the calculations for the new moon need to be more
Index: solar.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/solar.el,v
retrieving revision 1.7
diff -u -b -w -u -r1.7 solar.el
--- solar.el 2006/08/04 20:23:51 1.7
+++ solar.el 2006/08/19 00:02:18
@@ -922,9 +922,12 @@
:type 'integer
:version "21.1")
-(defun diary-sabbath-candles ()
+(defun diary-sabbath-candles (&optional mark)
"Local time of candle lighting diary entry--applies if date is a Friday.
-No diary entry if there is no sunset on that date."
+No diary entry if there is no sunset on that date.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."
(if (not (and calendar-latitude calendar-longitude calendar-time-zone))
(solar-setup))
(if (= (% (calendar-absolute-from-gregorian date) 7) 5);; Friday
@@ -934,8 +937,9 @@
(/ diary-sabbath-candles-minutes 60.0))
(cdr sunset)))))
(if sunset
+ (cons mark
(format "%s Sabbath candle lighting"
- (apply 'solar-time-string light))))))
+ (apply 'solar-time-string light)))))))
(defun solar-equinoxes/solstices (k year)
"Date of equinox/solstice K for YEAR.
Index: timeclock.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/timeclock.el,v
retrieving revision 1.2
diff -u -b -w -u -r1.2 timeclock.el
--- timeclock.el 2006/08/01 01:52:15 1.2
+++ timeclock.el 2006/08/19 00:02:19
@@ -277,12 +277,12 @@
(> (prefix-numeric-value arg) 0)
(not timeclock-modeline-display))))
(if on-p
- (let ((list-entry (memq 'global-mode-string
- mode-line-format)))
+ (let ((list-entry (or (memq 'global-mode-string mode-line-format)
+ ;; In Emacs 21.3 we must use assq
+ (assq 'global-mode-string mode-line-format))))
(unless (or (null list-entry)
(memq 'timeclock-mode-string mode-line-format))
- (setcdr list-entry
- (cons 'timeclock-mode-string
+ (setcdr list-entry (cons 'timeclock-mode-string
(cdr list-entry))))
(unless (memq 'timeclock-update-modeline timeclock-event-hook)
(add-hook 'timeclock-event-hook 'timeclock-update-modeline))
@@ -342,9 +342,11 @@
(error "You've already clocked in!")
(unless timeclock-last-event
(timeclock-reread-log))
- (unless (equal (timeclock-time-to-date
+ ;; Either no log file, or day has rolled over.
+ (unless (and timeclock-last-event
+ (equal (timeclock-time-to-date
(cadr timeclock-last-event))
- (timeclock-time-to-date (current-time)))
+ (timeclock-time-to-date (current-time))))
(let ((workday (or (and (numberp arg) arg)
(and arg 0)
(and timeclock-get-workday-function
@@ -353,7 +355,7 @@
(run-hooks 'timeclock-first-in-hook)
;; settle the discrepancy for the new day
(setq timeclock-discrepancy
- (- timeclock-discrepancy workday))
+ (- (or timeclock-discrepancy 0) workday))
(if (not (= workday timeclock-workday))
(timeclock-log "h" (and (numberp arg)
(number-to-string arg))))))