lisp/muse-journal.el

   1 ;;; muse-journal.el --- keep and publish a journal
   2
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008  Free Software Foundation, Inc.
   4
   5 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
   6
   7 ;; Emacs Muse is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published
   9 ;; by the Free Software Foundation; either version 3, or (at your
  10 ;; option) any later version.
  11
  12 ;; Emacs Muse is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with Emacs Muse; 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.
  21
  22 ;;; Commentary:
  23
  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.
  26 ;;
  27 ;; The input format for each entry is as follows:
  28 ;;
  29 ;;   * 20040317: Title of entry
  30 ;;
  31 ;;   Text for the entry.
  32 ;;
  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>
  37 ;;
  38 ;; The "qotd", or Quote of the Day, is entirely optional.  When
  39 ;; generated to HTML, this entry is rendered as:
  40 ;;
  41 ;;   <div class="entry">
  42 ;;     <div class="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 class="entry-body">
  49 ;;       <div class="entry-head">
  50 ;;         <div class="entry-date">
  51 ;;           <span class="date">March 17, 2004</span>
  52 ;;         </div>
  53 ;;         <div class="entry-title">
  54 ;;           <h2>Title of entry</h2>
  55 ;;         </div>
  56 ;;       </div>
  57 ;;       <div class="entry-text">
  58 ;;         <p>Text for the entry.</p>
  59 ;;       </div>
  60 ;;     </div>
  61 ;;   </div>
  62 ;;
  63 ;; The plurality of "div" tags makes it possible to display the
  64 ;; entries in any form you wish, using a CSS style.
  65 ;;
  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.
  70
  71 ;;; Contributors:
  72
  73 ;; René Stadler (mail AT renestadler DOT de) provided a patch that
  74 ;; causes dates in RSS feeds to be generated in a format that RSS
  75 ;; readers can parse.
  76
  77 ;;; Code:
  78
  79 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  80 ;;
  81 ;; Muse Journal Publishing
  82 ;;
  83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  84
  85 (require 'muse-publish)
  86 (require 'muse-html)
  87 (require 'muse-latex)
  88 (require 'muse-book)
  89
  90 (defgroup muse-journal nil
  91   "Rules for transforming a journal into its final form."
  92   :group 'muse-publish)
  93
  94 (defcustom muse-journal-heading-regexp
  95   "\\(?:\\([0-9]+\\)\\(?:: \\)?\\)?\\(.+?\\)?"
  96   "A regexp that matches a journal heading.
  97 Paren group 1 is the ISO date, group 2 is the optional category,
  98 and group 3 is the optional heading for the entry."
  99   :type 'regexp
 100   :group 'muse-journal)
 101
 102 (defcustom muse-journal-date-format "%a, %e %b %Y"
 103   "Date format to use for journal entries."
 104   :type 'string
 105   :group 'muse-journal)
 106
 107 (defcustom muse-journal-html-heading-regexp
 108   (concat "^<h2[^>\n]*>" muse-journal-heading-regexp "</h2>$")
 109   "A regexp that matches a journal heading from an HTML document.
 110 Paren group 1 is the ISO date, group 2 is the optional category,
 111 and group 3 is the optional heading for the entry."
 112   :type 'regexp
 113   :group 'muse-journal)
 114
 115 (defcustom muse-journal-rss-heading-regexp
 116   (concat "^\\* " muse-journal-heading-regexp "$")
 117   "A regexp that matches a journal heading from an HTML document.
 118 Paren group 1 is the ISO date, group 2 is the optional category,
 119 and group 3 is the optional heading for the entry."
 120   :type 'regexp
 121   :group 'muse-journal)
 122
 123 (defcustom muse-journal-html-entry-template
 124   "<div class=\"entry\">
 125   <a name=\"%anchor%\" style=\"text-decoration: none\">&nbsp;</a>
 126   <div class=\"entry-body\">
 127     <div class=\"entry-head\">
 128       <div class=\"entry-date\">
 129         <span class=\"date\">%date%</span>
 130       </div>
 131       <div class=\"entry-title\">
 132         <h2>%title%</h2>
 133       </div>
 134     </div>
 135     <div class=\"entry-text\">
 136       <div class=\"entry-qotd\">
 137         <p>%qotd%</p>
 138       </div>
 139 %text%
 140     </div>
 141   </div>
 142 </div>\n\n"
 143   "Template used to publish individual journal entries as HTML.
 144 This may be text or a filename."
 145   :type 'string
 146   :group 'muse-journal)
 147
 148 (defcustom muse-journal-latex-section
 149   "\\section*{%title% \\hfill {\\normalsize %date%}}
 150 \\addcontentsline{toc}{chapter}{%title%}"
 151   "Template used to publish a LaTeX section."
 152   :type 'string
 153   :group 'muse-journal)
 154
 155 (defcustom muse-journal-latex-subsection
 156   "\\subsection*{%title%}
 157 \\addcontentsline{toc}{section}{%title%}"
 158   "Template used to publish a LaTeX subsection."
 159   :type 'string
 160   :group 'muse-journal)
 161
 162 (defcustom muse-journal-markup-tags
 163   '(("qotd" t nil nil muse-journal-qotd-tag))
 164   "A list of tag specifications, for specially marking up Journal entries.
 165 See `muse-publish-markup-tags' for more info.
 166
 167 This is used by journal-latex and its related styles, as well as
 168 the journal-rss-entry style, which both journal-rdf and
 169 journal-rss use."
 170   :type '(repeat (list (string :tag "Markup tag")
 171                        (boolean :tag "Expect closing tag" :value t)
 172                        (boolean :tag "Parse attributes" :value nil)
 173                        (boolean :tag "Nestable" :value nil)
 174                        function))
 175   :group 'muse-journal)
 176
 177 ;; FIXME: This doesn't appear to be used.
 178 (defun muse-journal-generate-pages ()
 179   (let ((output-dir (muse-style-element :path)))
 180     (goto-char (point-min))
 181     (while (re-search-forward muse-journal-heading-regexp nil t)
 182       (let* ((date (match-string 1))
 183              (category (match-string 1))
 184              (category-file (concat output-dir category "/index.html"))
 185              (heading (match-string 1)))
 186         t))))
 187
 188 (defcustom muse-journal-rdf-extension ".rdf"
 189   "Default file extension for publishing RDF (RSS 1.0) files."
 190   :type 'string
 191   :group 'muse-journal)
 192
 193 (defcustom muse-journal-rdf-base-url ""
 194   "The base URL of the website referenced by the RDF file."
 195   :type 'string
 196   :group 'muse-journal)
 197
 198 (defcustom muse-journal-rdf-header
 199   "<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
 200          xmlns=\"http://purl.org/rss/1.0/\"
 201          xmlns:dc=\"http://purl.org/dc/elements/1.1/\">
 202   <channel rdf:about=\"<lisp>(concat (muse-style-element :base-url)
 203                                      (muse-publish-link-name))</lisp>\">
 204     <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
 205     <link><lisp>(concat (muse-style-element :base-url)
 206                        (concat (muse-page-name)
 207                                muse-html-extension))</lisp></link>
 208     <description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
 209     <items>
 210       <rdf:Seq>
 211         <rdf:li resource=\"<lisp>
 212           (concat (muse-style-element :base-url)
 213                   (concat (muse-page-name)
 214                           muse-html-extension))</lisp>\"/>
 215       </rdf:Seq>
 216     </items>
 217   </channel>\n"
 218   "Header used for publishing RDF (RSS 1.0) files.
 219 This may be text or a filename."
 220   :type 'string
 221   :group 'muse-journal)
 222
 223 (defcustom muse-journal-rdf-footer
 224   "</rdf:RDF>\n"
 225   "Footer used for publishing RDF (RSS 1.0) files.
 226 This may be text or a filename."
 227   :type 'string
 228   :group 'muse-journal)
 229
 230 (defcustom muse-journal-rdf-date-format
 231   "%Y-%m-%dT%H:%M:%S"
 232   "Date format to use for RDF entries."
 233   :type 'string
 234   :group 'muse-journal)
 235
 236 (defcustom muse-journal-rdf-entry-template
 237   "\n  <item rdf:about=\"%link%#%anchor%\">
 238     <title>%title%</title>
 239     <description>
 240       %desc%
 241     </description>
 242     <link>%link%#%anchor%</link>
 243     <dc:date>%date%</dc:date>
 244     <dc:creator>%maintainer%</dc:creator>
 245   </item>\n"
 246   "Template used to publish individual journal entries as RDF.
 247 This may be text or a filename."
 248   :type 'string
 249   :group 'muse-journal)
 250
 251 (defcustom muse-journal-rdf-summarize-entries nil
 252   "If non-nil, include only summaries in the RDF file, not the full data.
 253
 254 The default is nil, because this annoys some subscribers."
 255   :type 'boolean
 256   :group 'muse-journal)
 257
 258 (defcustom muse-journal-rss-extension ".xml"
 259   "Default file extension for publishing RSS 2.0 files."
 260   :type 'string
 261   :group 'muse-journal)
 262
 263 (defcustom muse-journal-rss-base-url ""
 264   "The base URL of the website referenced by the RSS file."
 265   :type 'string
 266   :group 'muse-journal)
 267
 268 (defcustom muse-journal-rss-header
 269   "<\?xml version=\"1.0\" encoding=\"<lisp>
 270   (muse-html-encoding)</lisp>\"?>
 271 <rss version=\"2.0\">
 272   <channel>
 273     <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
 274     <link><lisp>(concat (muse-style-element :base-url)
 275                         (concat (muse-page-name)
 276                                 muse-html-extension))</lisp></link>
 277     <description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
 278     <language>en-us</language>
 279     <generator>Emacs Muse</generator>\n\n"
 280   "Header used for publishing RSS 2.0 files.  This may be text or a filename."
 281   :type 'string
 282   :group 'muse-journal)
 283
 284 (defcustom muse-journal-rss-footer
 285   "\n\n  </channel>
 286 </rss>\n"
 287   "Footer used for publishing RSS 2.0 files.  This may be text or a filename."
 288   :type 'string
 289   :group 'muse-journal)
 290
 291 (defcustom muse-journal-rss-date-format
 292   "%a, %d %b %Y %H:%M:%S %Z"
 293   "Date format to use for RSS 2.0 entries."
 294   :type 'string
 295   :group 'muse-journal)
 296
 297 (defcustom muse-journal-rss-entry-template
 298   "\n    <item>
 299       <title>%title%</title>
 300       <link>%link%#%anchor%</link>
 301       <description>%desc%</description>
 302       <author><lisp>(muse-publishing-directive \"author\")</lisp></author>
 303       <pubDate>%date%</pubDate>
 304       <guid>%link%#%anchor%</guid>
 305       %enclosure%
 306     </item>\n"
 307   "Template used to publish individual journal entries as RSS 2.0.
 308 This may be text or a filename."
 309   :type 'string
 310   :group 'muse-journal)
 311
 312 (defcustom muse-journal-rss-enclosure-types-alist
 313   '(("mp3" . "audio/mpeg"))
 314   "File types that are accepted as RSS enclosures.
 315 This is an alist that maps file extension to content type.
 316 Useful for podcasting."
 317   :type '(alist :key-type string :value-type string)
 318   :group 'muse-journal)
 319
 320 (defcustom muse-journal-rss-summarize-entries nil
 321   "If non-nil, include only summaries in the RSS file, not the full data.
 322
 323 The default is nil, because this annoys some subscribers."
 324   :type 'boolean
 325   :group 'muse-journal)
 326
 327 (defcustom muse-journal-rss-markup-regexps
 328   '((10000 muse-explicit-link-regexp 0 "\\2"))
 329   "List of markup rules for publishing a Muse journal page to RSS 2.0.
 330 For more information on the structure of this list, see
 331 `muse-publish-markup-regexps'."
 332   :type '(repeat (choice
 333                   (list :tag "Markup rule"
 334                         integer
 335                         (choice regexp symbol)
 336                         integer
 337                         (choice string function symbol))
 338                   function))
 339   :group 'muse-journal)
 340
 341 (defcustom muse-journal-rss-markup-functions
 342   '((email . ignore)
 343     (link  . ignore)
 344     (url   . ignore))
 345   "An alist of style types to custom functions for that kind of text.
 346 For more on the structure of this list, see
 347 `muse-publish-markup-functions'."
 348   :type '(alist :key-type symbol :value-type function)
 349   :group 'muse-journal)
 350
 351 (defun muse-journal-anchorize-title (title)
 352   "This strips tags from TITLE, truncates TITLE at begin parenthesis,
 353 and escapes any remaining non-alphanumeric characters."
 354   (save-match-data
 355     (if (string-match "(" title)
 356         (setq title (substring title 0 (match-beginning 0))))
 357     (if (string-match "<[^>]+>" title)
 358         (setq title (replace-match "" nil nil title)))
 359     (let (pos code len ch)
 360       (while (setq pos (string-match (concat "[^" muse-regexp-alnum "_]")
 361                                      title pos))
 362           (setq ch (aref title pos)
 363                 code (format "%%%02X" (cond ((fboundp 'char-to-ucs)
 364                                              (char-to-ucs ch))
 365                                             ((fboundp 'char-to-int)
 366                                              (char-to-int ch))
 367                                             (t ch)))
 368                 len (length code)
 369                 title (concat (substring title 0 pos)
 370                               code
 371                               (when (< pos (length title))
 372                                 (substring title (1+ pos) nil)))
 373                 pos (+ len pos)))
 374         title)))
 375
 376 (defun muse-journal-sort-entries (&optional direction)
 377   (interactive "P")
 378   (sort-subr
 379    direction
 380    (function
 381     (lambda ()
 382       (if (re-search-forward "^\\* [0-9]+" nil t)
 383           (goto-char (match-beginning 0))
 384         (goto-char (point-max)))))
 385    (function
 386     (lambda ()
 387       (if (re-search-forward "^\\* [0-9]+" nil t)
 388           (goto-char (1- (match-beginning 0)))
 389         (goto-char (point-max)))))
 390    (function
 391     (lambda ()
 392       (forward-char 2)))
 393    (function
 394     (lambda ()
 395       (end-of-line)))))
 396
 397 (defun muse-journal-qotd-tag (beg end)
 398   (muse-publish-ensure-block beg end)
 399   (muse-insert-markup (muse-markup-text 'begin-quote))
 400   (muse-insert-markup (muse-markup-text 'begin-quote-item))
 401   (goto-char end)
 402   (muse-insert-markup (muse-markup-text 'end-quote-item))
 403   (muse-insert-markup (muse-markup-text 'end-quote)))
 404
 405 (defun muse-journal-html-munge-buffer ()
 406   (goto-char (point-min))
 407   (let ((heading-regexp muse-journal-html-heading-regexp)
 408         (inhibit-read-only t))
 409     (while (re-search-forward heading-regexp nil t)
 410       (let* ((date (match-string 1))
 411              (orig-date date)
 412              (title (match-string 2))
 413              (clean-title title)
 414              datestamp qotd text)
 415         (delete-region (match-beginning 0) (match-end 0))
 416         (if clean-title
 417             (save-match-data
 418               (while (string-match "\\(^<[^>]+>\\|<[^>]+>$\\)" clean-title)
 419                 (setq clean-title (replace-match "" nil nil clean-title)))))
 420         (save-match-data
 421           (when (and date
 422                      (string-match
 423                       (concat "\\`\\([1-9][0-9][0-9][0-9]\\)[./]?"
 424                               "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
 425             (setq datestamp
 426                   (encode-time
 427                    0 0 0
 428                    (string-to-number (match-string 3 date))
 429                    (string-to-number (match-string 2 date))
 430                    (string-to-number (match-string 1 date))
 431                    (current-time-zone))
 432                   date (concat (format-time-string
 433                                 muse-journal-date-format datestamp)
 434                                (substring date (match-end 0))))))
 435         (save-restriction
 436           (narrow-to-region
 437            (point) (if (re-search-forward
 438                         (concat "\\(^<hr>$\\|"
 439                                 heading-regexp "\\)") nil t)
 440                        (match-beginning 0)
 441                      (point-max)))
 442           (goto-char (point-max))
 443           (while (and (not (bobp))
 444                       (eq ?\  (char-syntax (char-before))))
 445             (delete-char -1))
 446           (goto-char (point-min))
 447           (while (and (not (eobp))
 448                       (eq ?\  (char-syntax (char-after))))
 449             (delete-char 1))
 450           (save-excursion
 451             (when (search-forward "<qotd>" nil t)
 452               (let ((tag-beg (match-beginning 0))
 453                     (beg (match-end 0))
 454                     end)
 455                 (re-search-forward "</qotd>\n*")
 456                 (setq end (point-marker))
 457                 (save-restriction
 458                   (narrow-to-region beg (match-beginning 0))
 459                   (muse-publish-escape-specials (point-min) (point-max)
 460                                                 nil 'document)
 461                   (setq qotd (buffer-substring-no-properties
 462                               (point-min) (point-max))))
 463                 (delete-region tag-beg end)
 464                 (set-marker end nil))))
 465           (setq text (buffer-string))
 466           (delete-region (point-min) (point-max))
 467           (let ((entry muse-journal-html-entry-template))
 468             (muse-insert-file-or-string entry)
 469             (muse-publish-mark-read-only (point-min) (point-max))
 470             (goto-char (point-min))
 471             (while (search-forward "%date%" nil t)
 472               (remove-text-properties (match-beginning 0) (match-end 0)
 473                                       '(read-only nil rear-nonsticky nil))
 474               (replace-match (or date "") nil t))
 475             (goto-char (point-min))
 476             (while (search-forward "%title%" nil t)
 477               (remove-text-properties (match-beginning 0) (match-end 0)
 478                                       '(read-only nil rear-nonsticky nil))
 479               (replace-match (or title "&nbsp;") nil t))
 480             (goto-char (point-min))
 481             (while (search-forward "%anchor%" nil t)
 482               (replace-match (muse-journal-anchorize-title
 483                               (or clean-title orig-date))
 484                              nil t))
 485             (goto-char (point-min))
 486             (while (search-forward "%qotd%" nil t)
 487               (save-restriction
 488                 (narrow-to-region (match-beginning 0) (match-end 0))
 489                 (delete-region (point-min) (point-max))
 490                 (when qotd (muse-insert-markup qotd))))
 491             (goto-char (point-min))
 492             (while (search-forward "%text%" nil t)
 493               (remove-text-properties (match-beginning 0) (match-end 0)
 494                                       '(read-only nil rear-nonsticky nil))
 495               (replace-match text nil t))
 496             (when (null qotd)
 497               (goto-char (point-min))
 498               (when (search-forward "<div class=\"entry-qotd\">" nil t)
 499                 (let ((beg (match-beginning 0)))
 500                   (re-search-forward "</div>\n*" nil t)
 501                   (delete-region beg (point))))))))))
 502   ;; indicate that we are to continue the :before-end processing
 503   nil)
 504
 505 (defun muse-journal-latex-munge-buffer ()
 506   (goto-char (point-min))
 507   (let ((heading-regexp
 508          (concat "^" (regexp-quote (muse-markup-text 'section))
 509                  muse-journal-heading-regexp
 510                  (regexp-quote (muse-markup-text 'section-end)) "$"))
 511         (inhibit-read-only t))
 512     (when (re-search-forward heading-regexp nil t)
 513       (goto-char (match-beginning 0))
 514       (sort-subr nil
 515                  (function
 516                   (lambda ()
 517                     (if (re-search-forward heading-regexp nil t)
 518                         (goto-char (match-beginning 0))
 519                       (goto-char (point-max)))))
 520                  (function
 521                   (lambda ()
 522                     (if (re-search-forward heading-regexp nil t)
 523                         (goto-char (1- (match-beginning 0)))
 524                       (goto-char (point-max)))))
 525                  (function
 526                   (lambda ()
 527                     (forward-char 2)))
 528                  (function
 529                   (lambda ()
 530                     (end-of-line)))))
 531     (while (re-search-forward heading-regexp nil t)
 532       (let ((date (match-string 1))
 533             (title (match-string 2))
 534             ;; FIXME: Nothing is done with qotd
 535             qotd section)
 536         (save-match-data
 537           (when (and date
 538                      (string-match
 539                       (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
 540                               "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
 541             (setq date (encode-time
 542                         0 0 0
 543                         (string-to-number (match-string 3 date))
 544                         (string-to-number (match-string 2 date))
 545                         (string-to-number (match-string 1 date))
 546                         (current-time-zone))
 547                   date (format-time-string
 548                         muse-journal-date-format date))))
 549         (save-restriction
 550           (narrow-to-region (match-beginning 0) (match-end 0))
 551           (delete-region (point-min) (point-max))
 552           (muse-insert-markup muse-journal-latex-section)
 553           (goto-char (point-min))
 554           (while (search-forward "%title%" nil t)
 555             (replace-match (or title "Untitled") nil t))
 556           (goto-char (point-min))
 557           (while (search-forward "%date%" nil t)
 558             (replace-match (or date "") nil t))))))
 559   (goto-char (point-min))
 560   (let ((subheading-regexp
 561          (concat "^" (regexp-quote (muse-markup-text 'subsection))
 562                  "\\([^\n}]+\\)"
 563                  (regexp-quote (muse-markup-text 'subsection-end)) "$"))
 564         (inhibit-read-only t))
 565     (while (re-search-forward subheading-regexp nil t)
 566       (let ((title (match-string 1)))
 567         (save-restriction
 568           (narrow-to-region (match-beginning 0) (match-end 0))
 569           (delete-region (point-min) (point-max))
 570           (muse-insert-markup muse-journal-latex-subsection)
 571           (goto-char (point-min))
 572           (while (search-forward "%title%" nil t)
 573             (replace-match title nil t))))))
 574   ;; indicate that we are to continue the :before-end processing
 575   nil)
 576
 577 (defun muse-journal-rss-munge-buffer ()
 578   (goto-char (point-min))
 579   (let ((heading-regexp muse-journal-rss-heading-regexp)
 580         (inhibit-read-only t))
 581     (while (re-search-forward heading-regexp nil t)
 582       (let* ((date (match-string 1))
 583              (orig-date date)
 584              (title (match-string 2))
 585              ;; FIXME: Nothing is done with qotd
 586              enclosure qotd desc)
 587         (if title
 588             (save-match-data
 589               (if (string-match muse-explicit-link-regexp title)
 590                   (setq enclosure (muse-get-link title)
 591                         title (muse-get-link-desc title)))))
 592         (save-match-data
 593           (when (and date
 594                      (string-match
 595                       (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
 596                               "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
 597             (setq date (encode-time 0 0 0
 598                                     (string-to-number (match-string 3 date))
 599                                     (string-to-number (match-string 2 date))
 600                                     (string-to-number (match-string 1 date))
 601                                     (current-time-zone))
 602                   ;; make sure that date is in a format that RSS
 603                   ;; readers can handle
 604                   date (let ((system-time-locale "C"))
 605                          (format-time-string
 606                           (muse-style-element :date-format) date)))))
 607         (save-restriction
 608           (narrow-to-region
 609            (match-beginning 0)
 610            (if (re-search-forward heading-regexp nil t)
 611                (match-beginning 0)
 612              (if (re-search-forward "^Footnotes:" nil t)
 613                  (match-beginning 0)
 614                (point-max))))
 615           (goto-char (point-min))
 616           (delete-region (point) (muse-line-end-position))
 617           (re-search-forward "</qotd>\n+" nil t)
 618           (while (and (char-after)
 619                       (eq ?\  (char-syntax (char-after))))
 620             (delete-char 1))
 621           (let ((beg (point)))
 622             (if (muse-style-element :summarize)
 623                 (progn
 624                   (forward-sentence 2)
 625                   (setq desc (concat (buffer-substring beg (point)) "...")))
 626               (save-restriction
 627                 (muse-publish-markup-buffer "rss-entry" "journal-rss-entry")
 628                 (goto-char (point-min))
 629                 (if (re-search-forward "Page published by Emacs Muse" nil t)
 630                     (goto-char (muse-line-end-position))
 631                   (muse-display-warning
 632                    (concat
 633                     "Cannot find 'Page published by Emacs Muse begins here'.\n"
 634                     "You will probably need this text in your header."))
 635                   (goto-char (point-min)))
 636                 (setq beg (point))
 637                 (if (re-search-forward "Page published by Emacs Muse" nil t)
 638                     (goto-char (muse-line-beginning-position))
 639                   (muse-display-warning
 640                    (concat
 641                     "Cannot find 'Page published by Emacs Muse ends here'.\n"
 642                     "You will probably need this text in your footer."))
 643                   (goto-char (point-max)))
 644                 (setq desc (buffer-substring beg (point))))))
 645           (unless (string= desc "")
 646             (setq desc (concat "<![CDATA[" desc "]]>")))
 647           (delete-region (point-min) (point-max))
 648           (let ((entry (muse-style-element :entry-template)))
 649             (muse-insert-file-or-string entry)
 650             (goto-char (point-min))
 651             (while (search-forward "%date%" nil t)
 652               (replace-match (or date "") nil t))
 653             (goto-char (point-min))
 654             (while (search-forward "%title%" nil t)
 655               (replace-match "")
 656               (save-restriction
 657                 (narrow-to-region (point) (point))
 658                 (insert (or title "Untitled"))
 659                 (remove-text-properties (match-beginning 0) (match-end 0)
 660                                         '(read-only nil rear-nonsticky nil))
 661                 (let ((muse-publishing-current-style (muse-style "html")))
 662                   (muse-publish-escape-specials (point-min) (point-max)
 663                                                 nil 'document))))
 664             (goto-char (point-min))
 665             (while (search-forward "%desc%" nil t)
 666               (replace-match desc nil t))
 667             (goto-char (point-min))
 668             (while (search-forward "%enclosure%" nil t)
 669               (replace-match
 670                (if (null enclosure)
 671                    ""
 672                  (save-match-data
 673                    (format
 674                     "<enclosure url=\"%s\" %stype=\"%s\"/>"
 675                     (if (string-match "//" enclosure)
 676                         enclosure
 677                       (concat (muse-style-element :base-url)
 678                               enclosure))
 679                     (let ((file
 680                            (expand-file-name enclosure
 681                                              (muse-style-element :path))))
 682                       (if (file-readable-p file)
 683                           (format "length=\"%d\" "
 684                                   (nth 7 (file-attributes file)))
 685                         ""))
 686                     (if (string-match "\\.\\([^.]+\\)$" enclosure)
 687                         (let* ((ext (match-string 1 enclosure))
 688                                (type
 689                                 (assoc
 690                                  ext muse-journal-rss-enclosure-types-alist)))
 691                           (if type
 692                               (cdr type)
 693                             "application/octet-stream"))))))
 694                nil t))
 695             (goto-char (point-min))
 696             (while (search-forward "%link%" nil t)
 697               (replace-match
 698                (concat (muse-style-element :base-url)
 699                        (concat (muse-page-name)
 700                                muse-html-extension))
 701                nil t))
 702             (goto-char (point-min))
 703             (while (search-forward "%anchor%" nil t)
 704               (replace-match
 705                (muse-journal-anchorize-title (or title orig-date))
 706                nil t))
 707             (goto-char (point-min))
 708             (while (search-forward "%maintainer%" nil t)
 709               (replace-match
 710                (or (muse-style-element :maintainer)
 711                    (concat "webmaster@" (system-name)))
 712                nil t)))))))
 713   ;; indicate that we are to continue the :before-end processing
 714   nil)
 715
 716
 717 ;;; Register the Muse Journal Publishers
 718
 719 (muse-derive-style "journal-html" "html"
 720                    :before-end 'muse-journal-html-munge-buffer)
 721
 722 (muse-derive-style "journal-xhtml" "xhtml"
 723                    :before-end 'muse-journal-html-munge-buffer)
 724
 725 (muse-derive-style "journal-latex" "latex"
 726                    :tags 'muse-journal-markup-tags
 727                    :before-end 'muse-journal-latex-munge-buffer)
 728
 729 (muse-derive-style "journal-pdf" "pdf"
 730                    :tags 'muse-journal-markup-tags
 731                    :before-end 'muse-journal-latex-munge-buffer)
 732
 733 (muse-derive-style "journal-book-latex" "book-latex"
 734                    ;;:nochapters
 735                    :tags 'muse-journal-markup-tags
 736                    :before-end 'muse-journal-latex-munge-buffer)
 737
 738 (muse-derive-style "journal-book-pdf" "book-pdf"
 739                    ;;:nochapters
 740                    :tags 'muse-journal-markup-tags
 741                    :before-end 'muse-journal-latex-munge-buffer)
 742
 743 (muse-define-style "journal-rdf"
 744                    :suffix         'muse-journal-rdf-extension
 745                    :regexps        'muse-journal-rss-markup-regexps
 746                    :functions      'muse-journal-rss-markup-functions
 747                    :before         'muse-journal-rss-munge-buffer
 748                    :header         'muse-journal-rdf-header
 749                    :footer         'muse-journal-rdf-footer
 750                    :date-format    'muse-journal-rdf-date-format
 751                    :entry-template 'muse-journal-rdf-entry-template
 752                    :base-url       'muse-journal-rdf-base-url
 753                    :summarize      'muse-journal-rdf-summarize-entries)
 754
 755 (muse-define-style "journal-rss"
 756                    :suffix         'muse-journal-rss-extension
 757                    :regexps        'muse-journal-rss-markup-regexps
 758                    :functions      'muse-journal-rss-markup-functions
 759                    :before         'muse-journal-rss-munge-buffer
 760                    :header         'muse-journal-rss-header
 761                    :footer         'muse-journal-rss-footer
 762                    :date-format    'muse-journal-rss-date-format
 763                    :entry-template 'muse-journal-rss-entry-template
 764                    :base-url       'muse-journal-rss-base-url
 765                    :summarize      'muse-journal-rss-summarize-entries)
 766
 767 ;; Used by `muse-journal-rss-munge-buffer' to mark up individual entries
 768 (muse-derive-style "journal-rss-entry" "html"
 769                    :tags 'muse-journal-markup-tags)
 770
 771 (provide 'muse-journal)
 772
 773 ;;; muse-journal.el ends here