[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, 2009, 2010
;;   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."
  (diary-list-entries (calendar-gregorian-from-absolute d1)
                      (1+ (- d2 d1)) t))


(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 &optional event)
  "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, or from
the position specified by EVENT.  Note that any existing output files
are overwritten."
  (interactive (let* ((event last-nonmenu-event)
                      (date (calendar-cursor-to-date t event))
                      (month (calendar-extract-month date))
                      (year (calendar-extract-year date)))
                 (list month year (cal-html-year-dir-ask-user year) event)))
  (make-directory dir t)
  (cal-html-one-month month year dir))

;;;###cal-autoload
(defun cal-html-cursor-year (year dir &optional event)
  "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, or from the position
specified by EVENT.  Note that any existing output files are overwritten."
  (interactive (let* ((event last-nonmenu-event)
                      (year (calendar-extract-year
                             (calendar-cursor-to-date t event))))
                 (list year (cal-html-year-dir-ask-user year) event)))
  (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
114f9c96	3	;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
ad20a664	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."
fb696168 GM	346	(diary-list-entries (calendar-gregorian-from-absolute d1)
fb696168 GM	347	(1+ (- d2 d1)) t))
94ce0230 GM	348
	349
	350	(defun cal-html-insert-agenda-days (month year diary-list)
	351	"Insert HTML commands for a range of days in monthly calendars.
	352	HTML commands are inserted for the days of the numeric MONTH in
	353	four-digit YEAR. Diary entries in DIARY-LIST are included."
	354	(let ((blank-days ; at start of month
	355	(mod (- (calendar-day-of-week (list month 1 year))
	356	calendar-week-start-day)
	357	7))
	358	(last (calendar-last-day-of-month month year))
	359	date)
	360	(insert "<a name=0>\n")
	361	(insert (cal-html-b-table "class=agenda border=1"))
	362	(dotimes (i last)
	363	(setq date (list month (1+ i) year))
	364	(insert
	365	(format "<a name=%d></a>\n" (1+ i)) ; link
	366	cal-html-b-tablerow-string
	367	;; Number & day name.
	368	cal-html-b-tableheader-string
	369	(if cal-html-print-day-number-flag
	370	(format "<em>%d</em>  "
	371	(calendar-day-number date))
	372	"")
	373	(format "%d %s" (1+ i)
	374	(aref calendar-day-name-array
	375	(calendar-day-of-week date)))
	376	cal-html-e-tableheader-string
	377	;; Diary entries.
	378	cal-html-b-tabledata-string
	379	(cal-html-htmlify-list diary-list date)
	380	cal-html-e-tabledata-string
	381	cal-html-e-tablerow-string)
	382	;; If end of week and not end of month, make new table.
	383	(if (and (zerop (mod (+ i 1 blank-days) 7))
	384	(/= (1+ i) last))
	385	(insert cal-html-e-table-string
	386	(cal-html-b-table
	387	"class=agenda border=1")))))
	388	(insert cal-html-e-table-string))
	389
	390
	391	(defun cal-html-one-month (month year dir)
	392	"Write an HTML calendar file for numeric MONTH of YEAR in directory DIR."
	393	(let ((diary-list (cal-html-list-diary-entries
	394	(calendar-absolute-from-gregorian (list month 1 year))
	395	(calendar-absolute-from-gregorian
	396	(list month
	397	(calendar-last-day-of-month month year)
	398	year)))))
	399	(with-temp-buffer
	400	(insert cal-html-b-document-string)
	401	(cal-html-insert-month-header month year)
	402	(cal-html-insert-agenda-days month year diary-list)
	403	(insert cal-html-e-document-string)
	404	(write-file (expand-file-name
	405	(cal-html-monthpage-name month year) dir)))))
	406
	407	\f
	408	;;; User commands.
	409
d3a0e5bf	410	;;;###cal-autoload
b40f3832	411	(defun cal-html-cursor-month (month year dir &optional event)
94ce0230 GM	412	"Write an HTML calendar file for numeric MONTH of four-digit YEAR.
94ce0230 GM	413	The output directory DIR is created if necessary. Interactively,
b40f3832 GM	414	MONTH and YEAR are taken from the calendar cursor position, or from
	415	the position specified by EVENT. Note that any existing output files
	416	are overwritten."
	417	(interactive (let* ((event last-nonmenu-event)
	418	(date (calendar-cursor-to-date t event))
e803eab7 GM	419	(month (calendar-extract-month date))
e803eab7 GM	420	(year (calendar-extract-year date)))
b40f3832	421	(list month year (cal-html-year-dir-ask-user year) event)))
94ce0230 GM	422	(make-directory dir t)
	423	(cal-html-one-month month year dir))
	424
d3a0e5bf	425	;;;###cal-autoload
b40f3832	426	(defun cal-html-cursor-year (year dir &optional event)
94ce0230 GM	427	"Write HTML calendar files (index and monthly pages) for four-digit YEAR.
94ce0230 GM	428	The output directory DIR is created if necessary. Interactively,
b40f3832 GM	429	YEAR is taken from the calendar cursor position, or from the position
	430	specified by EVENT. Note that any existing output files are overwritten."
	431	(interactive (let* ((event last-nonmenu-event)
	432	(year (calendar-extract-year
	433	(calendar-cursor-to-date t event))))
	434	(list year (cal-html-year-dir-ask-user year) event)))
94ce0230 GM	435	(make-directory dir t)
	436	(with-temp-buffer
	437	(cal-html-insert-year-minicals year cal-html-year-index-cols)
	438	(write-file (expand-file-name "index.html" dir)))
	439	(dotimes (i 12)
	440	(cal-html-one-month (1+ i) year dir)))
	441
	442
	443	(provide 'cal-html)
	444
fdcd003e	445	;; arch-tag: 4e73377d-d2c1-46ea-a103-02c111da5f57
94ce0230	446	;;; cal-html.el ends here