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-journal-rdf-base-url
 156                                      (muse-publish-output-name))</lisp>\">
 157     <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
 158     <link><lisp>(concat muse-journal-rdf-base-url
 159                        (concat (muse-page-name)
 160                                muse-html-extension))</lisp></link>
 161     <description>A Journal</description>
 162     <items>
 163       <rdf:Seq>
 164         <rdf:li resource=\"<lisp>
 165           (concat muse-journal-rdf-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-markup-regexps
 202   '((10000 muse-link-regexp 0 "\\2"))
 203   "List of markup rules for publishing a Muse journal page to RDF.
 204 For more on the structure of this list, see `muse-publish-markup-regexps'."
 205   :type '(repeat (choice
 206                   (list :tag "Markup rule"
 207                         integer
 208                         (choice regexp symbol)
 209                         integer
 210                         (choice string function symbol))
 211                   function))
 212   :group 'muse-journal)
 213
 214 (defcustom muse-journal-rdf-markup-functions
 215   '((email . ignore)
 216     (link  . ignore)
 217     (url   . ignore))
 218   "An alist of style types to custom functions for that kind of text.
 219 For more on the structure of this list, see
 220 `muse-publish-markup-functions'."
 221   :type '(alist :key-type symbol :value-type function)
 222   :group 'muse-journal)
 223
 224 (defun muse-journal-anchorize-title (title)
 225   (save-match-data
 226     (if (string-match "(" title)
 227         (setq title (substring title 0 (match-beginning 0))))
 228     (if (string-match "<[^>]+>" title)
 229         (setq title (replace-match "" nil nil title)))
 230     (downcase (replace-regexp-in-string "[^a-zA-Z0-9_]" ""
 231   title))))
 232
 233 (defun muse-journal-sort-entries (&optional direction)
 234   (interactive "P")
 235   (sort-subr
 236    direction
 237    (function
 238     (lambda ()
 239       (if (re-search-forward "^\\* [0-9]+" nil t)
 240           (goto-char (match-beginning 0))
 241         (goto-char (point-max)))))
 242    (function
 243     (lambda ()
 244       (if (re-search-forward "^\\* [0-9]+" nil t)
 245           (goto-char (1- (match-beginning 0)))
 246         (goto-char (point-max)))))
 247    (function
 248     (lambda ()
 249       (forward-char 2)))
 250    (function
 251     (lambda ()
 252       (end-of-line)))))
 253
 254 (defun muse-journal-html-munge-buffer ()
 255   (goto-char (point-min))
 256   (let ((heading-regexp muse-journal-html-heading-regexp)
 257         (inhibit-read-only t))
 258     (while (re-search-forward heading-regexp nil t)
 259       (let* ((date (match-string 1))
 260              (orig-date date)
 261              (title (match-string 2))
 262              (clean-title title)
 263              datestamp qotd text)
 264         (delete-region (match-beginning 0) (match-end 0))
 265         (if clean-title
 266             (save-match-data
 267               (while (string-match "\\(^<[^>]+>\\|<[^>]+>$\\)" clean-title)
 268                 (setq clean-title (replace-match "" nil nil clean-title)))))
 269         (save-match-data
 270           (when (and date
 271                      (string-match
 272                       (concat "\\`\\([1-9][0-9][0-9][0-9]\\)[./]?"
 273                               "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
 274             (setq datestamp
 275                   (encode-time
 276                    0 0 0
 277                    (string-to-int (match-string 3 date))
 278                    (string-to-int (match-string 2 date))
 279                    (string-to-int (match-string 1 date))
 280                    (current-time-zone))
 281                   date (concat (format-time-string
 282                                 muse-journal-date-format datestamp)
 283                                (substring date (match-end 0))))))
 284         (save-restriction
 285           (narrow-to-region
 286            (point) (if (re-search-forward
 287                         (concat "\\(^<hr>$\\|"
 288                                 heading-regexp "\\)") nil t)
 289                        (match-beginning 0)
 290                      (point-max)))
 291           (goto-char (point-max))
 292           (while (and (not (bobp))
 293                       (eq ?\  (char-syntax (char-before))))
 294             (delete-char -1))
 295           (goto-char (point-min))
 296           (while (and (not (eobp))
 297                       (eq ?\  (char-syntax (char-after))))
 298             (delete-char 1))
 299           (save-excursion
 300             (when (search-forward "<qotd>" nil t)
 301               (let ((tag-beg (match-beginning 0))
 302                     (beg (match-end 0)))
 303                 (re-search-forward "</qotd>\n*")
 304                 (setq qotd (buffer-substring-no-properties
 305                             beg (match-beginning 0)))
 306                 (delete-region tag-beg (match-end 0)))))
 307           (setq text (buffer-string))
 308           (delete-region (point-min) (point-max))
 309           (let ((entry muse-journal-html-entry-template))
 310             (while (string-match "%date%" entry)
 311               (setq entry (replace-match (or date "") nil t entry)))
 312             (while (string-match "%title%" entry)
 313               (setq entry (replace-match (or title "&nbsp;") nil t entry)))
 314             (while (string-match "%anchor%" entry)
 315               (setq entry (replace-match
 316                            (muse-journal-anchorize-title
 317                             (or clean-title orig-date))
 318                            nil t entry)))
 319             (while (string-match "%qotd%" entry)
 320               (setq entry (replace-match (or qotd "") nil t entry)))
 321             (while (string-match "%text%" entry)
 322               (setq entry (replace-match text nil t entry)))
 323             (insert entry)
 324             (when (null qotd)
 325               (goto-char (point-min))
 326               (search-forward "<div id=\"entry-qotd\">")
 327               (let ((beg (match-beginning 0)))
 328                 (re-search-forward "</div>\n*")
 329                 (delete-region beg (point))))))))))
 330
 331 (defun muse-journal-latex-munge-buffer ()
 332   (goto-char (point-min))
 333   (let ((heading-regexp
 334          (concat "^" (regexp-quote (muse-markup-text 'section))
 335                  muse-journal-heading-regexp
 336                  (regexp-quote (muse-markup-text 'section-end)) "$"))
 337         (inhibit-read-only t))
 338     (when (re-search-forward heading-regexp nil t)
 339       (goto-char (match-beginning 0))
 340       (sort-subr nil
 341                  (function
 342                   (lambda ()
 343                     (if (re-search-forward heading-regexp nil t)
 344                         (goto-char (match-beginning 0))
 345                       (goto-char (point-max)))))
 346                  (function
 347                   (lambda ()
 348                     (if (re-search-forward heading-regexp nil t)
 349                         (goto-char (1- (match-beginning 0)))
 350                       (goto-char (point-max)))))
 351                  (function
 352                   (lambda ()
 353                     (forward-char 2)))
 354                  (function
 355                   (lambda ()
 356                     (end-of-line)))))
 357     (while (re-search-forward heading-regexp nil t)
 358       (let ((date (match-string 1))
 359             (title (match-string 2))
 360             qotd section)
 361         (save-match-data
 362           (when (and date
 363                      (string-match
 364                       (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
 365                               "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
 366             (setq date (encode-time
 367                         0 0 0
 368                         (string-to-int (match-string 3 date))
 369                         (string-to-int (match-string 2 date))
 370                         (string-to-int (match-string 1 date))
 371                         (current-time-zone))
 372                   date (format-time-string
 373                         muse-journal-date-format date))))
 374         (save-match-data
 375           (setq section muse-journal-latex-section)
 376           (while (string-match "%title%" section)
 377             (setq section (replace-match (or title "Untitled")
 378                                          nil t section)))
 379           (while (string-match "%date%" section)
 380             (setq section (replace-match (or date "") nil t section))))
 381         (replace-match section nil t))))
 382   (goto-char (point-min))
 383   (let ((subheading-regexp
 384          (concat "^" (regexp-quote (muse-markup-text 'subsection))
 385                  "\\([^\n}]+\\)"
 386                  (regexp-quote (muse-markup-text 'subsection-end)) "$"))
 387         (inhibit-read-only t))
 388     (while (re-search-forward subheading-regexp nil t)
 389       (let ((subsection muse-journal-latex-subsection))
 390         (save-match-data
 391           (let ((title (match-string 1)))
 392             (while (string-match "%title%" subsection)
 393               (setq subsection (replace-match title nil t subsection)))))
 394         (replace-match subsection nil t)))))
 395
 396 (defun muse-journal-latex-qotd-tag (beg end)
 397   (goto-char beg)
 398   (insert (muse-markup-text 'begin-quote))
 399   (goto-char end)
 400   (insert (muse-markup-text 'end-quote)))
 401
 402 (defun muse-journal-rdf-munge-buffer ()
 403   (goto-char (point-min))
 404   (let ((heading-regexp (concat "^\\* " muse-journal-heading-regexp "$"))
 405         (inhibit-read-only t))
 406     (while (re-search-forward heading-regexp nil t)
 407       (let* ((date (match-string 1))
 408              (orig-date date)
 409              (title (match-string 2))
 410              qotd desc)
 411         (save-match-data
 412           (when (and date
 413                      (string-match
 414                       (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
 415                               "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
 416             (setq date (encode-time 0 0 0
 417                                     (string-to-int (match-string 3 date))
 418                                     (string-to-int (match-string 2 date))
 419                                     (string-to-int (match-string 1 date))
 420                                     (current-time-zone))
 421                   date (format-time-string
 422                         muse-journal-rdf-date-format date))))
 423         (save-restriction
 424           (narrow-to-region
 425            (match-beginning 0)
 426            (if (re-search-forward heading-regexp nil t)
 427                (match-beginning 0)
 428              (point-max)))
 429           (goto-char (point-min))
 430           (delete-region (point) (line-end-position))
 431           (re-search-forward "</qotd>\n+" nil t)
 432           (while (and (char-after)
 433                       (eq ?\  (char-syntax (char-after))))
 434             (delete-char 1))
 435           (let ((beg (point)))
 436             (forward-sentence 2)
 437             (setq desc (buffer-substring beg (point))))
 438           (delete-region (point-min) (point-max))
 439           (let ((entry muse-journal-rdf-entry-template))
 440             (while (string-match "%date%" entry)
 441               (setq entry (replace-match (or date "") nil t entry)))
 442             (while (string-match "%title%" entry)
 443               (setq entry (replace-match (or title "Untitled") nil t entry)))
 444             (while (string-match "%desc%" entry)
 445               (setq entry (replace-match desc nil t entry)))
 446             (while (string-match "%link%" entry)
 447               (setq entry (replace-match
 448                            (concat muse-journal-rdf-base-url
 449                                    (concat (muse-page-name)
 450                                            muse-html-extension))
 451                            nil t entry)))
 452             (while (string-match "%anchor%" entry)
 453               (setq entry (replace-match
 454                            (muse-journal-anchorize-title (or title orig-date))
 455                            nil t entry)))
 456             (while (string-match "%maintainer%" entry)
 457               (setq entry (replace-match
 458                            (or (muse-style-element :maintainer)
 459                                (concat "webmaster@" (system-name)))
 460                            nil t entry)))
 461             (insert entry)))))))
 462
 463 (unless (assoc "journal-html" muse-publishing-styles)
 464   (muse-derive-style "journal-html" "html"
 465                      :before-end 'muse-journal-html-munge-buffer)
 466
 467   (muse-derive-style "journal-latex" "latex"
 468                      :tags 'muse-journal-latex-markup-tags
 469                      :before-end 'muse-journal-latex-munge-buffer)
 470
 471   (muse-derive-style "journal-pdf" "pdf"
 472                      :tags 'muse-journal-latex-markup-tags
 473                      :before-end 'muse-journal-latex-munge-buffer)
 474
 475   (muse-derive-style "journal-book-latex" "book-latex"
 476                      ;;:nochapters
 477                      :tags 'muse-journal-latex-markup-tags
 478                      :before-end 'muse-journal-latex-munge-buffer)
 479
 480   (muse-derive-style "journal-book-pdf" "book-pdf"
 481                      ;;:nochapters
 482                      :tags 'muse-journal-latex-markup-tags
 483                      :before-end 'muse-journal-latex-munge-buffer)
 484
 485   (muse-define-style "journal-rdf"
 486                      :suffix    'muse-journal-rdf-extension
 487                      :regexps   'muse-journal-rdf-markup-regexps
 488                      :functions 'muse-journal-rdf-markup-functions
 489                      :before    'muse-journal-rdf-munge-buffer
 490                      :header    'muse-journal-rdf-header
 491                      :footer    'muse-journal-rdf-footer))
 492
 493 (provide 'muse-journal)
 494
 495 ;;; muse-journal.el ends here