muse-journal.el

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