lisp/calendar/cal-html.el

   1 ;;; cal-html.el --- functions for printing HTML calendars
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007  Free Software Foundation, Inc.
   4
   5 ;; Author: Anna M. Bigatti <bigatti@dima.unige.it>
   6 ;; Keywords: calendar
   7 ;; Human-Keywords: calendar, diary, HTML
   8 ;; Created: 23 Aug 2002
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  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 to index page for four-digit YEAR, tagged using MONTH name."
 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   (increment-calendar-month month year -1)      ; previous month
 210   (cal-html-insert-link-monthpage month year t) ; t --> change-dir
 211   (increment-calendar-month month year 1)       ; current month
 212   (cal-html-insert-link-yearpage month year)
 213   (increment-calendar-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   (increment-calendar-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" (car (cddr entry))) "BLOCK")
 317           ((string-match "anniversary" (car (cddr entry))) "ANN")
 318           ((not (string-match
 319                  (number-to-string (car (cddr (car entry))))
 320                  (car (cddr 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, HTMLified 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" nil t)
 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   (let (diary-display-hook)
 348     (diary-list-entries
 349      (calendar-gregorian-from-absolute d1)
 350      (1+ (- d2 d1)))))
 351
 352
 353 (defun cal-html-insert-agenda-days (month year diary-list)
 354   "Insert HTML commands for a range of days in monthly calendars.
 355 HTML commands are inserted for the days of the numeric MONTH in
 356 four-digit YEAR.  Diary entries in DIARY-LIST are included."
 357   (let ((blank-days                     ; at start of month
 358          (mod (- (calendar-day-of-week (list month 1 year))
 359                  calendar-week-start-day)
 360               7))
 361         (last (calendar-last-day-of-month month year))
 362         date)
 363     (insert "<a name=0>\n")
 364     (insert (cal-html-b-table "class=agenda border=1"))
 365     (dotimes (i last)
 366       (setq date (list month (1+ i) year))
 367       (insert
 368        (format "<a name=%d></a>\n" (1+ i)) ; link
 369        cal-html-b-tablerow-string
 370        ;; Number & day name.
 371        cal-html-b-tableheader-string
 372        (if cal-html-print-day-number-flag
 373            (format "<em>%d</em>&nbsp;&nbsp;"
 374                    (calendar-day-number date))
 375          "")
 376        (format "%d&nbsp;%s" (1+ i)
 377                (aref calendar-day-name-array
 378                      (calendar-day-of-week date)))
 379        cal-html-e-tableheader-string
 380        ;; Diary entries.
 381        cal-html-b-tabledata-string
 382        (cal-html-htmlify-list diary-list date)
 383        cal-html-e-tabledata-string
 384        cal-html-e-tablerow-string)
 385       ;; If end of week and not end of month, make new table.
 386       (if (and (zerop (mod (+ i 1 blank-days) 7))
 387                (/= (1+ i) last))
 388           (insert cal-html-e-table-string
 389                   (cal-html-b-table
 390                    "class=agenda border=1")))))
 391   (insert cal-html-e-table-string))
 392
 393
 394 (defun cal-html-one-month (month year dir)
 395   "Write an HTML calendar file for numeric MONTH of YEAR in directory DIR."
 396   (let ((diary-list (cal-html-list-diary-entries
 397                      (calendar-absolute-from-gregorian (list month 1 year))
 398                      (calendar-absolute-from-gregorian
 399                       (list month
 400                             (calendar-last-day-of-month month year)
 401                             year)))))
 402     (with-temp-buffer
 403       (insert cal-html-b-document-string)
 404       (cal-html-insert-month-header month year)
 405       (cal-html-insert-agenda-days month year diary-list)
 406       (insert cal-html-e-document-string)
 407       (write-file (expand-file-name
 408                    (cal-html-monthpage-name month year) dir)))))
 409
 410 \f
 411 ;;; User commands.
 412
 413 (defun cal-html-cursor-month (month year dir)
 414   "Write an HTML calendar file for numeric MONTH of four-digit YEAR.
 415 The output directory DIR is created if necessary.  Interactively,
 416 MONTH and YEAR are taken from the calendar cursor position.  Note
 417 that any existing output files are overwritten."
 418   (interactive (let* ((date (calendar-cursor-to-date t))
 419                       (month (extract-calendar-month date))
 420                       (year (extract-calendar-year date)))
 421                  (list month year (cal-html-year-dir-ask-user year))))
 422   (make-directory dir t)
 423   (cal-html-one-month month year dir))
 424
 425 (defun cal-html-cursor-year (year dir)
 426   "Write HTML calendar files (index and monthly pages) for four-digit YEAR.
 427 The output directory DIR is created if necessary.  Interactively,
 428 YEAR is taken from the calendar cursor position.  Note that any
 429 existing output files are overwritten."
 430   (interactive (let ((year (extract-calendar-year
 431                             (calendar-cursor-to-date t))))
 432                  (list year (cal-html-year-dir-ask-user year))))
 433   (make-directory dir t)
 434   (with-temp-buffer
 435     (cal-html-insert-year-minicals year cal-html-year-index-cols)
 436     (write-file (expand-file-name "index.html" dir)))
 437   (dotimes (i 12)
 438     (cal-html-one-month (1+ i) year dir)))
 439
 440
 441 (provide 'cal-html)
 442
 443
 444 ;; arch-tag: 4e73377d-d2c1-46ea-a103-02c111da5f57
 445 ;;; cal-html.el ends here