From: Glenn Morris <rgm@gnu.org>
Date: Sat, 28 Oct 2006 21:49:04 +0000 (+0000)
Subject: New file, from:  Anna M. Bigatti <bigatti at dima.unige.it>.
X-Git-Tag: emacs-pretest-22.0.91~491
X-Git-Url: https://code.delx.au/gnu-emacs/commitdiff_plain/94ce023059fcc9856a3914a70ea462e385551bed

New file, from:  Anna M. Bigatti <bigatti at dima.unige.it>.
---

diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
new file mode 100644
index 0000000000..5ae3697ade
--- /dev/null
+++ b/lisp/calendar/cal-html.el
@@ -0,0 +1,444 @@
+;;; 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
+  '(("&" . "&amp;")
+    ("\n" . "<BR>\n"))
+  "Alist of symbols and their HTML replacements.")
+
+
+
+(defun cal-html-comment (string)
+  "Return STRING as html comment."
+  (format "<!--  ======  %s  ======  -->\n"
+          (replace-regexp-in-string "--" "++" string)))
+
+(defun cal-html-href (link string)
+  "Return a hyperlink to url LINK with text STRING."
+  (format "<A HREF=\"%s\">%s</A>" link string))
+
+(defun cal-html-h3 (string)
+  "Return STRING as html header h3."
+  (format "\n        <H3>%s</H3>\n" string))
+
+(defun cal-html-h1 (string)
+  "Return STRING as html header h1."
+  (format "\n        <H1>%s</H1>\n" string))
+
+(defun cal-html-th (string)
+  "Return STRING as html table header."
+  (format "%s%s%s" cal-html-b-tableheader-string string
+          cal-html-e-tableheader-string))
+
+(defun cal-html-b-table (arg)
+  "Return table tag with attribute ARG."
+  (format "\n<TABLE %s>\n" arg))
+
+(defun cal-html-monthpage-name (month year)
+  "Return name of html page for numeric MONTH and four-digit YEAR.
+For example, \"2006-08.html\" for 8 2006."
+  (format "%d-%.2d.html" year month))
+
+
+(defun cal-html-insert-link-monthpage (month year &optional change-dir)
+  "Insert a link to the html page for numeric MONTH and four-digit YEAR.
+If optional argument CHANGE-DIR is non-nil and MONTH is 1 or 2,
+the link points to a different year and so has a directory part."
+  (insert (cal-html-h3
+           (cal-html-href
+            (concat (and change-dir
+                         (member month '(1 12))
+                         (format "../%d/" year))
+                    (cal-html-monthpage-name month year))
+            (calendar-month-name month)))))
+
+
+(defun cal-html-insert-link-yearpage (month year)
+  "Insert a link to index page for four-digit YEAR, tagged using MONTH name."
+  (insert (cal-html-h1
+           (format "%s %s"
+                   (calendar-month-name month)
+                   (cal-html-href "index.html" (number-to-string year))))))
+
+
+(defun cal-html-year-dir-ask-user (year)
+  "Prompt for the html calendar output directory for four-digit YEAR.
+Return the expanded directory name, which is based on
+`cal-html-directory' by default."
+  (expand-file-name (read-directory-name
+                     "Enter HTML calendar directory name: "
+                     (expand-file-name (format "%d" year)
+                                       cal-html-directory))))
+
+;;------------------------------------------------------------
+;; page header
+;;------------------------------------------------------------
+(defun cal-html-insert-month-header (month year)
+  "Insert the header for the numeric MONTH page for four-digit YEAR.
+Contains links to previous and next month and year, and current minical."
+  (insert (cal-html-b-table "class=header"))
+  (insert cal-html-b-tablerow-string)
+  (insert cal-html-b-tabledata-string)          ; month links
+  (increment-calendar-month month year -1)      ; previous month
+  (cal-html-insert-link-monthpage month year t) ; t --> change-dir
+  (increment-calendar-month month year 1)       ; current month
+  (cal-html-insert-link-yearpage month year)
+  (increment-calendar-month month year 1)       ; next month
+  (cal-html-insert-link-monthpage month year t) ; t --> change-dir
+  (insert cal-html-e-tabledata-string)
+  (insert cal-html-b-tabledata-string)  ; minical
+  (increment-calendar-month month year -1)
+  (cal-html-insert-minical month year)
+  (insert cal-html-e-tabledata-string)
+  (insert cal-html-e-tablerow-string)   ; end
+  (insert cal-html-e-table-string))
+
+;;------------------------------------------------------------
+;; minical: a small month calendar with links
+;;------------------------------------------------------------
+(defun cal-html-insert-minical (month year)
+  "Insert a minical for numeric MONTH of YEAR."
+  (let* ((blank-days                    ; at start of month
+          (mod (- (calendar-day-of-week (list month 1 year))
+                  calendar-week-start-day)
+               7))
+         (last (calendar-last-day-of-month month year))
+         (end-blank-days                ; at end of month
+          (mod (- 6 (- (calendar-day-of-week (list month last year))
+                       calendar-week-start-day))
+               7))
+         (monthpage-name (cal-html-monthpage-name month year))
+         date)
+    ;; Start writing table.
+    (insert (cal-html-comment "MINICAL")
+            (cal-html-b-table "class=minical border=1 align=center"))
+    ;; Weekdays row.
+    (insert cal-html-b-tablerow-string)
+    (dotimes (i 7)
+      (insert (cal-html-th
+               (aref cal-html-day-abbrev-array
+                     (mod (+ i calendar-week-start-day) 7)))))
+    (insert cal-html-e-tablerow-string)
+    ;; Initial empty slots.
+    (insert cal-html-b-tablerow-string)
+    (dotimes (i blank-days)
+      (insert
+       cal-html-b-tabledata-string
+       cal-html-e-tabledata-string))
+    ;; Numbers.
+    (dotimes (i last)
+      (insert (format cal-html-minical-day-format monthpage-name i (1+ i)))
+      ;; New row?
+      (if (and (zerop (mod (+ i 1 blank-days) 7))
+               (/= (1+ i) last))
+          (insert cal-html-e-tablerow-string
+                  cal-html-b-tablerow-string)))
+    ;; End empty slots (for some browsers like konqueror).
+    (dotimes (i end-blank-days)
+      (insert
+       cal-html-b-tabledata-string
+       cal-html-e-tabledata-string)))
+  (insert cal-html-e-tablerow-string
+          cal-html-e-table-string
+          (cal-html-comment "MINICAL end")))
+
+
+;;------------------------------------------------------------
+;; year index page with minicals
+;;------------------------------------------------------------
+(defun cal-html-insert-year-minicals (year cols)
+  "Make a one page yearly mini-calendar for four-digit YEAR.
+There are 12/cols rows of COLS months each."
+  (insert cal-html-b-document-string)
+  (insert (cal-html-h1 (number-to-string year)))
+  (insert (cal-html-b-table "class=year")
+          cal-html-b-tablerow-string)
+  (dotimes (i 12)
+    (insert cal-html-b-tabledata-string)
+    (cal-html-insert-link-monthpage (1+ i) year)
+    (cal-html-insert-minical (1+ i) year)
+    (insert cal-html-e-tabledata-string)
+    (if (zerop (mod (1+ i) cols))
+        (insert cal-html-e-tablerow-string
+                cal-html-b-tablerow-string)))
+  (insert cal-html-e-tablerow-string
+          cal-html-e-table-string
+          cal-html-e-document-string))
+
+
+;;------------------------------------------------------------
+;; HTMLify
+;;------------------------------------------------------------
+
+(defun cal-html-htmlify-string (string)
+  "Protect special characters in STRING from HTML.
+Characters are replaced according to `cal-html-html-subst-list'."
+  (if (stringp string)
+      (replace-regexp-in-string
+       (regexp-opt (mapcar 'car cal-html-html-subst-list))
+       (lambda (x)
+         (cdr (assoc x cal-html-html-subst-list)))
+       string)
+    ""))
+
+
+(defun cal-html-htmlify-entry (entry)
+  "Convert a diary entry ENTRY to html with the appropriate class specifier."
+  (let ((start
+         (cond
+          ((string-match "block" (car (cddr entry))) "BLOCK")
+          ((string-match "anniversary" (car (cddr entry))) "ANN")
+          ((not (string-match
+                 (number-to-string (car (cddr (car entry))))
+                 (car (cddr entry))))
+           "NO-YEAR")
+          (t "NORMAL"))))
+    (format "<span class=%s>%s</span>" start
+            (cal-html-htmlify-string (cadr entry)))))
+
+
+(defun cal-html-htmlify-list (date-list date)
+  "Return a string of concatenated, HTMLified diary entries.
+DATE-LIST is a list of diary entries.  Return only those matching DATE."
+  (mapconcat (lambda (x) (cal-html-htmlify-entry x))
+             (let (result)
+               (dolist (p date-list (reverse result))
+                 (and (car p)
+                      (calendar-date-equal date (car p))
+                      (setq result (cons p result)))))
+               "<BR>\n     "))
+
+
+;;------------------------------------------------------------
+;;  Monthly calendar
+;;------------------------------------------------------------
+
+(autoload 'diary-list-entries "diary-lib" nil t)
+
+(defun cal-html-list-diary-entries (d1 d2)
+  "Generate a list of all diary-entries from absolute date D1 to D2."
+  (let (diary-display-hook)
+    (diary-list-entries
+     (calendar-gregorian-from-absolute d1)
+     (1+ (- d2 d1)))))
+
+
+(defun cal-html-insert-agenda-days (month year diary-list)
+  "Insert HTML commands for a range of days in monthly calendars.
+HTML commands are inserted for the days of the numeric MONTH in
+four-digit YEAR.  Diary entries in DIARY-LIST are included."
+  (let ((blank-days                     ; at start of month
+         (mod (- (calendar-day-of-week (list month 1 year))
+                 calendar-week-start-day)
+              7))
+        (last (calendar-last-day-of-month month year))
+        date)
+    (insert "<a name=0>\n")
+    (insert (cal-html-b-table "class=agenda border=1"))
+    (dotimes (i last)
+      (setq date (list month (1+ i) year))
+      (insert
+       (format "<a name=%d></a>\n" (1+ i)) ; link
+       cal-html-b-tablerow-string
+       ;; Number & day name.
+       cal-html-b-tableheader-string
+       (if cal-html-print-day-number-flag
+           (format "<em>%d</em>&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)))))
+
+
+;;; User commands.
+
+(defun cal-html-cursor-month (month year dir)
+  "Write an HTML calendar file for numeric MONTH of four-digit YEAR.
+The output directory DIR is created if necessary.  Interactively,
+MONTH and YEAR are taken from the calendar cursor position.  Note
+that any existing output files are overwritten."
+  (interactive (let* ((date (calendar-cursor-to-date t))
+                      (month (extract-calendar-month date))
+                      (year (extract-calendar-year date)))
+                 (list month year (cal-html-year-dir-ask-user year))))
+  (make-directory dir t)
+  (cal-html-one-month month year dir))
+
+(defun cal-html-cursor-year (year dir)
+  "Write HTML calendar files (index and monthly pages) for four-digit YEAR.
+The output directory DIR is created if necessary.  Interactively,
+YEAR is taken from the calendar cursor position.  Note that any
+existing output files are overwritten."
+  (interactive (let ((year (extract-calendar-year
+                            (calendar-cursor-to-date t))))
+                 (list year (cal-html-year-dir-ask-user year))))
+  (make-directory dir t)
+  (with-temp-buffer
+    (cal-html-insert-year-minicals year cal-html-year-index-cols)
+    (write-file (expand-file-name "index.html" dir)))
+  (dotimes (i 12)
+    (cal-html-one-month (1+ i) year dir)))
+
+
+(provide 'cal-html)
+
+
+;;; cal-html.el ends here