;;; cal-html.el --- functions for printing HTML calendars;; Copyright (C) 2002, 2003, 2004, 2005, 2006 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 2, 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; 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 Emacs 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 infour-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. Notethat 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 anyexisting 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