(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)
(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))))
(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) (increment-calendar-month month year -1) (cal-html-insert-link-monthpage month year t) (increment-calendar-month month year 1) (cal-html-insert-link-yearpage month year)
(increment-calendar-month month year 1) (cal-html-insert-link-monthpage month year t) (insert cal-html-e-tabledata-string)
(insert cal-html-b-tabledata-string) (increment-calendar-month month year -1)
(cal-html-insert-minical month year)
(insert cal-html-e-tabledata-string)
(insert cal-html-e-tablerow-string) (insert cal-html-e-table-string))
(defun cal-html-insert-minical (month year)
"Insert a minical for numeric MONTH of YEAR."
(let* ((blank-days (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 (mod (- 6 (- (calendar-day-of-week (list month last year))
calendar-week-start-day))
7))
(monthpage-name (cal-html-monthpage-name month year))
date)
(insert (cal-html-comment "MINICAL")
(cal-html-b-table "class=minical border=1 align=center"))
(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)
(insert cal-html-b-tablerow-string)
(dotimes (i blank-days)
(insert
cal-html-b-tabledata-string
cal-html-e-tabledata-string))
(dotimes (i last)
(insert (format cal-html-minical-day-format monthpage-name i (1+ i)))
(if (and (zerop (mod (+ i 1 blank-days) 7))
(/= (1+ i) last))
(insert cal-html-e-tablerow-string
cal-html-b-tablerow-string)))
(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")))
(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))
(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 "))
(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 (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)) cal-html-b-tablerow-string
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
cal-html-b-tabledata-string
(cal-html-htmlify-list diary-list date)
cal-html-e-tabledata-string
cal-html-e-tablerow-string)
(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)))))
(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)