Cater even more to XEmacs and its annoying whims.
[muse-el.git] / lisp / muse-journal.el
blob88d3bda5af0180ac77272d83d2f649e15e7c4389
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., 51 Franklin Street, Fifth Floor,
20 ;; Boston, MA 02110-1301, 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 ;; FIXME: This doesn't appear to be used.
159 (defun muse-journal-generate-pages ()
160 (let ((output-dir (muse-style-element :path)))
161 (goto-char (point-min))
162 (while (re-search-forward muse-journal-heading-regexp nil t)
163 (let* ((date (match-string 1))
164 (category (match-string 1))
165 (category-file (concat output-dir category "/index.html"))
166 (heading (match-string 1)))
167 t))))
169 (defcustom muse-journal-rdf-extension ".rdf"
171 :type 'string
172 :group 'muse-journal)
174 (defcustom muse-journal-rdf-base-url ""
175 "The base URL of the website reference by the RDF file."
176 :type 'string
177 :group 'muse-journal)
179 (defcustom muse-journal-rdf-header
180 "<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
181 xmlns=\"http://purl.org/rss/1.0/\"
182 xmlns:dc=\"http://purl.org/dc/elements/1.1/\">
183 <channel rdf:about=\"<lisp>(concat (muse-style-element :base-url)
184 (muse-publish-output-name))</lisp>\">
185 <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
186 <link><lisp>(concat (muse-style-element :base-url)
187 (concat (muse-page-name)
188 muse-html-extension))</lisp></link>
189 <description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
190 <items>
191 <rdf:Seq>
192 <rdf:li resource=\"<lisp>
193 (concat (muse-style-element :base-url)
194 (concat (muse-page-name)
195 muse-html-extension))</lisp>\"/>
196 </rdf:Seq>
197 </items>
198 </channel>\n"
200 :type '(choice string file)
201 :group 'muse-journal)
203 (defcustom muse-journal-rdf-footer
204 "</rdf:RDF>\n"
206 :type '(choice string file)
207 :group 'muse-journal)
209 (defcustom muse-journal-rdf-date-format
210 "%Y-%m-%dT%H:%M:%S"
212 :type 'string
213 :group 'muse-journal)
215 (defcustom muse-journal-rdf-entry-template
216 " <item rdf:about=\"%link%#%anchor%\">
217 <title>%title%</title>
218 <description>
219 %desc%
220 </description>
221 <link>%link%#%anchor%</link>
222 <dc:date>%date%</dc:date>
223 <dc:creator>%maintainer%</dc:creator>
224 </item>\n"
226 :type 'string
227 :group 'muse-journal)
229 (defcustom muse-journal-rdf-summarize-entries t
230 "If non-nil, include only summaries in the RDF file, not the full data."
231 :type 'boolean
232 :group 'muse-journal)
234 (defcustom muse-journal-rss-extension ".xml"
236 :type 'string
237 :group 'muse-journal)
239 (defcustom muse-journal-rss-base-url ""
240 "The base URL of the website reference by the RSS file."
241 :type 'string
242 :group 'muse-journal)
244 (defcustom muse-journal-rss-header
245 "<\?xml version=\"1.0\" encoding=\"<lisp>
246 (muse-html-encoding)</lisp>\"?>
247 <rss version=\"2.0\">
248 <channel>
249 <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
250 <link><lisp>(concat (muse-style-element :base-url)
251 (concat (muse-page-name)
252 muse-html-extension))</lisp></link>
253 <description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
254 <language>en-us</language>
255 <generator>Emacs Muse</generator>"
257 :type '(choice string file)
258 :group 'muse-journal)
260 (defcustom muse-journal-rss-footer
261 " </channel>
262 </rss>\n"
264 :type '(choice string file)
265 :group 'muse-journal)
267 (defcustom muse-journal-rss-date-format
268 "%a, %d %b %Y %H:%M:%S %Z"
270 :type 'string
271 :group 'muse-journal)
273 (defcustom muse-journal-rss-entry-template
274 " <item>
275 <title>%title%</title>
276 <link>%link%#%anchor%</link>
277 <description>%desc%</description>
278 <author><lisp>(muse-publishing-directive \"author\")</lisp></author>
279 <pubDate>%date%</pubDate>
280 <guid>%link%#%anchor%</guid>
281 %enclosure%
282 </item>\n"
284 :type 'string
285 :group 'muse-journal)
287 (defcustom muse-journal-rss-enclosure-types-alist
288 '(("mp3" . "audio/mpeg"))
290 :type '(alist :key-type string :value-type string)
291 :group 'muse-journal)
293 (defcustom muse-journal-rss-summarize-entries nil
294 "If non-nil, include only summaries in the RSS file, not the full data."
295 :type 'boolean
296 :group 'muse-journal)
298 (defcustom muse-journal-rss-markup-regexps
299 '((10000 muse-link-regexp 0 "\\2"))
300 "List of markup rules for publishing a Muse journal page to RDF.
301 For more on the structure of this list, see `muse-publish-markup-regexps'."
302 :type '(repeat (choice
303 (list :tag "Markup rule"
304 integer
305 (choice regexp symbol)
306 integer
307 (choice string function symbol))
308 function))
309 :group 'muse-journal)
311 (defcustom muse-journal-rss-markup-functions
312 '((email . ignore)
313 (link . ignore)
314 (url . ignore))
315 "An alist of style types to custom functions for that kind of text.
316 For more on the structure of this list, see
317 `muse-publish-markup-functions'."
318 :type '(alist :key-type symbol :value-type function)
319 :group 'muse-journal)
321 (defun muse-journal-anchorize-title (title)
322 (save-match-data
323 (if (string-match "(" title)
324 (setq title (substring title 0 (match-beginning 0))))
325 (if (string-match "<[^>]+>" title)
326 (setq title (replace-match "" nil nil title)))
327 (downcase (muse-replace-regexp-in-string "[^a-zA-Z0-9_]" "" title))))
329 (defun muse-journal-sort-entries (&optional direction)
330 (interactive "P")
331 (sort-subr
332 direction
333 (function
334 (lambda ()
335 (if (re-search-forward "^\\* [0-9]+" nil t)
336 (goto-char (match-beginning 0))
337 (goto-char (point-max)))))
338 (function
339 (lambda ()
340 (if (re-search-forward "^\\* [0-9]+" nil t)
341 (goto-char (1- (match-beginning 0)))
342 (goto-char (point-max)))))
343 (function
344 (lambda ()
345 (forward-char 2)))
346 (function
347 (lambda ()
348 (end-of-line)))))
350 (defun muse-journal-html-munge-buffer ()
351 (goto-char (point-min))
352 (let ((heading-regexp muse-journal-html-heading-regexp)
353 (inhibit-read-only t))
354 (while (re-search-forward heading-regexp nil t)
355 (let* ((date (match-string 1))
356 (orig-date date)
357 (title (match-string 2))
358 (clean-title title)
359 datestamp qotd text)
360 (delete-region (match-beginning 0) (match-end 0))
361 (if clean-title
362 (save-match-data
363 (while (string-match "\\(^<[^>]+>\\|<[^>]+>$\\)" clean-title)
364 (setq clean-title (replace-match "" nil nil clean-title)))))
365 (save-match-data
366 (when (and date
367 (string-match
368 (concat "\\`\\([1-9][0-9][0-9][0-9]\\)[./]?"
369 "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
370 (setq datestamp
371 (encode-time
372 0 0 0
373 (string-to-number (match-string 3 date))
374 (string-to-number (match-string 2 date))
375 (string-to-number (match-string 1 date))
376 (current-time-zone))
377 date (concat (format-time-string
378 muse-journal-date-format datestamp)
379 (substring date (match-end 0))))))
380 (save-restriction
381 (narrow-to-region
382 (point) (if (re-search-forward
383 (concat "\\(^<hr>$\\|"
384 heading-regexp "\\)") nil t)
385 (match-beginning 0)
386 (point-max)))
387 (goto-char (point-max))
388 (while (and (not (bobp))
389 (eq ?\ (char-syntax (char-before))))
390 (delete-char -1))
391 (goto-char (point-min))
392 (while (and (not (eobp))
393 (eq ?\ (char-syntax (char-after))))
394 (delete-char 1))
395 (save-excursion
396 (when (search-forward "<qotd>" nil t)
397 (let ((tag-beg (match-beginning 0))
398 (beg (match-end 0)))
399 (re-search-forward "</qotd>\n*")
400 (setq qotd (buffer-substring-no-properties
401 beg (match-beginning 0)))
402 (delete-region tag-beg (match-end 0)))))
403 (setq text (buffer-string))
404 (delete-region (point-min) (point-max))
405 (let ((entry muse-journal-html-entry-template))
406 (while (string-match "%date%" entry)
407 (setq entry (replace-match (or date "") nil t entry)))
408 (while (string-match "%title%" entry)
409 (setq entry (replace-match (or title "&nbsp;") nil t entry)))
410 (while (string-match "%anchor%" entry)
411 (setq entry (replace-match
412 (muse-journal-anchorize-title
413 (or clean-title orig-date))
414 nil t entry)))
415 (while (string-match "%qotd%" entry)
416 (setq entry (replace-match (or qotd "") nil t entry)))
417 (while (string-match "%text%" entry)
418 (setq entry (replace-match text nil t entry)))
419 (insert entry)
420 (when (null qotd)
421 (goto-char (point-min))
422 (search-forward "<div id=\"entry-qotd\">")
423 (let ((beg (match-beginning 0)))
424 (re-search-forward "</div>\n*")
425 (delete-region beg (point))))))))))
427 (defun muse-journal-latex-munge-buffer ()
428 (goto-char (point-min))
429 (let ((heading-regexp
430 (concat "^" (regexp-quote (muse-markup-text 'section))
431 muse-journal-heading-regexp
432 (regexp-quote (muse-markup-text 'section-end)) "$"))
433 (inhibit-read-only t))
434 (when (re-search-forward heading-regexp nil t)
435 (goto-char (match-beginning 0))
436 (sort-subr nil
437 (function
438 (lambda ()
439 (if (re-search-forward heading-regexp nil t)
440 (goto-char (match-beginning 0))
441 (goto-char (point-max)))))
442 (function
443 (lambda ()
444 (if (re-search-forward heading-regexp nil t)
445 (goto-char (1- (match-beginning 0)))
446 (goto-char (point-max)))))
447 (function
448 (lambda ()
449 (forward-char 2)))
450 (function
451 (lambda ()
452 (end-of-line)))))
453 (while (re-search-forward heading-regexp nil t)
454 (let ((date (match-string 1))
455 (title (match-string 2))
456 ;; FIXME: Nothing is done with qotd
457 qotd section)
458 (save-match-data
459 (when (and date
460 (string-match
461 (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
462 "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
463 (setq date (encode-time
464 0 0 0
465 (string-to-number (match-string 3 date))
466 (string-to-number (match-string 2 date))
467 (string-to-number (match-string 1 date))
468 (current-time-zone))
469 date (format-time-string
470 muse-journal-date-format date))))
471 (save-match-data
472 (setq section muse-journal-latex-section)
473 (while (string-match "%title%" section)
474 (setq section (replace-match (or title "Untitled")
475 nil t section)))
476 (while (string-match "%date%" section)
477 (setq section (replace-match (or date "") nil t section))))
478 (replace-match section nil t))))
479 (goto-char (point-min))
480 (let ((subheading-regexp
481 (concat "^" (regexp-quote (muse-markup-text 'subsection))
482 "\\([^\n}]+\\)"
483 (regexp-quote (muse-markup-text 'subsection-end)) "$"))
484 (inhibit-read-only t))
485 (while (re-search-forward subheading-regexp nil t)
486 (let ((subsection muse-journal-latex-subsection))
487 (save-match-data
488 (let ((title (match-string 1)))
489 (while (string-match "%title%" subsection)
490 (setq subsection (replace-match title nil t subsection)))))
491 (replace-match subsection nil t)))))
493 (defun muse-journal-latex-qotd-tag (beg end)
494 (goto-char beg)
495 (insert (muse-markup-text 'begin-quote))
496 (goto-char end)
497 (insert (muse-markup-text 'end-quote)))
499 (defun muse-journal-rss-munge-buffer ()
500 (goto-char (point-min))
501 (let ((heading-regexp (concat "^\\* " muse-journal-heading-regexp "$"))
502 (inhibit-read-only t))
503 (while (re-search-forward heading-regexp nil t)
504 (let* ((date (match-string 1))
505 (orig-date date)
506 (title (match-string 2))
507 ;; FIXME: Nothing is done with qotd
508 enclosure qotd desc)
509 (if title
510 (save-match-data
511 (if (string-match muse-link-regexp title)
512 (setq enclosure (match-string 1 title)
513 title (match-string 2 title)))))
514 (save-match-data
515 (when (and date
516 (string-match
517 (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
518 "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
519 (setq date (encode-time 0 0 0
520 (string-to-number (match-string 3 date))
521 (string-to-number (match-string 2 date))
522 (string-to-number (match-string 1 date))
523 (current-time-zone))
524 date (format-time-string
525 (muse-style-element :date-format) date))))
526 (save-restriction
527 (narrow-to-region
528 (match-beginning 0)
529 (if (re-search-forward heading-regexp nil t)
530 (match-beginning 0)
531 (if (re-search-forward "^Footnotes:" nil t)
532 (match-beginning 0)
533 (point-max))))
534 (goto-char (point-min))
535 (delete-region (point) (muse-line-end-position))
536 (re-search-forward "</qotd>\n+" nil t)
537 (while (and (char-after)
538 (eq ?\ (char-syntax (char-after))))
539 (delete-char 1))
540 (let ((beg (point)))
541 (if (muse-style-element :summarize)
542 (progn
543 (forward-sentence 2)
544 (setq desc (concat (buffer-substring beg (point)) "...")))
545 (save-restriction
546 (muse-publish-markup-buffer "rss-entry" "html")
547 (goto-char (point-min))
548 (re-search-forward "Page published by Emacs Muse")
549 (goto-char (muse-line-end-position))
550 (setq beg (point))
551 (re-search-forward "Page published by Emacs Muse")
552 (goto-char (muse-line-beginning-position))
553 (setq desc (concat "<![CDATA[" (buffer-substring beg (point))
554 "]]>")))))
555 (delete-region (point-min) (point-max))
556 (let ((entry (muse-style-element :entry-template)))
557 (while (string-match "%date%" entry)
558 (setq entry (replace-match (or date "") nil t entry)))
559 (while (string-match "%title%" entry)
560 (setq entry (replace-match (or title "Untitled") nil t entry)))
561 (while (string-match "%desc%" entry)
562 (setq entry (replace-match desc nil t entry)))
563 (while (string-match "%enclosure%" entry)
564 (setq
565 entry
566 (replace-match
567 (if (null enclosure)
569 (save-match-data
570 (format
571 "<enclosure url=\"%s\" %stype=\"%s\"/>"
572 (if (string-match "//" enclosure)
573 enclosure
574 (concat (muse-style-element :base-url)
575 enclosure))
576 (let ((file
577 (expand-file-name enclosure
578 (muse-style-element :path))))
579 (if (file-readable-p file)
580 (format "length=\"%d\" "
581 (nth 7 (file-attributes file)))
582 ""))
583 (if (string-match "\\.\\([^.]+\\)$" enclosure)
584 (let* ((ext (match-string 1 enclosure))
585 (type
586 (assoc
587 ext muse-journal-rss-enclosure-types-alist)))
588 (if type
589 (cdr type)
590 "application/octet-stream"))))))
591 nil t entry)))
592 (while (string-match "%link%" entry)
593 (setq entry (replace-match
594 (concat (muse-style-element :base-url)
595 (concat (muse-page-name)
596 muse-html-extension))
597 nil t entry)))
598 (while (string-match "%anchor%" entry)
599 (setq entry (replace-match
600 (muse-journal-anchorize-title (or title orig-date))
601 nil t entry)))
602 (while (string-match "%maintainer%" entry)
603 (setq entry (replace-match
604 (or (muse-style-element :maintainer)
605 (concat "webmaster@" (system-name)))
606 nil t entry)))
607 (insert entry)))))
608 (unless (eobp)
609 (delete-region (point) (point-max)))))
611 (unless (assoc "journal-html" muse-publishing-styles)
612 (muse-derive-style "journal-html" "html"
613 :before-end 'muse-journal-html-munge-buffer)
615 (muse-derive-style "journal-xhtml" "xhtml"
616 :before-end 'muse-journal-html-munge-buffer)
618 (muse-derive-style "journal-latex" "latex"
619 :tags 'muse-journal-latex-markup-tags
620 :before-end 'muse-journal-latex-munge-buffer)
622 (muse-derive-style "journal-pdf" "pdf"
623 :tags 'muse-journal-latex-markup-tags
624 :before-end 'muse-journal-latex-munge-buffer)
626 (muse-derive-style "journal-book-latex" "book-latex"
627 ;;:nochapters
628 :tags 'muse-journal-latex-markup-tags
629 :before-end 'muse-journal-latex-munge-buffer)
631 (muse-derive-style "journal-book-pdf" "book-pdf"
632 ;;:nochapters
633 :tags 'muse-journal-latex-markup-tags
634 :before-end 'muse-journal-latex-munge-buffer)
636 (muse-define-style "journal-rdf"
637 :suffix 'muse-journal-rdf-extension
638 :regexps 'muse-journal-rss-markup-regexps
639 :functions 'muse-journal-rss-markup-functions
640 :before 'muse-journal-rss-munge-buffer
641 :header 'muse-journal-rdf-header
642 :footer 'muse-journal-rdf-footer
643 :date-format 'muse-journal-rdf-date-format
644 :entry-template 'muse-journal-rdf-entry-template
645 :base-url 'muse-journal-rdf-base-url
646 :summarize 'muse-journal-rdf-summarize-entries)
648 (muse-define-style "journal-rss"
649 :suffix 'muse-journal-rss-extension
650 :regexps 'muse-journal-rss-markup-regexps
651 :functions 'muse-journal-rss-markup-functions
652 :before 'muse-journal-rss-munge-buffer
653 :header 'muse-journal-rss-header
654 :footer 'muse-journal-rss-footer
655 :date-format 'muse-journal-rss-date-format
656 :entry-template 'muse-journal-rss-entry-template
657 :base-url 'muse-journal-rss-base-url
658 :summarize 'muse-journal-rss-summarize-entries))
660 (provide 'muse-journal)
662 ;;; muse-journal.el ends here