Mercurial > emacs
comparison lisp/calendar/cal-html.el @ 73517:2881aec6b925
New file, from: Anna M. Bigatti <bigatti at dima.unige.it>.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sat, 28 Oct 2006 21:49:04 +0000 |
parents | |
children | 3a457f633344 |
comparison
equal
deleted
inserted
replaced
73516:a4f1d5ea6dee | 73517:2881aec6b925 |
---|---|
1 ;;; cal-html.el --- functions for printing HTML calendars | |
2 | |
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006 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. | |
166 For 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. | |
172 If optional argument CHANGE-DIR is non-nil and MONTH is 1 or 2, | |
173 the 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. | |
193 Return 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. | |
205 Contains 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. | |
278 There 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. | |
302 Characters 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. | |
329 DATE-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. | |
355 HTML commands are inserted for the days of the numeric MONTH in | |
356 four-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. | |
415 The output directory DIR is created if necessary. Interactively, | |
416 MONTH and YEAR are taken from the calendar cursor position. Note | |
417 that 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. | |
427 The output directory DIR is created if necessary. Interactively, | |
428 YEAR is taken from the calendar cursor position. Note that any | |
429 existing 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 ;;; cal-html.el ends here |