[bpt/emacs.git] / lisp / calendar / cal-html.el

;;; cal-html.el --- functions for printing HTML calendars

;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
;;   Free Software Foundation, Inc.

;; Author: Anna M. Bigatti <bigatti@dima.unige.it>
;; Keywords: calendar
;; Human-Keywords: calendar, diary, HTML
;; Created: 23 Aug 2002

;; This file is part of GNU Emacs.

;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This package writes HTML calendar files using the user's diary
;; file.  See the Emacs manual for details.


;;; Code:

(require 'calendar)

\f
(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.

\f
;;; 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.")


\f
(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 tagged with MONTH name, to index page for four-digit YEAR."
  (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
  (calendar-increment-month month year -1)      ; previous month
  (cal-html-insert-link-monthpage month year t) ; t --> change-dir
  (calendar-increment-month month year 1)       ; current month
  (cal-html-insert-link-yearpage month year)
  (calendar-increment-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
  (calendar-increment-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" (nth 2 entry)) "BLOCK")
          ((string-match "anniversary" (nth 2 entry)) "ANN")
          ((not (string-match
                 (number-to-string (nth 2 (car entry)))
                 (nth 2 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, HTML-ified 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")

(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)))))

\f
;;; User commands.

;;;###cal-autoload
(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 (calendar-extract-month date))
                      (year (calendar-extract-year date)))
                 (list month year (cal-html-year-dir-ask-user year))))
  (make-directory dir t)
  (cal-html-one-month month year dir))

;;;###cal-autoload
(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 (calendar-extract-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
Commit	Line	Data
94ce0230 GM	1	;;; cal-html.el --- functions for printing HTML calendars
94ce0230 GM	2
ad20a664 GM	3	;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
ad20a664 GM	4	;; Free Software Foundation, Inc.
94ce0230 GM	5
	6	;; Author: Anna M. Bigatti <bigatti@dima.unige.it>
	7	;; Keywords: calendar
	8	;; Human-Keywords: calendar, diary, HTML
	9	;; Created: 23 Aug 2002
	10
	11	;; This file is part of GNU Emacs.
	12
2ed66575	13	;; GNU Emacs is free software: you can redistribute it and/or modify
94ce0230	14	;; it under the terms of the GNU General Public License as published by
2ed66575 GM	15	;; the Free Software Foundation, either version 3 of the License, or
2ed66575 GM	16	;; (at your option) any later version.
94ce0230 GM	17
	18	;; GNU Emacs is distributed in the hope that it will be useful,
	19	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	20	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	21	;; GNU General Public License for more details.
	22
	23	;; You should have received a copy of the GNU General Public License
2ed66575	24	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
94ce0230 GM	25
	26	;;; Commentary:
	27
	28	;; This package writes HTML calendar files using the user's diary
	29	;; file. See the Emacs manual for details.
	30
	31
	32	;;; Code:
	33
	34	(require 'calendar)
	35
	36	\f
	37	(defgroup calendar-html nil
	38	"Options for HTML calendars."
	39	:prefix "cal-html-"
	40	:group 'calendar)
	41
	42	(defcustom cal-html-directory "~/public_html"
	43	"Directory for HTML pages generated by cal-html."
	44	:type 'string
	45	:group 'calendar-html)
	46
	47	(defcustom cal-html-print-day-number-flag nil
	48	"Non-nil means print the day-of-the-year number in the monthly cal-html page."
	49	:type 'boolean
	50	:group 'calendar-html)
	51
	52	(defcustom cal-html-year-index-cols 3
	53	"Number of columns in the cal-html yearly index page."
	54	:type 'integer
	55	:group 'calendar-html)
	56
	57	(defcustom cal-html-day-abbrev-array
	58	(calendar-abbrev-construct calendar-day-abbrev-array
	59	calendar-day-name-array)
	60	"Array of seven strings for abbreviated day names (starting with Sunday)."
	61	:type '(vector string string string string string string string)
	62	:group 'calendar-html)
	63
	64	(defcustom cal-html-css-default
	65	(concat
	66	"<STYLE TYPE=\"text/css\">\n"
	67	" BODY { background: #bde; }\n"
	68	" H1 { text-align: center; }\n"
	69	" TABLE { padding: 2pt; }\n"
	70	" TH { background: #dee; }\n"
	71	" TABLE.year { width: 100%; }\n"
	72	" TABLE.agenda { width: 100%; }\n"
	73	" TABLE.header { width: 100%; text-align: center; }\n"
	74	" TABLE.minical TD { background: white; text-align: center; }\n"
	75	" TABLE.agenda TD { background: white; text-align: left; }\n"
	76	" TABLE.agenda TH { text-align: left; width: 20%; }\n"
	77	" SPAN.NO-YEAR { color: #0b3; font-weight: bold; }\n"
	78	" SPAN.ANN { color: #0bb; font-weight: bold; }\n"
	79	" SPAN.BLOCK { color: #048; font-style: italic; }\n"
	80	"</STYLE>\n\n")
	81	"Default cal-html css style. You can override this with a \"cal.css\" file."
	82	:type 'string
	83	:group 'calendar-html)
	84
	85	;;; End customizable variables.
	86
	87	\f
	88	;;; HTML and CSS code constants.
89
90	(defconst cal-html-e-document-string "<BR><BR>\n</BODY>\n</HTML>"
91	"HTML code for end of page.")
92
93	(defconst cal-html-b-tablerow-string "<TR>\n"
94	"HTML code for beginning of table row.")
95
96	(defconst cal-html-e-tablerow-string "</TR>\n"
97	"HTML code for end of table row.")
98
99	(defconst cal-html-b-tabledata-string " <TD>"
100	"HTML code for beginning of table data.")
101
102	(defconst cal-html-e-tabledata-string " </TD>\n"
103	"HTML code for end of table data.")
104
105	(defconst cal-html-b-tableheader-string " <TH>"
106	"HTML code for beginning of table header.")
107
108	(defconst cal-html-e-tableheader-string " </TH>\n"
109	"HTML code for end of table header.")
110
111	(defconst cal-html-e-table-string
112	"</TABLE>\n<!-- ================================================== -->\n"
113	"HTML code for end of table.")
114
115	(defconst cal-html-minical-day-format " <TD><a href=%s#%d>%d</TD>\n"
116	"HTML code for a day in the minical - links NUM to month-page#NUM.")
117
118	(defconst cal-html-b-document-string
119	(concat
120	"<HTML>\n"
121	"<HEAD>\n"
122	"<TITLE>Calendar</TITLE>\n"
123	"<!--This buffer was produced by cal-html.el-->\n\n"
124	cal-html-css-default
125	"<LINK REL=\"stylesheet\" TYPE=\"text/css\" HREF=\"cal.css\">\n"
126	"</HEAD>\n\n"
127	"<BODY>\n\n")
128	"Initial block for html page.")
129
130	(defconst cal-html-html-subst-list
131	'(("&" . "&")
132	("\n" . "<BR>\n"))
133	"Alist of symbols and their HTML replacements.")
134
135
136	\f
137	(defun cal-html-comment (string)
138	"Return STRING as html comment."
139	(format "<!-- ====== %s ====== -->\n"
140	(replace-regexp-in-string "--" "++" string)))
141
142	(defun cal-html-href (link string)
143	"Return a hyperlink to url LINK with text STRING."
144	(format "<A HREF=\"%s\">%s</A>" link string))
145
146	(defun cal-html-h3 (string)
147	"Return STRING as html header h3."
148	(format "\n <H3>%s</H3>\n" string))
149
150	(defun cal-html-h1 (string)
151	"Return STRING as html header h1."
152	(format "\n <H1>%s</H1>\n" string))
153
154	(defun cal-html-th (string)
155	"Return STRING as html table header."
156	(format "%s%s%s" cal-html-b-tableheader-string string
157	cal-html-e-tableheader-string))
158
159	(defun cal-html-b-table (arg)
160	"Return table tag with attribute ARG."
161	(format "\n<TABLE %s>\n" arg))
162
163	(defun cal-html-monthpage-name (month year)
164	"Return name of html page for numeric MONTH and four-digit YEAR.
165	For example, \"2006-08.html\" for 8 2006."
166	(format "%d-%.2d.html" year month))
167
168
169	(defun cal-html-insert-link-monthpage (month year &optional change-dir)
170	"Insert a link to the html page for numeric MONTH and four-digit YEAR.
171	If optional argument CHANGE-DIR is non-nil and MONTH is 1 or 2,
172	the link points to a different year and so has a directory part."
173	(insert (cal-html-h3
174	(cal-html-href
175	(concat (and change-dir
176	(member month '(1 12))
177	(format "../%d/" year))
178	(cal-html-monthpage-name month year))
179	(calendar-month-name month)))))
180
181
182	(defun cal-html-insert-link-yearpage (month year)
85133518	183	"Insert a link tagged with MONTH name, to index page for four-digit YEAR."
94ce0230 GM	184	(insert (cal-html-h1
	185	(format "%s %s"
	186	(calendar-month-name month)
	187	(cal-html-href "index.html" (number-to-string year))))))
	188
	189
	190	(defun cal-html-year-dir-ask-user (year)
	191	"Prompt for the html calendar output directory for four-digit YEAR.
	192	Return the expanded directory name, which is based on
	193	`cal-html-directory' by default."
	194	(expand-file-name (read-directory-name
	195	"Enter HTML calendar directory name: "
	196	(expand-file-name (format "%d" year)
	197	cal-html-directory))))
	198
	199	;;------------------------------------------------------------
	200	;; page header
	201	;;------------------------------------------------------------
	202	(defun cal-html-insert-month-header (month year)
	203	"Insert the header for the numeric MONTH page for four-digit YEAR.
	204	Contains links to previous and next month and year, and current minical."
	205	(insert (cal-html-b-table "class=header"))
	206	(insert cal-html-b-tablerow-string)
	207	(insert cal-html-b-tabledata-string) ; month links
e803eab7	208	(calendar-increment-month month year -1) ; previous month
94ce0230	209	(cal-html-insert-link-monthpage month year t) ; t --> change-dir
e803eab7	210	(calendar-increment-month month year 1) ; current month
94ce0230	211	(cal-html-insert-link-yearpage month year)
e803eab7	212	(calendar-increment-month month year 1) ; next month
94ce0230 GM	213	(cal-html-insert-link-monthpage month year t) ; t --> change-dir
	214	(insert cal-html-e-tabledata-string)
	215	(insert cal-html-b-tabledata-string) ; minical
e803eab7	216	(calendar-increment-month month year -1)
94ce0230 GM	217	(cal-html-insert-minical month year)
	218	(insert cal-html-e-tabledata-string)
	219	(insert cal-html-e-tablerow-string) ; end
	220	(insert cal-html-e-table-string))
	221
	222	;;------------------------------------------------------------
	223	;; minical: a small month calendar with links
	224	;;------------------------------------------------------------
	225	(defun cal-html-insert-minical (month year)
	226	"Insert a minical for numeric MONTH of YEAR."
	227	(let* ((blank-days ; at start of month
	228	(mod (- (calendar-day-of-week (list month 1 year))
	229	calendar-week-start-day)
	230	7))
	231	(last (calendar-last-day-of-month month year))
	232	(end-blank-days ; at end of month
	233	(mod (- 6 (- (calendar-day-of-week (list month last year))
	234	calendar-week-start-day))
	235	7))
	236	(monthpage-name (cal-html-monthpage-name month year))
	237	date)
	238	;; Start writing table.
	239	(insert (cal-html-comment "MINICAL")
	240	(cal-html-b-table "class=minical border=1 align=center"))
	241	;; Weekdays row.
	242	(insert cal-html-b-tablerow-string)
	243	(dotimes (i 7)
	244	(insert (cal-html-th
	245	(aref cal-html-day-abbrev-array
	246	(mod (+ i calendar-week-start-day) 7)))))
	247	(insert cal-html-e-tablerow-string)
	248	;; Initial empty slots.
	249	(insert cal-html-b-tablerow-string)
	250	(dotimes (i blank-days)
	251	(insert
	252	cal-html-b-tabledata-string
	253	cal-html-e-tabledata-string))
	254	;; Numbers.
	255	(dotimes (i last)
	256	(insert (format cal-html-minical-day-format monthpage-name i (1+ i)))
	257	;; New row?
	258	(if (and (zerop (mod (+ i 1 blank-days) 7))
	259	(/= (1+ i) last))
	260	(insert cal-html-e-tablerow-string
	261	cal-html-b-tablerow-string)))
	262	;; End empty slots (for some browsers like konqueror).
	263	(dotimes (i end-blank-days)
	264	(insert
	265	cal-html-b-tabledata-string
	266	cal-html-e-tabledata-string)))
	267	(insert cal-html-e-tablerow-string
	268	cal-html-e-table-string
	269	(cal-html-comment "MINICAL end")))
	270
	271
	272	;;------------------------------------------------------------
	273	;; year index page with minicals
	274	;;------------------------------------------------------------
	275	(defun cal-html-insert-year-minicals (year cols)
	276	"Make a one page yearly mini-calendar for four-digit YEAR.
	277	There are 12/cols rows of COLS months each."
	278	(insert cal-html-b-document-string)
	279	(insert (cal-html-h1 (number-to-string year)))
	280	(insert (cal-html-b-table "class=year")
281	cal-html-b-tablerow-string)
282	(dotimes (i 12)
283	(insert cal-html-b-tabledata-string)
284	(cal-html-insert-link-monthpage (1+ i) year)
285	(cal-html-insert-minical (1+ i) year)
286	(insert cal-html-e-tabledata-string)
287	(if (zerop (mod (1+ i) cols))
288	(insert cal-html-e-tablerow-string
289	cal-html-b-tablerow-string)))
290	(insert cal-html-e-tablerow-string
291	cal-html-e-table-string
292	cal-html-e-document-string))
293
294
295	;;------------------------------------------------------------
296	;; HTMLify
297	;;------------------------------------------------------------
298
299	(defun cal-html-htmlify-string (string)
300	"Protect special characters in STRING from HTML.
301	Characters are replaced according to `cal-html-html-subst-list'."
302	(if (stringp string)
303	(replace-regexp-in-string
304	(regexp-opt (mapcar 'car cal-html-html-subst-list))
305	(lambda (x)
306	(cdr (assoc x cal-html-html-subst-list)))
307	string)
308	""))
309
310
311	(defun cal-html-htmlify-entry (entry)
312	"Convert a diary entry ENTRY to html with the appropriate class specifier."
313	(let ((start
314	(cond
85133518 GM	315	((string-match "block" (nth 2 entry)) "BLOCK")
85133518 GM	316	((string-match "anniversary" (nth 2 entry)) "ANN")
94ce0230	317	((not (string-match
85133518 GM	318	(number-to-string (nth 2 (car entry)))
85133518 GM	319	(nth 2 entry)))
94ce0230 GM	320	"NO-YEAR")
	321	(t "NORMAL"))))
	322	(format "<span class=%s>%s</span>" start
	323	(cal-html-htmlify-string (cadr entry)))))
	324
	325
	326	(defun cal-html-htmlify-list (date-list date)
85133518	327	"Return a string of concatenated, HTML-ified diary entries.
94ce0230 GM	328	DATE-LIST is a list of diary entries. Return only those matching DATE."
	329	(mapconcat (lambda (x) (cal-html-htmlify-entry x))
	330	(let (result)
	331	(dolist (p date-list (reverse result))
	332	(and (car p)
	333	(calendar-date-equal date (car p))
	334	(setq result (cons p result)))))
	335	"<BR>\n "))
	336
	337
	338	;;------------------------------------------------------------
	339	;; Monthly calendar
	340	;;------------------------------------------------------------
	341
d3a0e5bf	342	(autoload 'diary-list-entries "diary-lib")
94ce0230 GM	343
	344	(defun cal-html-list-diary-entries (d1 d2)
	345	"Generate a list of all diary-entries from absolute date D1 to D2."
	346	(let (diary-display-hook)
	347	(diary-list-entries
	348	(calendar-gregorian-from-absolute d1)
	349	(1+ (- d2 d1)))))
	350
	351
	352	(defun cal-html-insert-agenda-days (month year diary-list)
	353	"Insert HTML commands for a range of days in monthly calendars.
	354	HTML commands are inserted for the days of the numeric MONTH in
	355	four-digit YEAR. Diary entries in DIARY-LIST are included."
	356	(let ((blank-days ; at start of month
	357	(mod (- (calendar-day-of-week (list month 1 year))
	358	calendar-week-start-day)
	359	7))
	360	(last (calendar-last-day-of-month month year))
	361	date)
	362	(insert "<a name=0>\n")
	363	(insert (cal-html-b-table "class=agenda border=1"))
	364	(dotimes (i last)
	365	(setq date (list month (1+ i) year))
	366	(insert
	367	(format "<a name=%d></a>\n" (1+ i)) ; link
	368	cal-html-b-tablerow-string
	369	;; Number & day name.
	370	cal-html-b-tableheader-string
	371	(if cal-html-print-day-number-flag
	372	(format "<em>%d</em>  "
	373	(calendar-day-number date))
	374	"")
	375	(format "%d %s" (1+ i)
	376	(aref calendar-day-name-array
	377	(calendar-day-of-week date)))
	378	cal-html-e-tableheader-string
	379	;; Diary entries.
	380	cal-html-b-tabledata-string
	381	(cal-html-htmlify-list diary-list date)
	382	cal-html-e-tabledata-string
	383	cal-html-e-tablerow-string)
	384	;; If end of week and not end of month, make new table.
	385	(if (and (zerop (mod (+ i 1 blank-days) 7))
	386	(/= (1+ i) last))
	387	(insert cal-html-e-table-string
	388	(cal-html-b-table
	389	"class=agenda border=1")))))
	390	(insert cal-html-e-table-string))
	391
	392
	393	(defun cal-html-one-month (month year dir)
	394	"Write an HTML calendar file for numeric MONTH of YEAR in directory DIR."
	395	(let ((diary-list (cal-html-list-diary-entries
	396	(calendar-absolute-from-gregorian (list month 1 year))
	397	(calendar-absolute-from-gregorian
	398	(list month
	399	(calendar-last-day-of-month month year)
	400	year)))))
	401	(with-temp-buffer
	402	(insert cal-html-b-document-string)
	403	(cal-html-insert-month-header month year)
	404	(cal-html-insert-agenda-days month year diary-list)
	405	(insert cal-html-e-document-string)
	406	(write-file (expand-file-name
407	(cal-html-monthpage-name month year) dir)))))
408
409	\f
410	;;; User commands.
411
d3a0e5bf	412	;;;###cal-autoload
94ce0230 GM	413	(defun cal-html-cursor-month (month year dir)
	414	"Write an HTML calendar file for numeric MONTH of four-digit YEAR.
	415	The output directory DIR is created if necessary. Interactively,
	416	MONTH and YEAR are taken from the calendar cursor position. Note
	417	that any existing output files are overwritten."
	418	(interactive (let* ((date (calendar-cursor-to-date t))
e803eab7 GM	419	(month (calendar-extract-month date))
e803eab7 GM	420	(year (calendar-extract-year date)))
94ce0230 GM	421	(list month year (cal-html-year-dir-ask-user year))))
	422	(make-directory dir t)
	423	(cal-html-one-month month year dir))
	424
d3a0e5bf	425	;;;###cal-autoload
94ce0230 GM	426	(defun cal-html-cursor-year (year dir)
	427	"Write HTML calendar files (index and monthly pages) for four-digit YEAR.
	428	The output directory DIR is created if necessary. Interactively,
	429	YEAR is taken from the calendar cursor position. Note that any
	430	existing output files are overwritten."
e803eab7	431	(interactive (let ((year (calendar-extract-year
94ce0230 GM	432	(calendar-cursor-to-date t))))
	433	(list year (cal-html-year-dir-ask-user year))))
	434	(make-directory dir t)
	435	(with-temp-buffer
	436	(cal-html-insert-year-minicals year cal-html-year-index-cols)
	437	(write-file (expand-file-name "index.html" dir)))
	438	(dotimes (i 12)
	439	(cal-html-one-month (1+ i) year dir)))
	440
	441
	442	(provide 'cal-html)
	443
fdcd003e	444	;; arch-tag: 4e73377d-d2c1-46ea-a103-02c111da5f57
94ce0230	445	;;; cal-html.el ends here