lisp/calendar/cal-html.el

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