Fix newly-introduced lock-up during HTML publishing.
[muse-el.git] / muse-journal.el
blob1a7281795853efd2c990637b786a043f3df50172
1 ;;; muse-journal.el --- Keep and publish a journal.
3 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
5 ;; This file is not part of GNU Emacs.
7 ;; This is free software; you can redistribute it and/or modify it under
8 ;; the terms of the GNU General Public License as published by the Free
9 ;; Software Foundation; either version 2, or (at your option) any later
10 ;; version.
12 ;; This is distributed in the hope that it will be useful, but WITHOUT
13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 ;; for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
20 ;; MA 02111-1307, USA.
22 ;;; Commentary:
24 ;; The module facilitates the keeping and publication of a journal.
25 ;; When publishing to HTML, it assumes the form of a web log, or blog.
27 ;; The input format for each entry is as follows:
29 ;; * 20040317: Title of entry
31 ;; Text for the entry.
33 ;; <qotd>
34 ;; "You know who you are. It comes down to a simple gut check: You
35 ;; either love what you do or you don't. Period." -- P. Bronson
36 ;; </qotd>
38 ;; The "qotd", or Quote of the Day, is entirely optional. When
39 ;; generated to HTML, this entry is rendered as:
41 ;; <div id="entry">
42 ;; <div id="entry-qotd">
43 ;; <h3>Quote of the Day:</h3>
44 ;; <p>"You know who you are. It comes down to a simple gut
45 ;; check: You either love what you do or you don't. Period."
46 ;; -- P. Bronson</p>
47 ;; </div>
48 ;; <div id="entry-body">
49 ;; <div id="entry-head">
50 ;; <div id="entry-date">
51 ;; <span class="date">March 17, 2004</span>
52 ;; </div>
53 ;; <div id="entry-title">
54 ;; <h2>Title of entry</h2>
55 ;; </div>
56 ;; </div>
57 ;; <div id="entry-text">
58 ;; <p>Text for the entry.</p>
59 ;; </div>
60 ;; </div>
61 ;; </div>
63 ;; The plurality of "div" tags makes it possible to display the
64 ;; entries in any form you wish, using a CSS style.
66 ;; Also, an .RDF file can be generated from your journal by publishing
67 ;; it with the "rdf" style. It uses the first two sentences of the
68 ;; first paragraph of each entry as its "description", and
69 ;; autogenerates tags for linking to the various entries.
71 ;;; Contributors:
73 ;;; Code:
75 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
77 ;; Muse Journal Publishing
79 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
81 (require 'muse-publish)
82 (require 'muse-html)
83 (require 'muse-latex)
84 (require 'muse-book)
86 (defgroup muse-journal nil
87 "Rules for transforming a journal into its final form."
88 :group 'muse-publish)
90 (defcustom muse-journal-heading-regexp
91 "\\(?:\\([0-9]+\\)\\(?:: \\)?\\)?\\(.+?\\)?"
92 "A regexp that match a journal heading.
93 Paren group 1 is the ISO date, group 2 is the optional category,
94 and group 3 is the optional heading for the entry."
95 :type 'regexp
96 :group 'muse-journal)
98 (defcustom muse-journal-date-format "%a, %e %b %Y"
99 "Date formats to use for journal entries."
100 :type 'string
101 :group 'muse-journal)
103 (defcustom muse-journal-html-heading-regexp
104 (concat "^<h2[^>]*>" muse-journal-heading-regexp "</h2>$")
105 "A regexp that match a journal heading.
106 Paren group 1 is the ISO date, group 2 is the optional category,
107 and group 3 is the optional heading for the entry."
108 :type 'regexp
109 :group 'muse-journal)
111 (defcustom muse-journal-html-entry-template
112 "<div id=\"entry\">
113 <a name=\"%anchor%\" style=\"text-decoration: none\">&nbsp;</a>
114 <div id=\"entry-body\">
115 <div id=\"entry-head\">
116 <div id=\"entry-date\">
117 <span class=\"date\">%date%</span>
118 </div>
119 <div id=\"entry-title\">
120 <h2>%title%</h2>
121 </div>
122 </div>
123 <div id=\"entry-text\">
124 <div id=\"entry-qotd\">
125 <p>%qotd%</p>
126 </div>
127 %text%
128 </div>
129 </div>
130 </div>\n\n"
132 :type 'string
133 :group 'muse-journal)
135 (defcustom muse-journal-latex-section
136 "\\section*{%title% \\hfill {\\normalsize %date%}}
137 \\addcontentsline{toc}{chapter}{%title%}"
139 :type 'string
140 :group 'muse-journal)
142 (defcustom muse-journal-latex-subsection
143 "\\subsection*{%title%}
144 \\addcontentsline{toc}{section}{%title%}"
146 :type 'string
147 :group 'muse-journal)
149 (defcustom muse-journal-latex-markup-tags
150 '(("qotd" t nil muse-journal-latex-qotd-tag))
151 "See `muse-publish-markup-tags' for more info."
152 :type '(repeat (list (string :tag "Markup tag")
153 (boolean :tag "Expect closing tag" :value t)
154 (boolean :tag "Parse attributes" :value nil)
155 function))
156 :group 'muse-journal)
158 (defun muse-journal-generate-pages ()
159 (let ((output-dir (muse-style-element :path)))
160 (goto-char (point-min))
161 (while (re-search-forward muse-journal-heading-regexp nil t)
162 (let* ((date (match-string 1))
163 (category (match-string 1))
164 (category-file (concat output-dir category "/index.html"))
165 (heading (match-string 1)))
166 t))))
168 (defcustom muse-journal-rdf-extension ".rdf"
170 :type 'string
171 :group 'muse-journal)
173 (defcustom muse-journal-rdf-base-url ""
174 "The base URL of the website reference by the RDF file."
175 :type 'string
176 :group 'muse-journal)
178 (defcustom muse-journal-rdf-header
179 "<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
180 xmlns=\"http://purl.org/rss/1.0/\"
181 xmlns:dc=\"http://purl.org/dc/elements/1.1/\">
182 <channel rdf:about=\"<lisp>(concat (muse-style-element :base-url)
183 (muse-publish-output-name))</lisp>\">
184 <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
185 <link><lisp>(concat (muse-style-element :base-url)
186 (concat (muse-page-name)
187 muse-html-extension))</lisp></link>
188 <description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
189 <items>
190 <rdf:Seq>
191 <rdf:li resource=\"<lisp>
192 (concat (muse-style-element :base-url)
193 (concat (muse-page-name)
194 muse-html-extension))</lisp>\"/>
195 </rdf:Seq>
196 </items>
197 </channel>\n"
199 :type '(choice string file)
200 :group 'muse-journal)
202 (defcustom muse-journal-rdf-footer
203 "</rdf:RDF>\n"
205 :type '(choice string file)
206 :group 'muse-journal)
208 (defcustom muse-journal-rdf-date-format
209 "%Y-%m-%dT%H:%M:%S"
211 :type 'string
212 :group 'muse-journal)
214 (defcustom muse-journal-rdf-entry-template
215 " <item rdf:about=\"%link%#%anchor%\">
216 <title>%title%</title>
217 <description>
218 %desc%
219 </description>
220 <link>%link%#%anchor%</link>
221 <dc:date>%date%</dc:date>
222 <dc:creator>%maintainer%</dc:creator>
223 </item>\n"
225 :type 'string
226 :group 'muse-journal)
228 (defcustom muse-journal-rdf-summarize-entries t
229 "If non-nil, include only summaries in the RDF file, not the full data."
230 :type 'boolean
231 :group 'muse-journal)
233 (defcustom muse-journal-rss-extension ".xml"
235 :type 'string
236 :group 'muse-journal)
238 (defcustom muse-journal-rss-base-url ""
239 "The base URL of the website reference by the RSS file."
240 :type 'string
241 :group 'muse-journal)
243 (defcustom muse-journal-rss-header
244 "<\?xml version=\"1.0\" encoding=\"iso-8859-1\"\?>
245 <rss version=\"2.0\">
246 <channel>
247 <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
248 <link><lisp>(concat (muse-style-element :base-url)
249 (concat (muse-page-name)
250 muse-html-extension))</lisp></link>
251 <description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
252 <language>en-us</language>
253 <generator>Emacs Muse</generator>"
255 :type '(choice string file)
256 :group 'muse-journal)
258 (defcustom muse-journal-rss-footer
259 " </channel>
260 </rss>\n"
262 :type '(choice string file)
263 :group 'muse-journal)
265 (defcustom muse-journal-rss-date-format
266 "%a, %d %b %Y %H:%M:%S %Z"
268 :type 'string
269 :group 'muse-journal)
271 (defcustom muse-journal-rss-entry-template
272 " <item>
273 <title>%title%</title>
274 <link>%link%#%anchor%</link>
275 <description>%desc%</description>
276 <author><lisp>(muse-publishing-directive \"author\")</lisp></author>
277 <pubDate>%date%</pubDate>
278 <guid>%link%#%anchor%</guid>
279 %enclosure%
280 </item>\n"
282 :type 'string
283 :group 'muse-journal)
285 (defcustom muse-journal-rss-enclosure-types-alist
286 '(("mp3" . "audio/mpeg"))
288 :type '(alist :key-type string :value-type string)
289 :group 'muse-journal)
291 (defcustom muse-journal-rss-summarize-entries nil
292 "If non-nil, include only summaries in the RSS file, not the full data."
293 :type 'boolean
294 :group 'muse-journal)
296 (defcustom muse-journal-rss-markup-regexps
297 '((10000 muse-link-regexp 0 "\\2"))
298 "List of markup rules for publishing a Muse journal page to RDF.
299 For more on the structure of this list, see `muse-publish-markup-regexps'."
300 :type '(repeat (choice
301 (list :tag "Markup rule"
302 integer
303 (choice regexp symbol)
304 integer
305 (choice string function symbol))
306 function))
307 :group 'muse-journal)
309 (defcustom muse-journal-rss-markup-functions
310 '((email . ignore)
311 (link . ignore)
312 (url . ignore))
313 "An alist of style types to custom functions for that kind of text.
314 For more on the structure of this list, see
315 `muse-publish-markup-functions'."
316 :type '(alist :key-type symbol :value-type function)
317 :group 'muse-journal)
319 (defun muse-journal-anchorize-title (title)
320 (save-match-data
321 (if (string-match "(" title)
322 (setq title (substring title 0 (match-beginning 0))))
323 (if (string-match "<[^>]+>" title)
324 (setq title (replace-match "" nil nil title)))
325 (downcase (replace-regexp-in-string "[^a-zA-Z0-9_]" ""
326 title))))
328 (defun muse-journal-sort-entries (&optional direction)
329 (interactive "P")
330 (sort-subr
331 direction
332 (function
333 (lambda ()
334 (if (re-search-forward "^\\* [0-9]+" nil t)
335 (goto-char (match-beginning 0))
336 (goto-char (point-max)))))
337 (function
338 (lambda ()
339 (if (re-search-forward "^\\* [0-9]+" nil t)
340 (goto-char (1- (match-beginning 0)))
341 (goto-char (point-max)))))
342 (function
343 (lambda ()
344 (forward-char 2)))
345 (function
346 (lambda ()
347 (end-of-line)))))
349 (defun muse-journal-html-munge-buffer ()
350 (goto-char (point-min))
351 (let ((heading-regexp muse-journal-html-heading-regexp)
352 (inhibit-read-only t))
353 (while (re-search-forward heading-regexp nil t)
354 (let* ((date (match-string 1))
355 (orig-date date)
356 (title (match-string 2))
357 (clean-title title)
358 datestamp qotd text)
359 (delete-region (match-beginning 0) (match-end 0))
360 (if clean-title
361 (save-match-data
362 (while (string-match "\\(^<[^>]+>\\|<[^>]+>$\\)" clean-title)
363 (setq clean-title (replace-match "" nil nil clean-title)))))
364 (save-match-data
365 (when (and date
366 (string-match
367 (concat "\\`\\([1-9][0-9][0-9][0-9]\\)[./]?"
368 "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
369 (setq datestamp
370 (encode-time
371 0 0 0
372 (string-to-int (match-string 3 date))
373 (string-to-int (match-string 2 date))
374 (string-to-int (match-string 1 date))
375 (current-time-zone))
376 date (concat (format-time-string
377 muse-journal-date-format datestamp)
378 (substring date (match-end 0))))))
379 (save-restriction
380 (narrow-to-region
381 (point) (if (re-search-forward
382 (concat "\\(^<hr>$\\|"
383 heading-regexp "\\)") nil t)
384 (match-beginning 0)
385 (point-max)))
386 (goto-char (point-max))
387 (while (and (not (bobp))
388 (eq ?\ (char-syntax (char-before))))
389 (delete-char -1))
390 (goto-char (point-min))
391 (while (and (not (eobp))
392 (eq ?\ (char-syntax (char-after))))
393 (delete-char 1))
394 (save-excursion
395 (when (search-forward "<qotd>" nil t)
396 (let ((tag-beg (match-beginning 0))
397 (beg (match-end 0)))
398 (re-search-forward "</qotd>\n*")
399 (setq qotd (buffer-substring-no-properties
400 beg (match-beginning 0)))
401 (delete-region tag-beg (match-end 0)))))
402 (setq text (buffer-string))
403 (delete-region (point-min) (point-max))
404 (let ((entry muse-journal-html-entry-template))
405 (while (string-match "%date%" entry)
406 (setq entry (replace-match (or date "") nil t entry)))
407 (while (string-match "%title%" entry)
408 (setq entry (replace-match (or title "&nbsp;") nil t entry)))
409 (while (string-match "%anchor%" entry)
410 (setq entry (replace-match
411 (muse-journal-anchorize-title
412 (or clean-title orig-date))
413 nil t entry)))
414 (while (string-match "%qotd%" entry)
415 (setq entry (replace-match (or qotd "") nil t entry)))
416 (while (string-match "%text%" entry)
417 (setq entry (replace-match text nil t entry)))
418 (insert entry)
419 (when (null qotd)
420 (goto-char (point-min))
421 (search-forward "<div id=\"entry-qotd\">")
422 (let ((beg (match-beginning 0)))
423 (re-search-forward "</div>\n*")
424 (delete-region beg (point))))))))))
426 (defun muse-journal-latex-munge-buffer ()
427 (goto-char (point-min))
428 (let ((heading-regexp
429 (concat "^" (regexp-quote (muse-markup-text 'section))
430 muse-journal-heading-regexp
431 (regexp-quote (muse-markup-text 'section-end)) "$"))
432 (inhibit-read-only t))
433 (when (re-search-forward heading-regexp nil t)
434 (goto-char (match-beginning 0))
435 (sort-subr nil
436 (function
437 (lambda ()
438 (if (re-search-forward heading-regexp nil t)
439 (goto-char (match-beginning 0))
440 (goto-char (point-max)))))
441 (function
442 (lambda ()
443 (if (re-search-forward heading-regexp nil t)
444 (goto-char (1- (match-beginning 0)))
445 (goto-char (point-max)))))
446 (function
447 (lambda ()
448 (forward-char 2)))
449 (function
450 (lambda ()
451 (end-of-line)))))
452 (while (re-search-forward heading-regexp nil t)
453 (let ((date (match-string 1))
454 (title (match-string 2))
455 qotd section)
456 (save-match-data
457 (when (and date
458 (string-match
459 (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
460 "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
461 (setq date (encode-time
462 0 0 0
463 (string-to-int (match-string 3 date))
464 (string-to-int (match-string 2 date))
465 (string-to-int (match-string 1 date))
466 (current-time-zone))
467 date (format-time-string
468 muse-journal-date-format date))))
469 (save-match-data
470 (setq section muse-journal-latex-section)
471 (while (string-match "%title%" section)
472 (setq section (replace-match (or title "Untitled")
473 nil t section)))
474 (while (string-match "%date%" section)
475 (setq section (replace-match (or date "") nil t section))))
476 (replace-match section nil t))))
477 (goto-char (point-min))
478 (let ((subheading-regexp
479 (concat "^" (regexp-quote (muse-markup-text 'subsection))
480 "\\([^\n}]+\\)"
481 (regexp-quote (muse-markup-text 'subsection-end)) "$"))
482 (inhibit-read-only t))
483 (while (re-search-forward subheading-regexp nil t)
484 (let ((subsection muse-journal-latex-subsection))
485 (save-match-data
486 (let ((title (match-string 1)))
487 (while (string-match "%title%" subsection)
488 (setq subsection (replace-match title nil t subsection)))))
489 (replace-match subsection nil t)))))
491 (defun muse-journal-latex-qotd-tag (beg end)
492 (goto-char beg)
493 (insert (muse-markup-text 'begin-quote))
494 (goto-char end)
495 (insert (muse-markup-text 'end-quote)))
497 (defun muse-journal-rss-munge-buffer ()
498 (goto-char (point-min))
499 (let ((heading-regexp (concat "^\\* " muse-journal-heading-regexp "$"))
500 (inhibit-read-only t))
501 (while (re-search-forward heading-regexp nil t)
502 (let* ((date (match-string 1))
503 (orig-date date)
504 (title (match-string 2))
505 enclosure qotd desc)
506 (if title
507 (save-match-data
508 (if (string-match muse-link-regexp title)
509 (setq enclosure (match-string 1 title)
510 title (match-string 2 title)))))
511 (save-match-data
512 (when (and date
513 (string-match
514 (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
515 "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
516 (setq date (encode-time 0 0 0
517 (string-to-int (match-string 3 date))
518 (string-to-int (match-string 2 date))
519 (string-to-int (match-string 1 date))
520 (current-time-zone))
521 date (format-time-string
522 (muse-style-element :date-format) date))))
523 (save-restriction
524 (narrow-to-region
525 (match-beginning 0)
526 (if (re-search-forward heading-regexp nil t)
527 (match-beginning 0)
528 (if (re-search-forward "^Footnotes:" nil t)
529 (match-beginning 0)
530 (point-max))))
531 (goto-char (point-min))
532 (delete-region (point) (line-end-position))
533 (re-search-forward "</qotd>\n+" nil t)
534 (while (and (char-after)
535 (eq ?\ (char-syntax (char-after))))
536 (delete-char 1))
537 (let ((beg (point)))
538 (if (muse-style-element :summarize)
539 (progn
540 (forward-sentence 2)
541 (setq desc (concat (buffer-substring beg (point)) "...")))
542 (save-restriction
543 (muse-publish-markup-buffer "rss-entry" "html")
544 (goto-char (point-min))
545 (re-search-forward "Page published by Emacs Muse")
546 (goto-char (line-end-position))
547 (setq beg (point))
548 (re-search-forward "Page published by Emacs Muse")
549 (goto-char (line-beginning-position))
550 (setq desc (concat "<![CDATA[" (buffer-substring beg (point))
551 "]]>")))))
552 (delete-region (point-min) (point-max))
553 (let ((entry (muse-style-element :entry-template)))
554 (while (string-match "%date%" entry)
555 (setq entry (replace-match (or date "") nil t entry)))
556 (while (string-match "%title%" entry)
557 (setq entry (replace-match (or title "Untitled") nil t entry)))
558 (while (string-match "%desc%" entry)
559 (setq entry (replace-match desc nil t entry)))
560 (while (string-match "%enclosure%" entry)
561 (setq
562 entry
563 (replace-match
564 (if (null enclosure)
566 (save-match-data
567 (format
568 "<enclosure url=\"%s\" %stype=\"%s\"/>"
569 (if (string-match "//" enclosure)
570 enclosure
571 (concat (muse-style-element :base-url)
572 enclosure))
573 (let ((file
574 (expand-file-name enclosure
575 (muse-style-element :path))))
576 (if (file-readable-p file)
577 (format "length=\"%d\" "
578 (nth 7 (file-attributes file)))
579 ""))
580 (if (string-match "\\.\\([^.]+\\)$" enclosure)
581 (let* ((ext (match-string 1 enclosure))
582 (type
583 (assoc ext muse-journal-rss-enclosure-types-alist)))
584 (if type
585 (cdr type)
586 "application/octet-stream"))))))
587 nil t entry)))
588 (while (string-match "%link%" entry)
589 (setq entry (replace-match
590 (concat (muse-style-element :base-url)
591 (concat (muse-page-name)
592 muse-html-extension))
593 nil t entry)))
594 (while (string-match "%anchor%" entry)
595 (setq entry (replace-match
596 (muse-journal-anchorize-title (or title orig-date))
597 nil t entry)))
598 (while (string-match "%maintainer%" entry)
599 (setq entry (replace-match
600 (or (muse-style-element :maintainer)
601 (concat "webmaster@" (system-name)))
602 nil t entry)))
603 (insert entry)))))
604 (unless (eobp)
605 (delete-region (point) (point-max)))))
607 (unless (assoc "journal-html" muse-publishing-styles)
608 (muse-derive-style "journal-html" "html"
609 :before-end 'muse-journal-html-munge-buffer)
611 (muse-derive-style "journal-xhtml" "xhtml"
612 :before-end 'muse-journal-html-munge-buffer)
614 (muse-derive-style "journal-latex" "latex"
615 :tags 'muse-journal-latex-markup-tags
616 :before-end 'muse-journal-latex-munge-buffer)
618 (muse-derive-style "journal-pdf" "pdf"
619 :tags 'muse-journal-latex-markup-tags
620 :before-end 'muse-journal-latex-munge-buffer)
622 (muse-derive-style "journal-book-latex" "book-latex"
623 ;;:nochapters
624 :tags 'muse-journal-latex-markup-tags
625 :before-end 'muse-journal-latex-munge-buffer)
627 (muse-derive-style "journal-book-pdf" "book-pdf"
628 ;;:nochapters
629 :tags 'muse-journal-latex-markup-tags
630 :before-end 'muse-journal-latex-munge-buffer)
632 (muse-define-style "journal-rdf"
633 :suffix 'muse-journal-rdf-extension
634 :regexps 'muse-journal-rss-markup-regexps
635 :functions 'muse-journal-rss-markup-functions
636 :before 'muse-journal-rss-munge-buffer
637 :header 'muse-journal-rdf-header
638 :footer 'muse-journal-rdf-footer
639 :date-format 'muse-journal-rdf-date-format
640 :entry-template 'muse-journal-rdf-entry-template
641 :base-url 'muse-journal-rdf-base-url
642 :summarize 'muse-journal-rdf-summarize-entries)
644 (muse-define-style "journal-rss"
645 :suffix 'muse-journal-rss-extension
646 :regexps 'muse-journal-rss-markup-regexps
647 :functions 'muse-journal-rss-markup-functions
648 :before 'muse-journal-rss-munge-buffer
649 :header 'muse-journal-rss-header
650 :footer 'muse-journal-rss-footer
651 :date-format 'muse-journal-rss-date-format
652 :entry-template 'muse-journal-rss-entry-template
653 :base-url 'muse-journal-rss-base-url
654 :summarize 'muse-journal-rss-summarize-entries))
656 (provide 'muse-journal)
658 ;;; muse-journal.el ends here