;;; muse-journal.el --- keep and publish a journal
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 3, or (at your
;; option) any later version.
;; Emacs Muse is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; The module facilitates the keeping and publication of a journal.
;; When publishing to HTML, it assumes the form of a web log, or blog.
;;
;; The input format for each entry is as follows:
;;
;; * 20040317: Title of entry
;;
;; Text for the entry.
;;
;;
;; "You know who you are. It comes down to a simple gut check: You
;; either love what you do or you don't. Period." -- P. Bronson
;;
;;
;; The "qotd", or Quote of the Day, is entirely optional. When
;; generated to HTML, this entry is rendered as:
;;
;;
;;
;;
Quote of the Day:
;;
"You know who you are. It comes down to a simple gut
;; check: You either love what you do or you don't. Period."
;; -- P. Bronson
$")
"A regexp that matches a journal heading from an HTML document.
Paren group 1 is the ISO date, group 2 is the optional category,
and group 3 is the optional heading for the entry."
:type 'regexp
:group 'muse-journal)
(defcustom muse-journal-rss-heading-regexp
(concat "^\\* " muse-journal-heading-regexp "$")
"A regexp that matches a journal heading from an HTML document.
Paren group 1 is the ISO date, group 2 is the optional category,
and group 3 is the optional heading for the entry."
:type 'regexp
:group 'muse-journal)
(defcustom muse-journal-html-entry-template
"
%date%
%title%
%qotd%
%text%
\n\n"
"Template used to publish individual journal entries as HTML.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-latex-section
"\\section*{%title% \\hfill {\\normalsize %date%}}
\\addcontentsline{toc}{chapter}{%title%}"
"Template used to publish a LaTeX section."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-latex-subsection
"\\subsection*{%title%}
\\addcontentsline{toc}{section}{%title%}"
"Template used to publish a LaTeX subsection."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-markup-tags
'(("qotd" t nil nil muse-journal-qotd-tag))
"A list of tag specifications, for specially marking up Journal entries.
See `muse-publish-markup-tags' for more info.
This is used by journal-latex and its related styles, as well as
the journal-rss-entry style, which both journal-rdf and
journal-rss use."
:type '(repeat (list (string :tag "Markup tag")
(boolean :tag "Expect closing tag" :value t)
(boolean :tag "Parse attributes" :value nil)
(boolean :tag "Nestable" :value nil)
function))
:group 'muse-journal)
;; FIXME: This doesn't appear to be used.
(defun muse-journal-generate-pages ()
(let ((output-dir (muse-style-element :path)))
(goto-char (point-min))
(while (re-search-forward muse-journal-heading-regexp nil t)
(let* ((date (match-string 1))
(category (match-string 1))
(category-file (concat output-dir category "/index.html"))
(heading (match-string 1)))
t))))
(defcustom muse-journal-rdf-extension ".rdf"
"Default file extension for publishing RDF (RSS 1.0) files."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-base-url ""
"The base URL of the website referenced by the RDF file."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-header
"(concat (muse-style-element :base-url)
(muse-publish-link-name))\">
(muse-publishing-directive \"title\")(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))(muse-publishing-directive \"desc\")
(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))\"/>
\n"
"Header used for publishing RDF (RSS 1.0) files.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-footer
"\n"
"Footer used for publishing RDF (RSS 1.0) files.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-date-format
"%Y-%m-%dT%H:%M:%S"
"Date format to use for RDF entries."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-entry-template
"\n %title%
%desc%
%link%#%anchor%
%date%%maintainer%\n"
"Template used to publish individual journal entries as RDF.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-summarize-entries nil
"If non-nil, include only summaries in the RDF file, not the full data.
The default is nil, because this annoys some subscribers."
:type 'boolean
:group 'muse-journal)
(defcustom muse-journal-rss-extension ".xml"
"Default file extension for publishing RSS 2.0 files."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-base-url ""
"The base URL of the website referenced by the RSS file."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-header
"<\?xml version=\"1.0\" encoding=\"
(muse-html-encoding)\"?>
(muse-publishing-directive \"title\")(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))(muse-publishing-directive \"desc\")en-usEmacs Muse\n\n"
"Header used for publishing RSS 2.0 files. This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-footer
"\n\n \n"
"Footer used for publishing RSS 2.0 files. This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-date-format
"%a, %d %b %Y %H:%M:%S %Z"
"Date format to use for RSS 2.0 entries."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-entry-template
"\n %title%
%link%#%anchor%
%desc%(muse-publishing-directive \"author\")%date%%link%#%anchor%
%enclosure%
\n"
"Template used to publish individual journal entries as RSS 2.0.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-enclosure-types-alist
'(("mp3" . "audio/mpeg"))
"File types that are accepted as RSS enclosures.
This is an alist that maps file extension to content type.
Useful for podcasting."
:type '(alist :key-type string :value-type string)
:group 'muse-journal)
(defcustom muse-journal-rss-summarize-entries nil
"If non-nil, include only summaries in the RSS file, not the full data.
The default is nil, because this annoys some subscribers."
:type 'boolean
:group 'muse-journal)
(defcustom muse-journal-rss-markup-regexps
'((10000 muse-explicit-link-regexp 0 "\\2"))
"List of markup rules for publishing a Muse journal page to RSS 2.0.
For more information on the structure of this list, see
`muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-journal)
(defcustom muse-journal-rss-markup-functions
'((email . ignore)
(link . ignore)
(url . ignore))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-journal)
(defun muse-journal-anchorize-title (title)
"This strips tags from TITLE, truncates TITLE at begin parenthesis,
and escapes any remaining non-alphanumeric characters."
(save-match-data
(if (string-match "(" title)
(setq title (substring title 0 (match-beginning 0))))
(if (string-match "<[^>]+>" title)
(setq title (replace-match "" nil nil title)))
(let (pos code len ch)
(while (setq pos (string-match (concat "[^" muse-regexp-alnum "_]")
title pos))
(setq ch (aref title pos)
code (format "%%%02X" (cond ((fboundp 'char-to-ucs)
(char-to-ucs ch))
((fboundp 'char-to-int)
(char-to-int ch))
(t ch)))
len (length code)
title (concat (substring title 0 pos)
code
(when (< pos (length title))
(substring title (1+ pos) nil)))
pos (+ len pos)))
title)))
(defun muse-journal-sort-entries (&optional direction)
(interactive "P")
(sort-subr
direction
(function
(lambda ()
(if (re-search-forward "^\\* [0-9]+" nil t)
(goto-char (match-beginning 0))
(goto-char (point-max)))))
(function
(lambda ()
(if (re-search-forward "^\\* [0-9]+" nil t)
(goto-char (1- (match-beginning 0)))
(goto-char (point-max)))))
(function
(lambda ()
(forward-char 2)))
(function
(lambda ()
(end-of-line)))))
(defun muse-journal-qotd-tag (beg end)
(muse-publish-ensure-block beg end)
(muse-insert-markup (muse-markup-text 'begin-quote))
(muse-insert-markup (muse-markup-text 'begin-quote-item))
(goto-char end)
(muse-insert-markup (muse-markup-text 'end-quote-item))
(muse-insert-markup (muse-markup-text 'end-quote)))
(defun muse-journal-html-munge-buffer ()
(goto-char (point-min))
(let ((heading-regexp muse-journal-html-heading-regexp)
(inhibit-read-only t))
(while (re-search-forward heading-regexp nil t)
(let* ((date (match-string 1))
(orig-date date)
(title (match-string 2))
(clean-title title)
datestamp qotd text)
(delete-region (match-beginning 0) (match-end 0))
(if clean-title
(save-match-data
(while (string-match "\\(^<[^>]+>\\|<[^>]+>$\\)" clean-title)
(setq clean-title (replace-match "" nil nil clean-title)))))
(save-match-data
(when (and date
(string-match
(concat "\\`\\([1-9][0-9][0-9][0-9]\\)[./]?"
"\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
(setq datestamp
(encode-time
0 0 0
(string-to-number (match-string 3 date))
(string-to-number (match-string 2 date))
(string-to-number (match-string 1 date))
nil)
date (concat (format-time-string
muse-journal-date-format datestamp)
(substring date (match-end 0))))))
(save-restriction
(narrow-to-region
(point) (if (re-search-forward
(concat "\\(^$\\|"
heading-regexp "\\)") nil t)
(match-beginning 0)
(point-max)))
(goto-char (point-max))
(while (and (not (bobp))
(eq ?\ (char-syntax (char-before))))
(delete-char -1))
(goto-char (point-min))
(while (and (not (eobp))
(eq ?\ (char-syntax (char-after))))
(delete-char 1))
(save-excursion
(when (search-forward "" nil t)
(let ((tag-beg (match-beginning 0))
(beg (match-end 0))
end)
(re-search-forward "\n*")
(setq end (point-marker))
(save-restriction
(narrow-to-region beg (match-beginning 0))
(muse-publish-escape-specials (point-min) (point-max)
nil 'document)
(setq qotd (buffer-substring-no-properties
(point-min) (point-max))))
(delete-region tag-beg end)
(set-marker end nil))))
(setq text (buffer-string))
(delete-region (point-min) (point-max))
(let ((entry muse-journal-html-entry-template))
(muse-insert-file-or-string entry)
(muse-publish-mark-read-only (point-min) (point-max))
(goto-char (point-min))
(while (search-forward "%date%" nil t)
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(replace-match (or date "") nil t))
(goto-char (point-min))
(while (search-forward "%title%" nil t)
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(replace-match (or title " ") nil t))
(goto-char (point-min))
(while (search-forward "%anchor%" nil t)
(replace-match (muse-journal-anchorize-title
(or clean-title orig-date))
nil t))
(goto-char (point-min))
(while (search-forward "%qotd%" nil t)
(save-restriction
(narrow-to-region (match-beginning 0) (match-end 0))
(delete-region (point-min) (point-max))
(when qotd (muse-insert-markup qotd))))
(goto-char (point-min))
(while (search-forward "%text%" nil t)
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(replace-match text nil t))
(when (null qotd)
(goto-char (point-min))
(when (search-forward "