CVS update by jmiller packages/xemacs-packages/calendar,
cal-dst.el ...
xemacs-cvs at xemacs.org
xemacs-cvs at xemacs.org
Sun Nov 12 23:22:15 EST 2006
User: jmiller
Date: 06/11/13 05:22:15
Modified: packages/xemacs-packages/calendar ChangeLog Makefile
cal-dst.el calendar.el
Added: packages/xemacs-packages/calendar cal-html.el
Log:
updates for DST time end, add cal-html.el
Revision Changes Path
1.41 +27 -0 XEmacs/packages/xemacs-packages/calendar/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/ChangeLog,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -p -r1.40 -r1.41
--- ChangeLog 2006/10/31 08:35:27 1.40
+++ ChangeLog 2006/11/13 04:22:11 1.41
@@ -1,3 +1,30 @@
+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.
+
2006-10-31 Norbert Koch <viteno at xemacs.org>
* Makefile (VERSION): XEmacs package 1.27 released.
1.37 +2 -1 XEmacs/packages/xemacs-packages/calendar/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/Makefile,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -p -r1.36 -r1.37
--- Makefile 2006/10/31 08:35:27 1.36
+++ Makefile 2006/11/13 04:22:11 1.37
@@ -31,7 +31,8 @@ ELCS = appt.elc cal-dst.elc cal-french.e
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
1.7 +104 -42 XEmacs/packages/xemacs-packages/calendar/cal-dst.el
Index: cal-dst.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/cal-dst.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -p -r1.6 -r1.7
--- cal-dst.el 2006/10/23 01:25:28 1.6
+++ cal-dst.el 2006/11/13 04:22:11 1.7
@@ -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 @@ The result has the proper form for calen
(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 @@ DST-ZONE are equal, and all the DST-* in
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 @@ For example, \"EST\" in New York City, \
"*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 @@ If the locale never uses daylight saving
;;;###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
1.12 +40 -17 XEmacs/packages/xemacs-packages/calendar/calendar.el
Index: calendar.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/calendar/calendar.el,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -p -r1.11 -r1.12
--- calendar.el 2006/10/23 01:25:29 1.11
+++ calendar.el 2006/11/13 04:22:12 1.12
@@ -571,11 +571,20 @@ are
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 @@ See the documentation of that function f
(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 @@ to be replaced by asterisks to highlight
(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."
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 @@ Optional prefix argument specifies numbe
"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 @@ movement commands will not work correctl
(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)
1.1 XEmacs/packages/xemacs-packages/calendar/cal-html.el
Index: cal-html.el
===================================================================
;;; 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
More information about the XEmacs-CVS
mailing list