[PATCH] CVS Emacs syncs for calendar

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(a)xemacs.org&gt; * 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(a)dima.unige.it&gt; +;; 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 + '(("&" . "&amp;") + ("\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>&nbsp;&nbsp;" + (calendar-day-number date)) + "") + (format "%d&nbsp;%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) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches