lisp/calendar/cal-html.el

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