lisp/calendar/cal-html.el

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