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