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