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 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 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 '(("&" . "&") 133 ("\n" . "<BR>\n")) 134 "Alist of symbols and their HTML replacements.") 135 136 137 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. 166For 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. 172If optional argument CHANGE-DIR is non-nil and MONTH is 1 or 2, 173the 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. 193Return 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. 205Contains 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. 278There 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. 302Characters 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. 329DATE-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. 355HTML commands are inserted for the days of the numeric MONTH in 356four-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> " 374 (calendar-day-number date)) 375 "") 376 (format "%d %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 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. 415The output directory DIR is created if necessary. Interactively, 416MONTH and YEAR are taken from the calendar cursor position. Note 417that 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. 427The output directory DIR is created if necessary. Interactively, 428YEAR is taken from the calendar cursor position. Note that any 429existing 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 446