cal-html.el

Revision 4220, 16.1 kB (checked in by miyoshi, 9 months ago)
Sync up with Emacs22.2.

Line
1	;;; cal-html.el --- functions for printing HTML calendars
2
3	;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 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 3, 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	;; arch-tag: 4e73377d-d2c1-46ea-a103-02c111da5f57
445	;;; cal-html.el ends here
446

Note: See TracBrowser for help on using the browser.

root/trunk/lisp/calendar/cal-html.el

Download in other formats: