code.delx.au - gnu-emacs-elpa/blob - packages/muse/muse-journal.el

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