[PATCH] CVS Emacs syncs for calendar
Jeff Miller
jmiller at cablespeed.com
Sat Nov 11 18:59:07 EST 2006
Fixes for determination of Daylight Saving Time start/stop.
Addition of cal-html, creates web pages from your diary
entries.
I intend to commit this tomorrow (Nov 12).
Jeff
ChangeLog addition:
2006-11-11 Jeff Miller <jeff.miller at xemacs.org>
* calendar/cal-dst.el: Do not assume DST starts/ends on the same
date in every year.
(calendar-dst-check-each-year-flag): New customizable variable.
(calendar-dst-find-data): New function, extracted from
calendar-current-time-zone.
(calendar-current-time-zone): Use calendar-dst-find-data.
(calendar-dst-transition-cache): New variable.
(calendar-dst-find-startend, calendar-dst-starts)
(calendar-dst-ends): New functions.
(calendar-daylight-savings-starts)
(calendar-daylight-savings-ends): Change value to use
calendar-dst-starts, calendar-dst-ends; respectively.
* calendar/calendar.el (cal-html-cursor-month)
(cal-html-cursor-year): Add autoloads for this new package.
(calendar-mode-map): Bind cal-html-cursor-month,
cal-html-cursor-year.
* calendar/cal-html.el: New file.
* calendar/calendar.el (european-calendar-style): Call
european-calendar or american-calendar as needed when set.
(diary-view-entries, list-calendar-holidays): Move autoloads
before use.
calendar source patch:
Diff command: cvs -q diff -uN
Files affected: calendar.el cal-html.el cal-dst.el Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/Makefile,v
retrieving revision 1.36
diff -u -u -r1.36 Makefile
--- Makefile 2006/10/31 08:35:27 1.36
+++ Makefile 2006/11/11 23:53:28
@@ -31,7 +31,8 @@
cal-xemacs.elc calendar.elc diary-lib.elc holidays.elc cal-tex.elc \
cal-hebrew.elc cal-islam.elc cal-iso.elc cal-move.elc cal-persia.elc\
cal-china.elc cal-coptic.elc cal-julian.elc lunar.elc solar.elc \
- todo-mode.elc timeclock.elc cal-bahai.elc icalendar.elc cal-compat.elc
+ todo-mode.elc timeclock.elc cal-bahai.elc icalendar.elc cal-compat.elc \
+ cal-html.elc
ifeq ($(BUILD_WITHOUT_MULE),)
ELCS += cal-japanese.elc
Index: cal-dst.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-dst.el,v
retrieving revision 1.6
diff -u -u -r1.6 cal-dst.el
--- cal-dst.el 2006/10/23 01:25:28 1.6
+++ cal-dst.el 2006/11/11 23:53:28
@@ -44,6 +44,16 @@
(require 'calendar)
(require 'cal-persia)
+(defcustom calendar-dst-check-each-year-flag t
+ "Non-nil means to check each year for DST transitions as needed.
+Otherwise assume the next two transitions found after the
+current date apply to all years. This is faster, but not always
+correct, since the dates of Daylight Saving transitions sometimes
+change."
+:type 'boolean
+:version "22.1"
+:group 'calendar)
+
(defvar calendar-current-time-zone-cache nil
"Cache for result of calendar-current-time-zone.")
@@ -201,6 +211,74 @@
(cdr candidate-rules)))
(car candidate-rules)))
+;; TODO it might be better to extract this information directly from
+;; the system timezone database. But cross-platform...?
+;; See thread
+;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2006-11/msg00060.html
+(defun calendar-dst-find-data (&optional time)
+ "Find data on the first Daylight Saving Time transitions after TIME.
+TIME defaults to `current-time'. Return value is as described
+for `calendar-current-time-zone'."
+ (let* ((t0 (or time (current-time)))
+ (t0-zone (current-time-zone t0))
+ (t0-utc-diff (car t0-zone))
+ (t0-name (car (cdr t0-zone))))
+ (if (not t0-utc-diff)
+ ;; Little or no time zone information is available.
+ (list nil nil t0-name t0-name nil nil nil nil)
+ (let* ((t1 (calendar-next-time-zone-transition t0))
+ (t2 (and t1 (calendar-next-time-zone-transition t1))))
+ (if (not t2)
+ ;; This locale does not have daylight savings time.
+ (list (/ t0-utc-diff 60) 0 t0-name t0-name nil nil 0 0)
+ ;; Use heuristics to find daylight savings parameters.
+ (let* ((t1-zone (current-time-zone t1))
+ (t1-utc-diff (car t1-zone))
+ (t1-name (car (cdr t1-zone)))
+ (t1-date-sec (calendar-absolute-from-time t1 t0-utc-diff))
+ (t2-date-sec (calendar-absolute-from-time t2 t1-utc-diff))
+ ;; TODO When calendar-dst-check-each-year-flag is non-nil,
+ ;; the rules can be simpler than they currently are.
+ (t1-rules (calendar-time-zone-daylight-rules
+ (car t1-date-sec) t0-utc-diff))
+ (t2-rules (calendar-time-zone-daylight-rules
+ (car t2-date-sec) t1-utc-diff))
+ (t1-time (/ (cdr t1-date-sec) 60))
+ (t2-time (/ (cdr t2-date-sec) 60)))
+ (cons
+ (/ (min t0-utc-diff t1-utc-diff) 60)
+ (cons
+ (/ (abs (- t0-utc-diff t1-utc-diff)) 60)
+ (if (< t0-utc-diff t1-utc-diff)
+ (list t0-name t1-name t1-rules t2-rules t1-time t2-time)
+ (list t1-name t0-name t2-rules t1-rules t2-time t1-time)
+ )))))))))
+
+(defvar calendar-dst-transition-cache nil
+ "Internal cal-dst variable storing date of Daylight Saving Time transitions.
+Value is a list with elements of the form (YEAR START END), where
+START and END are expressions that when evaluated return the
+start and end dates (respectively) for DST in YEAR. Used by the
+function `calendar-dst-find-startend'.")
+
+(defun calendar-dst-find-startend (year)
+ "Find the dates in YEAR on which Daylight Saving Time starts and ends.
+Returns a list (YEAR START END), where START and END are
+expressions that when evaluated return the start and end dates,
+respectively. This function first attempts to use pre-calculated
+data from `calendar-dst-transition-cache', otherwise it calls
+`calendar-dst-find-data' (and adds the results to the cache)."
+ (let ((e (assoc year calendar-dst-transition-cache))
+ f)
+ (or e
+ (progn
+ (setq e (calendar-dst-find-data (encode-time 1 0 0 1 1 year))
+ f (nth 4 e)
+ e (list year f (nth 5 e))
+ calendar-dst-transition-cache
+ (append calendar-dst-transition-cache (list e)))
+ e))))
+
(defun calendar-current-time-zone ()
"Return UTC difference, dst offset, names and rules for current time zone.
@@ -228,42 +306,8 @@
Some operating systems cannot provide all this information to Emacs; in this
case, `calendar-current-time-zone' returns a list containing nil for the data
it can't find."
- (or
- calendar-current-time-zone-cache
- (setq
- calendar-current-time-zone-cache
- (let* ((t0 (current-time))
- (t0-zone (current-time-zone t0))
- (t0-utc-diff (car t0-zone))
- (t0-name (car (cdr t0-zone))))
- (if (not t0-utc-diff)
- ;; Little or no time zone information is available.
- (list nil nil t0-name t0-name nil nil nil nil)
- (let* ((t1 (calendar-next-time-zone-transition t0))
- (t2 (and t1 (calendar-next-time-zone-transition t1))))
- (if (not t2)
- ;; This locale does not have daylight savings time.
- (list (/ t0-utc-diff 60) 0 t0-name t0-name nil nil 0 0)
- ;; Use heuristics to find daylight savings parameters.
- (let* ((t1-zone (current-time-zone t1))
- (t1-utc-diff (car t1-zone))
- (t1-name (car (cdr t1-zone)))
- (t1-date-sec (calendar-absolute-from-time t1 t0-utc-diff))
- (t2-date-sec (calendar-absolute-from-time t2 t1-utc-diff))
- (t1-rules (calendar-time-zone-daylight-rules
- (car t1-date-sec) t0-utc-diff))
- (t2-rules (calendar-time-zone-daylight-rules
- (car t2-date-sec) t1-utc-diff))
- (t1-time (/ (cdr t1-date-sec) 60))
- (t2-time (/ (cdr t2-date-sec) 60)))
- (cons
- (/ (min t0-utc-diff t1-utc-diff) 60)
- (cons
- (/ (abs (- t0-utc-diff t1-utc-diff)) 60)
- (if (< t0-utc-diff t1-utc-diff)
- (list t0-name t1-name t1-rules t2-rules t1-time t2-time)
- (list t1-name t0-name t2-rules t1-rules t2-time t1-time)
- )))))))))))
+ (unless calendar-current-time-zone-cache
+ (setq calendar-current-time-zone-cache (calendar-dst-find-data))))
;;; The following eight defvars relating to daylight savings time should NOT be
;;; marked to go into loaddefs.el where they would be evaluated when Emacs is
@@ -295,12 +339,32 @@
"*Abbreviated name of daylight-savings time zone at `calendar-location-name'.
For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.")
+
+(defun calendar-dst-starts (year)
+ "Return the date of YEAR on which Daylight Saving Time starts.
+This function respects the value of `calendar-dst-check-each-year-flag'."
+ (or (let ((expr (if calendar-dst-check-each-year-flag
+ (cadr (calendar-dst-find-startend year))
+ (nth 4 calendar-current-time-zone-cache))))
+ (if expr (eval expr)))
+ (and (not (zerop calendar-daylight-time-offset))
+ (calendar-nth-named-day 1 0 4 year))))
+
+(defun calendar-dst-ends (year)
+ "Return the date of YEAR on which Daylight Saving Time ends.
+This function respects the value of `calendar-dst-check-each-year-flag'."
+ (or (let ((expr (if calendar-dst-check-each-year-flag
+ (nth 2 (calendar-dst-find-startend year))
+ (nth 5 calendar-current-time-zone-cache))))
+ (if expr (eval expr)))
+ (and (not (zerop calendar-daylight-time-offset))
+ (calendar-nth-named-day -1 0 10 year))))
+
+
;;;###autoload
(put 'calendar-daylight-savings-starts 'risky-local-variable t)
(defvar calendar-daylight-savings-starts
- (or (car (nthcdr 4 calendar-current-time-zone-cache))
- (and (not (zerop calendar-daylight-time-offset))
- '(calendar-nth-named-day 1 0 4 year)))
+ '(calendar-dst-starts year)
"*Sexp giving the date on which daylight savings time starts.
This is an expression in the variable `year' whose value gives the Gregorian
date in the form (month day year) on which daylight savings time starts. It is
@@ -321,9 +385,7 @@
;;;###autoload
(put 'calendar-daylight-savings-ends 'risky-local-variable t)
(defvar calendar-daylight-savings-ends
- (or (car (nthcdr 5 calendar-current-time-zone-cache))
- (and (not (zerop calendar-daylight-time-offset))
- '(calendar-nth-named-day -1 0 10 year)))
+ '(calendar-dst-ends year)
"*Sexp giving the date on which daylight savings time ends.
This is an expression in the variable `year' whose value gives the Gregorian
date in the form (month day year) on which daylight savings time ends. It is
Index: cal-html.el
===================================================================
RCS file: cal-html.el
diff -N cal-html.el
--- /dev/null Sun Nov 12 00:53:25 2006
+++ cal-html.el Sun Nov 12 00:53:28 2006
@@ -0,0 +1,445 @@
+;;; cal-html.el --- functions for printing HTML calendars
+
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+
+;; Author: Anna M. Bigatti <bigatti at dima.unige.it>
+;; Keywords: calendar
+;; Human-Keywords: calendar, diary, HTML
+;; Created: 23 Aug 2002
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This package writes HTML calendar files using the user's diary
+;; file. See the XEmacs manual for details.
+
+
+;;; Code:
+
+(require 'calendar)
+
+
+(defgroup calendar-html nil
+ "Options for HTML calendars."
+:prefix "cal-html-"
+:group 'calendar)
+
+(defcustom cal-html-directory "~/public_html"
+ "Directory for HTML pages generated by cal-html."
+:type 'string
+:group 'calendar-html)
+
+(defcustom cal-html-print-day-number-flag nil
+ "Non-nil means print the day-of-the-year number in the monthly cal-html page."
+:type 'boolean
+:group 'calendar-html)
+
+(defcustom cal-html-year-index-cols 3
+ "Number of columns in the cal-html yearly index page."
+:type 'integer
+:group 'calendar-html)
+
+(defcustom cal-html-day-abbrev-array
+ (calendar-abbrev-construct calendar-day-abbrev-array
+ calendar-day-name-array)
+ "Array of seven strings for abbreviated day names (starting with Sunday)."
+:type '(vector string string string string string string string)
+:group 'calendar-html)
+
+(defcustom cal-html-css-default
+ (concat
+ "<STYLE TYPE=\"text/css\">\n"
+ " BODY { background: #bde; }\n"
+ " H1 { text-align: center; }\n"
+ " TABLE { padding: 2pt; }\n"
+ " TH { background: #dee; }\n"
+ " TABLE.year { width: 100%; }\n"
+ " TABLE.agenda { width: 100%; }\n"
+ " TABLE.header { width: 100%; text-align: center; }\n"
+ " TABLE.minical TD { background: white; text-align: center; }\n"
+ " TABLE.agenda TD { background: white; text-align: left; }\n"
+ " TABLE.agenda TH { text-align: left; width: 20%; }\n"
+ " SPAN.NO-YEAR { color: #0b3; font-weight: bold; }\n"
+ " SPAN.ANN { color: #0bb; font-weight: bold; }\n"
+ " SPAN.BLOCK { color: #048; font-style: italic; }\n"
+ "</STYLE>\n\n")
+ "Default cal-html css style. You can override this with a \"cal.css\" file."
+:type 'string
+:group 'calendar-html)
+
+;;; End customizable variables.
+
+
+;;; HTML and CSS code constants.
+
+(defconst cal-html-e-document-string "<BR><BR>\n</BODY>\n</HTML>"
+ "HTML code for end of page.")
+
+(defconst cal-html-b-tablerow-string "<TR>\n"
+ "HTML code for beginning of table row.")
+
+(defconst cal-html-e-tablerow-string "</TR>\n"
+ "HTML code for end of table row.")
+
+(defconst cal-html-b-tabledata-string " <TD>"
+ "HTML code for beginning of table data.")
+
+(defconst cal-html-e-tabledata-string " </TD>\n"
+ "HTML code for end of table data.")
+
+(defconst cal-html-b-tableheader-string " <TH>"
+ "HTML code for beginning of table header.")
+
+(defconst cal-html-e-tableheader-string " </TH>\n"
+ "HTML code for end of table header.")
+
+(defconst cal-html-e-table-string
+ "</TABLE>\n<!-- ================================================== -->\n"
+ "HTML code for end of table.")
+
+(defconst cal-html-minical-day-format " <TD><a href=%s#%d>%d</TD>\n"
+ "HTML code for a day in the minical - links NUM to month-page#NUM.")
+
+(defconst cal-html-b-document-string
+ (concat
+ "<HTML>\n"
+ "<HEAD>\n"
+ "<TITLE>Calendar</TITLE>\n"
+ "<!--This buffer was produced by cal-html.el-->\n\n"
+ cal-html-css-default
+ "<LINK REL=\"stylesheet\" TYPE=\"text/css\" HREF=\"cal.css\">\n"
+ "</HEAD>\n\n"
+ "<BODY>\n\n")
+ "Initial block for html page.")
+
+(defconst cal-html-html-subst-list
+ '(("&" . "&")
+ ("\n" . "<BR>\n"))
+ "Alist of symbols and their HTML replacements.")
+
+
+
+(defun cal-html-comment (string)
+ "Return STRING as html comment."
+ (format "<!-- ====== %s ====== -->\n"
+ (replace-regexp-in-string "--" "++" string)))
+
+(defun cal-html-href (link string)
+ "Return a hyperlink to url LINK with text STRING."
+ (format "<A HREF=\"%s\">%s</A>" link string))
+
+(defun cal-html-h3 (string)
+ "Return STRING as html header h3."
+ (format "\n <H3>%s</H3>\n" string))
+
+(defun cal-html-h1 (string)
+ "Return STRING as html header h1."
+ (format "\n <H1>%s</H1>\n" string))
+
+(defun cal-html-th (string)
+ "Return STRING as html table header."
+ (format "%s%s%s" cal-html-b-tableheader-string string
+ cal-html-e-tableheader-string))
+
+(defun cal-html-b-table (arg)
+ "Return table tag with attribute ARG."
+ (format "\n<TABLE %s>\n" arg))
+
+(defun cal-html-monthpage-name (month year)
+ "Return name of html page for numeric MONTH and four-digit YEAR.
+For example, \"2006-08.html\" for 8 2006."
+ (format "%d-%.2d.html" year month))
+
+
+(defun cal-html-insert-link-monthpage (month year &optional change-dir)
+ "Insert a link to the html page for numeric MONTH and four-digit YEAR.
+If optional argument CHANGE-DIR is non-nil and MONTH is 1 or 2,
+the link points to a different year and so has a directory part."
+ (insert (cal-html-h3
+ (cal-html-href
+ (concat (and change-dir
+ (member month '(1 12))
+ (format "../%d/" year))
+ (cal-html-monthpage-name month year))
+ (calendar-month-name month)))))
+
+
+(defun cal-html-insert-link-yearpage (month year)
+ "Insert a link to index page for four-digit YEAR, tagged using MONTH name."
+ (insert (cal-html-h1
+ (format "%s %s"
+ (calendar-month-name month)
+ (cal-html-href "index.html" (number-to-string year))))))
+
+
+(defun cal-html-year-dir-ask-user (year)
+ "Prompt for the html calendar output directory for four-digit YEAR.
+Return the expanded directory name, which is based on
+`cal-html-directory' by default."
+ (expand-file-name (read-directory-name
+ "Enter HTML calendar directory name: "
+ (expand-file-name (format "%d" year)
+ cal-html-directory))))
+
+;;------------------------------------------------------------
+;; page header
+;;------------------------------------------------------------
+(defun cal-html-insert-month-header (month year)
+ "Insert the header for the numeric MONTH page for four-digit YEAR.
+Contains links to previous and next month and year, and current minical."
+ (insert (cal-html-b-table "class=header"))
+ (insert cal-html-b-tablerow-string)
+ (insert cal-html-b-tabledata-string) ; month links
+ (increment-calendar-month month year -1) ; previous month
+ (cal-html-insert-link-monthpage month year t) ; t --> change-dir
+ (increment-calendar-month month year 1) ; current month
+ (cal-html-insert-link-yearpage month year)
+ (increment-calendar-month month year 1) ; next month
+ (cal-html-insert-link-monthpage month year t) ; t --> change-dir
+ (insert cal-html-e-tabledata-string)
+ (insert cal-html-b-tabledata-string) ; minical
+ (increment-calendar-month month year -1)
+ (cal-html-insert-minical month year)
+ (insert cal-html-e-tabledata-string)
+ (insert cal-html-e-tablerow-string) ; end
+ (insert cal-html-e-table-string))
+
+;;------------------------------------------------------------
+;; minical: a small month calendar with links
+;;------------------------------------------------------------
+(defun cal-html-insert-minical (month year)
+ "Insert a minical for numeric MONTH of YEAR."
+ (let* ((blank-days ; at start of month
+ (mod (- (calendar-day-of-week (list month 1 year))
+ calendar-week-start-day)
+ 7))
+ (last (calendar-last-day-of-month month year))
+ (end-blank-days ; at end of month
+ (mod (- 6 (- (calendar-day-of-week (list month last year))
+ calendar-week-start-day))
+ 7))
+ (monthpage-name (cal-html-monthpage-name month year))
+ date)
+ ;; Start writing table.
+ (insert (cal-html-comment "MINICAL")
+ (cal-html-b-table "class=minical border=1 align=center"))
+ ;; Weekdays row.
+ (insert cal-html-b-tablerow-string)
+ (dotimes (i 7)
+ (insert (cal-html-th
+ (aref cal-html-day-abbrev-array
+ (mod (+ i calendar-week-start-day) 7)))))
+ (insert cal-html-e-tablerow-string)
+ ;; Initial empty slots.
+ (insert cal-html-b-tablerow-string)
+ (dotimes (i blank-days)
+ (insert
+ cal-html-b-tabledata-string
+ cal-html-e-tabledata-string))
+ ;; Numbers.
+ (dotimes (i last)
+ (insert (format cal-html-minical-day-format monthpage-name i (1+ i)))
+ ;; New row?
+ (if (and (zerop (mod (+ i 1 blank-days) 7))
+ (/= (1+ i) last))
+ (insert cal-html-e-tablerow-string
+ cal-html-b-tablerow-string)))
+ ;; End empty slots (for some browsers like konqueror).
+ (dotimes (i end-blank-days)
+ (insert
+ cal-html-b-tabledata-string
+ cal-html-e-tabledata-string)))
+ (insert cal-html-e-tablerow-string
+ cal-html-e-table-string
+ (cal-html-comment "MINICAL end")))
+
+
+;;------------------------------------------------------------
+;; year index page with minicals
+;;------------------------------------------------------------
+(defun cal-html-insert-year-minicals (year cols)
+ "Make a one page yearly mini-calendar for four-digit YEAR.
+There are 12/cols rows of COLS months each."
+ (insert cal-html-b-document-string)
+ (insert (cal-html-h1 (number-to-string year)))
+ (insert (cal-html-b-table "class=year")
+ cal-html-b-tablerow-string)
+ (dotimes (i 12)
+ (insert cal-html-b-tabledata-string)
+ (cal-html-insert-link-monthpage (1+ i) year)
+ (cal-html-insert-minical (1+ i) year)
+ (insert cal-html-e-tabledata-string)
+ (if (zerop (mod (1+ i) cols))
+ (insert cal-html-e-tablerow-string
+ cal-html-b-tablerow-string)))
+ (insert cal-html-e-tablerow-string
+ cal-html-e-table-string
+ cal-html-e-document-string))
+
+
+;;------------------------------------------------------------
+;; HTMLify
+;;------------------------------------------------------------
+
+(defun cal-html-htmlify-string (string)
+ "Protect special characters in STRING from HTML.
+Characters are replaced according to `cal-html-html-subst-list'."
+ (if (stringp string)
+ (replace-regexp-in-string
+ (regexp-opt (mapcar 'car cal-html-html-subst-list))
+ (lambda (x)
+ (cdr (assoc x cal-html-html-subst-list)))
+ string)
+ ""))
+
+
+(defun cal-html-htmlify-entry (entry)
+ "Convert a diary entry ENTRY to html with the appropriate class specifier."
+ (let ((start
+ (cond
+ ((string-match "block" (car (cddr entry))) "BLOCK")
+ ((string-match "anniversary" (car (cddr entry))) "ANN")
+ ((not (string-match
+ (number-to-string (car (cddr (car entry))))
+ (car (cddr entry))))
+ "NO-YEAR")
+ (t "NORMAL"))))
+ (format "<span class=%s>%s</span>" start
+ (cal-html-htmlify-string (cadr entry)))))
+
+
+(defun cal-html-htmlify-list (date-list date)
+ "Return a string of concatenated, HTMLified diary entries.
+DATE-LIST is a list of diary entries. Return only those matching DATE."
+ (mapconcat (lambda (x) (cal-html-htmlify-entry x))
+ (let (result)
+ (dolist (p date-list (reverse result))
+ (and (car p)
+ (calendar-date-equal date (car p))
+ (setq result (cons p result)))))
+ "<BR>\n "))
+
+
+;;------------------------------------------------------------
+;; Monthly calendar
+;;------------------------------------------------------------
+
+(autoload 'diary-list-entries "diary-lib" nil t)
+
+(defun cal-html-list-diary-entries (d1 d2)
+ "Generate a list of all diary-entries from absolute date D1 to D2."
+ (let (diary-display-hook)
+ (diary-list-entries
+ (calendar-gregorian-from-absolute d1)
+ (1+ (- d2 d1)))))
+
+
+(defun cal-html-insert-agenda-days (month year diary-list)
+ "Insert HTML commands for a range of days in monthly calendars.
+HTML commands are inserted for the days of the numeric MONTH in
+four-digit YEAR. Diary entries in DIARY-LIST are included."
+ (let ((blank-days ; at start of month
+ (mod (- (calendar-day-of-week (list month 1 year))
+ calendar-week-start-day)
+ 7))
+ (last (calendar-last-day-of-month month year))
+ date)
+ (insert "<a name=0>\n")
+ (insert (cal-html-b-table "class=agenda border=1"))
+ (dotimes (i last)
+ (setq date (list month (1+ i) year))
+ (insert
+ (format "<a name=%d></a>\n" (1+ i)) ; link
+ cal-html-b-tablerow-string
+ ;; Number & day name.
+ cal-html-b-tableheader-string
+ (if cal-html-print-day-number-flag
+ (format "<em>%d</em> "
+ (calendar-day-number date))
+ "")
+ (format "%d %s" (1+ i)
+ (aref calendar-day-name-array
+ (calendar-day-of-week date)))
+ cal-html-e-tableheader-string
+ ;; Diary entries.
+ cal-html-b-tabledata-string
+ (cal-html-htmlify-list diary-list date)
+ cal-html-e-tabledata-string
+ cal-html-e-tablerow-string)
+ ;; If end of week and not end of month, make new table.
+ (if (and (zerop (mod (+ i 1 blank-days) 7))
+ (/= (1+ i) last))
+ (insert cal-html-e-table-string
+ (cal-html-b-table
+ "class=agenda border=1")))))
+ (insert cal-html-e-table-string))
+
+
+(defun cal-html-one-month (month year dir)
+ "Write an HTML calendar file for numeric MONTH of YEAR in directory DIR."
+ (let ((diary-list (cal-html-list-diary-entries
+ (calendar-absolute-from-gregorian (list month 1 year))
+ (calendar-absolute-from-gregorian
+ (list month
+ (calendar-last-day-of-month month year)
+ year)))))
+ (with-temp-buffer
+ (insert cal-html-b-document-string)
+ (cal-html-insert-month-header month year)
+ (cal-html-insert-agenda-days month year diary-list)
+ (insert cal-html-e-document-string)
+ (write-file (expand-file-name
+ (cal-html-monthpage-name month year) dir)))))
+
+
+;;; User commands.
+
+(defun cal-html-cursor-month (month year dir)
+ "Write an HTML calendar file for numeric MONTH of four-digit YEAR.
+The output directory DIR is created if necessary. Interactively,
+MONTH and YEAR are taken from the calendar cursor position. Note
+that any existing output files are overwritten."
+ (interactive (let* ((date (calendar-cursor-to-date t))
+ (month (extract-calendar-month date))
+ (year (extract-calendar-year date)))
+ (list month year (cal-html-year-dir-ask-user year))))
+ (make-directory dir t)
+ (cal-html-one-month month year dir))
+
+(defun cal-html-cursor-year (year dir)
+ "Write HTML calendar files (index and monthly pages) for four-digit YEAR.
+The output directory DIR is created if necessary. Interactively,
+YEAR is taken from the calendar cursor position. Note that any
+existing output files are overwritten."
+ (interactive (let ((year (extract-calendar-year
+ (calendar-cursor-to-date t))))
+ (list year (cal-html-year-dir-ask-user year))))
+ (make-directory dir t)
+ (with-temp-buffer
+ (cal-html-insert-year-minicals year cal-html-year-index-cols)
+ (write-file (expand-file-name "index.html" dir)))
+ (dotimes (i 12)
+ (cal-html-one-month (1+ i) year dir)))
+
+
+(provide 'cal-html)
+
+
+;; arch-tag: 4e73377d-d2c1-46ea-a103-02c111da5f57
+;;; cal-html.el ends here
Index: calendar.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/calendar.el,v
retrieving revision 1.11
diff -u -u -r1.11 calendar.el
--- calendar.el 2006/10/23 01:25:29 1.11
+++ calendar.el 2006/11/11 23:53:28
@@ -571,11 +571,20 @@
Names can be capitalized or not, written in full (as specified by the
variable `calendar-day-name-array'), or abbreviated (as specified by
-`calendar-day-abbrev-array') with or without a period. To take effect,
-this variable should be set before the calendar package and its associates
-are loaded. Otherwise, use one of the functions `european-calendar' or
-`american-calendar' to force the appropriate update."
+`calendar-day-abbrev-array') with or without a period.
+
+Setting this variable directly does not take effect (if the
+calendar package is already loaded). Rather, use either
+\\[customize] or the functions `european-calendar' and
+`american-calendar'."
:type 'boolean
+ ;; Without :initialize (require 'calendar) throws an error because
+ ;; american-calendar is undefined at this point.
+:initialize 'custom-initialize-default
+:set (lambda (symbol value)
+ (if value
+ (european-calendar)
+ (american-calendar)))
:group 'diary)
;;;###autoload
@@ -1586,6 +1595,19 @@
(calendar-only-one-frame-setup arg))
(t (calendar-basic-setup arg))))
+(autoload 'diary-view-entries "diary-lib"
+ "Prepare and display a buffer with diary entries.
+Searches your diary file for entries that match ARG days starting with
+the date indicated by the cursor position in the displayed three-month
+calendar."
+ t)
+
+(autoload 'list-calendar-holidays "holidays"
+ "Create a buffer containing the holidays for the current calendar window.
+The holidays are those in the list `calendar-notable-days'. Returns t if any
+holidays are found, nil if not."
+ t)
+
(defun calendar-basic-setup (&optional arg)
"Display a three-month calendar in another window.
The three months appear side by side, with the current month in the middle
@@ -1653,13 +1675,6 @@
(list-calendar-holidays)))
(run-hooks 'initial-calendar-window-hook))
-(autoload 'diary-view-entries "diary-lib"
- "Prepare and display a buffer with diary entries.
-Searches your diary file for entries that match ARG days starting with
-the date indicated by the cursor position in the displayed three-month
-calendar."
- t)
-
(autoload 'view-other-diary-entries "diary-lib"
"Prepare and display buffer of diary entries from an alternative diary file.
Searches for entries that match ARG days, starting with the date indicated
@@ -1934,12 +1949,6 @@
to the date indicated by point."
t)
-(autoload 'list-calendar-holidays "holidays"
- "Create a buffer containing the holidays for the current calendar window.
-The holidays are those in the list `calendar-notable-days'. Returns t if any
-holidays are found, nil if not."
- t)
-
(autoload 'cal-tex-cursor-month "cal-tex"
"Make a buffer with LaTeX commands for the month cursor is on.
Optional prefix argument specifies number of months to be produced.
@@ -2007,6 +2016,18 @@
"Make a buffer with LaTeX commands for a year's calendar (Filofax).
Optional prefix argument specifies number of years." t)
+(autoload 'cal-html-cursor-month "cal-html"
+ "Write an HTML calendar file for numeric MONTH of four-digit YEAR.
+The output directory DIR is created if necessary. Interactively,
+MONTH and YEAR are taken from the calendar cursor position. Note
+that any existing output files are overwritten." t)
+
+(autoload 'cal-html-cursor-year "cal-html"
+ "Write HTML calendar files (index and monthly pages) for four-digit YEAR.
+The output directory DIR is created if necessary. Interactively,
+YEAR is taken from the calendar cursor position. Note that any
+existing output files are overwritten." t)
+
(autoload 'mark-calendar-holidays "holidays"
"Mark notable days in the calendar window."
t)
@@ -2294,6 +2315,8 @@
(define-key map "iBm" 'insert-monthly-bahai-diary-entry)
(define-key map "iBy" 'insert-yearly-bahai-diary-entry)
(define-key map "?" 'calendar-goto-info-node)
+ (define-key map "Hm" 'cal-html-cursor-month)
+ (define-key map "Hy" 'cal-html-cursor-year)
(define-key map "tm" 'cal-tex-cursor-month)
(define-key map "tM" 'cal-tex-cursor-month-landscape)
(define-key map "td" 'cal-tex-cursor-day)
More information about the XEmacs-Patches
mailing list