lisp/calendar/cal-html.el

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