experimental/muse-blosxom.el

   1 ;;; emacs-wiki-blosxom.el --- Publish a wiki tree for serving by Blosxom
   2
   3 ;; Copyright 2004 Gary V. Vaughan (gary AT gnu DOT org)
   4 ;; Copyright 2004 Brad Collins (brad AT chenla DOT org)
   5
   6 ;; Emacs Lisp Archive Entry
   7 ;; Filename: emacs-wiki-blosxom.el
   8 ;; Version: 0.0.1
   9 ;; Date: Wed, 24 March 2004
  10 ;; Keywords: hypermedia
  11 ;; Author: Gary V. Vaughan (gary AT gnu DOT org)
  12 ;; Maintainer: Gary V. Vaughan (gary AT gnu DOT org)
  13 ;; Description: Publish a local Emacs Wiki tree for serving by Blosxom
  14 ;; URL: http://tkd.kicks-ass.net/arch/gary@gnu.org--2004/emacs-wiki--gary--1.0
  15 ;; Compatibility: Emacs21
  16
  17 ;; This file is not part of GNU Emacs.
  18
  19 ;; This is free software; you can redistribute it and/or modify it under
  20 ;; the terms of the GNU General Public License as published by the Free
  21 ;; Software Foundation; either version 2, or (at your option) any later
  22 ;; version.
  23 ;;
  24 ;; This is distributed in the hope that it will be useful, but WITHOUT
  25 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  26 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  27 ;; for more details.
  28 ;;
  29 ;; You should have received a copy of the GNU General Public License
  30 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  31 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  32 ;; MA 02111-1307, USA.
  33
  34 ;;; Commentary:
  35
  36 ;; I maintain the hypertext parts of my website with John Wiegley's
  37 ;; emacs-wiki.el, now maintained by Michael Olson at
  38 ;; http://www.mwolson.org/projects/EmacsWiki.html.  You will need to
  39 ;; install a copy of that file before this one is of any use to you.
  40 ;;
  41 ;; Blosxom wiki publishes a tree of categorised Wiki files to a mirrored
  42 ;; tree of blosxom stories to be served by blosxom.cgi.
  43 ;;
  44 ;; Each Blosxom Wiki file must include `#date yyyy-mm-dd', or optionally
  45 ;; the longer `#date yyyy-mm-dd hh:mm', plus whatever normal emacs wiki
  46 ;; content is desired.
  47 ;;
  48 ;; If you want to change `blosxom-directory' and some other variables,
  49 ;; either use Customize or use `blosxom-option-customized'.  For
  50 ;; example:
  51 ;;
  52 ;;    (blosxom-option-customized 'blosxom-directory "~/Blosxom")
  53 ;;    (blosxom-option-customized 'blosxom-publishing-directory
  54 ;;                               "~/public_html/blog")
  55 ;;
  56 ;; and if you want to modify other emacs-wiki variables for the blosxom
  57 ;; project:
  58 ;;
  59 ;;    (add-to-list 'blosxom-custom-variables
  60 ;;                 '(some-emacs-wiki-variable . "some-blosxom-wiki-value"))
  61 ;;    (blosxom-option-customized 'blosxom-custom-variables
  62 ;;                               blosxom-custom-variables)
  63 ;;
  64 ;; See `emacs-wiki-update-project' and `blosxom-custom-variables' for more
  65 ;; details.
  66
  67 ;;; Contributors:
  68
  69 ;; Brad Collins (brad AT chenla DOT org) ported this file (originally
  70 ;; called `emacs-wiki-bloxsom.el' to Muse.
  71
  72 ;;; Code:
  73
  74 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  75 ;;
  76 ;; Muse Blosxom Publishing
  77 ;;
  78 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  79
  80 (require 'muse-publish)
  81
  82 (defgroup muse-blosxom nil
  83   "Options controlling the behaviour of Muse BLOSXOM publishing.
  84 See `muse-blosxom' for more information."
  85   :group 'muse-publish)
  86
  87 (defcustom muse-blosxom-extension ".txt"
  88   "Default file extension for publishing BLOSXOM files."
  89   :type 'string
  90   :group 'muse-blosxom)
  91
  92 (defcustom muse-blosxom-header
  93   "<lisp>(muse-publishing-directive \"title\")</lisp>\n"
  94   "Header used for publishing BLOSXOM files."
  95   :type '(choice string file)
  96   :group 'muse-blosxom)
  97
  98 (defcustom muse-blosxom-footer "\n"
  99   "Footer used for publishing BLOSXOM files."
 100   :type '(choice string file)
 101   :group 'muse-blosxom)
 102
 103 (defcustom muse-blosxom-anchor-on-word nil
 104   "When true, anchors surround the closest word. This allows you
 105 to select them in a browser (ie, for pasting), but has the
 106 side-effect of marking up headers in multiple colours if your
 107 header style is different from your link style."
 108   :type 'boolean
 109   :group 'muse-blosxom)
 110
 111 (defcustom muse-blosxom-table-attributes
 112   "class=\"muse-table\" border=\"2\" cellpadding=\"5\""
 113   "The attribute to be used with BLOSXOM <table> tags.
 114 Note that since Muse supports direct insertion of BLOSXOM tags, you
 115 can easily create any kind of table you want, as long as each
 116 line begins at column 0 (to prevent it from being blockquote'd).
 117 To make such a table, use this idiom:
 118
 119   <verbatim>
 120   <table>
 121     [... contents of my table, in raw BLOSXOM ...]
 122   </verbatim></table>
 123
 124 It may look strange to have the tags out of sequence, but this is
 125 because the Muse verbatim tag is handled during a different pass
 126 than the BLOSXOM table tag."
 127   :type 'string
 128   :group 'muse-blosxom)
 129
 130 (defcustom muse-blosxom-markup-regexps
 131   `(
 132
 133    ;;(emacs-wiki-tag-regexp 0 muse-markup-custom-tags)
 134
 135     ;; join together the parts of a list or table
 136     (10000 "</\\([oud]l\\)>\\s-*<\\1>\\s-*" 0 "")
 137     (10100 ,(concat "  </t\\(body\\|head\\|foot\\)>\\s-*</table>\\s-*"
 138                     "<table[^>]*>\\s-*<t\\1>\n") 0 "")
 139     (10200 "</table>\\s-*<table[^>]*>\n" 0 "")
 140
 141     ;; the beginning of the buffer begins the first paragraph
 142     (10300 "\\`\n*\\([^<]\\|<\\(em\\|strong\\|code\\)>\\|<a \\)" 0
 143            "<p class=\"first\">\\1")
 144     ;; plain paragraph separator
 145     (10400 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?\n"
 146                     "\\([ \t]*\n\\)+\\(<\\(blockquote\\|center\\)>\n\\)?") 0
 147      muse-blosxom-markup-paragraph)
 148     (10500 "\\([^> \n\t]\\)\\s-*\\'" 0 "\\1</p>\n")
 149     (10600 "^#\\([A-C]\\)\\([0-9]*\\)\\s-*\\([_oX>CP]\\)\\s-*\\(.+\\)"
 150            0 planner-markup-task)
 151     (10700 "^\\.#\\([0-9]+\\)" 0 planner-markup-note)
 152     (10800 "^#\\(date\\)\\s-+\\(.+\\)\n+" 0 muse-blosxom-markup-date-directive))
 153   "List of markup rules for publishing a Muse page to BLOSXOM.
 154 For more on the structure of this list, see `muse-publish-markup-regexps'."
 155   :type '(repeat (choice
 156                   (list :tag "Markup rule"
 157                         (choice regexp symbol)
 158                         integer
 159                         (choice string function symbol))
 160                   function))
 161   :group 'muse-blosxom)
 162
 163 (defcustom muse-blosxom-markup-functions
 164   '((anchor   . muse-blosxom-markup-anchor)
 165     (table    . muse-blosxom-markup-table)
 166     (footnote . muse-blosxom-markup-footnote))
 167   "An alist of style types to custom functions for that kind of text.
 168 For more on the structure of this list, see
 169 `muse-publish-markup-functions'."
 170   :type '(alist :key-type symbol :value-type function)
 171   :group 'muse-blosxom)
 172
 173 (defcustom muse-blosxom-markup-strings
 174   '((image-with-desc . "<img src=\"%s\" alt=\"%s\">")
 175     (image-link      . "<img src=\"%s\">")
 176     (url-with-image  . "<a href=\"%s\"><img src=\"%s\"></a>")
 177     (url-link        . "<a href=\"%s\">%s</a>")
 178     (email-addr      . "<a href=\"mailto:%s\">%s</a>")
 179     (emdash          . " &#151; ")
 180     (rule            . "<hr>")
 181     (fn-sep          . "<hr>\n")
 182     (enddots         . "....")
 183     (dots            . "...")
 184     (section         . "<h2>")
 185     (section-end     . "</h2>")
 186     (subsection      . "<h3>")
 187     (subsection-end  . "</h3>")
 188     (subsubsection   . "<h4>")
 189     (subsubsection-end . "</h4>")
 190     (begin-underline . "<u>")
 191     (end-underline   . "</u>")
 192     (begin-literal   . "<code>")
 193     (end-literal     . "</code>")
 194     (begin-emph      . "<em>")
 195     (end-emph        . "</em>")
 196     (begin-more-emph . "<strong>")
 197     (end-more-emph   . "</strong>")
 198     (begin-most-emph . "<strong><em>")
 199     (end-most-emph   . "</em></strong>")
 200     (begin-verse     . "<p class=\"verse\">\n")
 201     (verse-space     . "&nbsp;&nbsp;")
 202     (end-verse-line  . "<br>")
 203     (last-stanza-end . "<br>")
 204     (empty-verse-line . "<br>")
 205     (end-verse       . "</p>")
 206     (begin-example   . "<pre class=\"example\">")
 207     (end-example     . "</pre>")
 208     (begin-center    . "<center>\n")
 209     (end-center      . "\n</center>")
 210     (begin-quote     . "<blockquote>\n")
 211     (end-quote       . "\n</blockquote>")
 212     (begin-uli       . "<ul>\n<li>")
 213     (end-uli         . "</li>\n</ul>")
 214     (begin-oli       . "<ol>\n<li>")
 215     (end-oli         . "</li>\n</ol>")
 216     (begin-ddt       . "<dl>\n<dt><strong>")
 217     (start-dde       . "</strong></dt>\n<dd>")
 218     (end-ddt         . "</dd>\n</dl>"))
 219   "Strings used for marking up text.
 220 These cover the most basic kinds of markup, the handling of which
 221 differs little between the various styles."
 222   :type '(alist :key-type symbol :value-type string)
 223   :group 'muse-blosxom)
 224
 225 (defcustom muse-blosxom-markup-specials
 226   '((?\" . "&quot;")
 227     (?\< . "&lt;")
 228     (?\> . "&gt;")
 229     (?\& . "&amp;"))
 230   "A table of characters which must be represented specially."
 231   :type '(alist :key-type character :value-type string)
 232   :group 'muse-blosxom)
 233
 234 (defcustom muse-blosxom-meta-http-equiv "Content-Type"
 235   "The http-equiv attribute used for the BLOSXOM <meta> tag."
 236   :type 'string
 237   :group 'muse-blosxom)
 238
 239 (defcustom muse-blosxom-meta-content-type "text/blosxom"
 240   "The content type used for the BLOSXOM <meta> tag."
 241   :type 'string
 242   :group 'muse-blosxom)
 243
 244 (defcustom muse-blosxom-meta-content-encoding (if (featurep 'mule)
 245                                               'detect
 246                                             "iso-8859-1")
 247   "If set to the symbol 'detect, use `muse-coding-map' to try
 248   and determine the BLOSXOM charset from emacs's coding. If set to a string, this
 249   string will be used to force a particular charset"
 250   :type '(choice string symbol)
 251   :group 'muse-blosxom)
 252
 253 (defcustom muse-blosxom-charset-default "iso-8859-1"
 254   "The default BLOSXOM meta charset to use if no translation is found in
 255   `muse-coding-map'"
 256   :type 'string
 257   :group 'muse-blosxom)
 258
 259 (defcustom muse-blosxom-encoding-default 'iso-8859-1
 260   "The default emacs coding  use if no special characters are found"
 261   :type 'symbol
 262   :group 'muse-blosxom)
 263
 264 (defcustom muse-blosxom-encoding-map
 265   '((iso-2022-jp        . "iso-2022-jp")
 266     (utf-8              . "utf-8")
 267     (japanese-iso-8bit  . "euc-jp")
 268     (chinese-big5       . "big5"))
 269   "An alist mapping emacs coding systems to appropriate BLOSXOM charsets.
 270   Use the base name of the coding system (ie, without the -unix)"
 271   :type '(alist :key-type coding-system :value-type string)
 272   :group 'muse-blosxom)
 273
 274 (defun muse-blosxom-transform-content-type (content-type)
 275   "Using `muse-blosxom-encoding-map', try and resolve an emacs coding
 276 system to an associated BLOSXOM coding system. If no match is found,
 277 `muse-blosxom-charset-default' is used instead."
 278   (let ((match (assoc (coding-system-base content-type)
 279                       muse-blosxom-encoding-map)))
 280     (if match
 281         (cadr match)
 282       muse-blosxom-charset-default)))
 283
 284 (defun muse-blosxom-insert-anchor (anchor)
 285   "Insert an anchor, either around the word at point, or within a tag."
 286   (skip-chars-forward " \t\n")
 287   (if (looking-at "<\\([^ />]+\\)>")
 288       (let ((tag (match-string 1)))
 289         (goto-char (match-end 0))
 290         (insert "<a name=\"" anchor "\" id=\"" anchor "\">")
 291         (when muse-blosxom-anchor-on-word
 292           (or (and (search-forward (format "</%s>" tag)
 293                                    (line-end-position) t)
 294                    (goto-char (match-beginning 0)))
 295               (forward-word 1)))
 296         (insert "</a>"))
 297     (insert "<a name=\"" anchor "\" id=\"" anchor "\">")
 298     (when muse-blosxom-anchor-on-word
 299       (forward-word 1))
 300     (insert "</a>")))
 301
 302 (unless (fboundp 'looking-back)
 303   (defun looking-back (regexp &optional limit)
 304     (save-excursion
 305       (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
 306
 307 (defun muse-blosxom-markup-paragraph ()
 308   (let ((end (copy-marker (match-end 0) t)))
 309     (goto-char (match-beginning 0))
 310     (unless (eq (char-before) ?\>) (insert "</p>"))
 311     (goto-char end)
 312     (unless (and (eq (char-after) ?\<)
 313                  (not (or (looking-at "<\\(em\\|strong\\|code\\)>")
 314                           (looking-at "<a "))))
 315       (cond
 316        ((looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n")
 317         (insert "<p class=\"first\">"))
 318        ((looking-back "<\\(blockquote\\|center\\)>\n")
 319         (insert "<p class=\"quoted\">"))
 320        (t
 321         (insert "<p>"))))))
 322
 323 (defun muse-blosxom-markup-anchor ()
 324   (save-match-data
 325     (muse-blosxom-insert-anchor (match-string 1))) "")
 326
 327 (defun muse-blosxom-escape-string (str)
 328   "Convert to character entities any non-alphanumeric characters
 329 outside a few punctuation symbols, that risk being misinterpreted
 330 if not escaped."
 331   (when str
 332     (let (pos code len)
 333       (save-match-data
 334         (while (setq pos (string-match "[^-[:alnum:]/:._=@\\?~#]"
 335                                        str pos))
 336           (setq code (int-to-string (aref str pos))
 337                 len (length code)
 338                 str (replace-match (concat "&#" code ";") nil nil str)
 339                 pos (+ 3 len pos)))
 340         str))))
 341
 342 (defun muse-blosxom-markup-footnote ()
 343   (if (/= (line-beginning-position) (match-beginning 0))
 344       "<sup><a name=\"fnr.\\1\" href=\"#fn.\\1\">\\1</a></sup>"
 345     (prog1
 346         "<p class=\"footnote\"><a name=\"fn.\\1\" href=\"#fnr.\\1\">\\1.</a>"
 347       (save-excursion
 348         (save-match-data
 349           (let* ((beg (goto-char (match-end 0)))
 350                  (end (and (search-forward "\n\n" nil t)
 351                            (prog1
 352                                (copy-marker (match-beginning 0))
 353                              (goto-char beg)))))
 354             (while (re-search-forward "^[ \t]+\\([^\n]\\)" end t)
 355               (replace-match "\\1" t))))))))
 356
 357 (defun muse-blosxom-markup-table ()
 358   (let* ((str (prog1
 359                   (match-string 1)
 360                 (delete-region (match-beginning 0) (match-end 0))))
 361          (fields (split-string str "\\s-*|+\\s-*"))
 362          (type (and (string-match "\\s-*\\(|+\\)\\s-*" str)
 363                     (length (match-string 1 str))))
 364          (part (cond ((= type 1) "tbody")
 365                      ((= type 2) "thead")
 366                      ((= type 3) "tfoot")))
 367          (col (cond ((= type 1) "td")
 368                     ((= type 2) "th")
 369                     ((= type 3) "td")))
 370          field)
 371     (insert "<table " muse-blosxom-table-attributes ">\n"
 372             "  <" part ">\n"
 373             "    <tr>\n")
 374     (dolist (field fields)
 375       (insert "      <" col ">" field "</" col ">\n"))
 376     (insert "    </tr>\n"
 377             "  </" part ">\n"
 378             "</table>\n")))
 379
 380 ;; Handling of tags for BLOSXOM
 381
 382 (defun muse-blosxom-insert-contents (depth)
 383   (let ((max-depth (or depth 2))
 384         (index 1)
 385         base contents l)
 386     (save-excursion
 387       (goto-char (point-min))
 388       (search-forward "Page published by Emacs Muse begins here" nil t)
 389       (catch 'done
 390         (while (re-search-forward "^<h\\([0-9]+\\)>\\(.+?\\)</h\\1>" nil t)
 391           (unless (get-text-property (point) 'read-only)
 392             (setq l (1- (string-to-int (match-string 1))))
 393             (if (null base)
 394                 (setq base l)
 395               (if (< l base)
 396                   (throw 'done t)))
 397             (when (<= l max-depth)
 398               (setq contents (cons (cons l (match-string-no-properties 2))
 399                                    contents))
 400               (goto-char (match-beginning 2))
 401               (muse-blosxom-insert-anchor (concat "sec" (int-to-string index)))
 402               (setq index (1+ index)))))))
 403     (setq index 1 contents (reverse contents))
 404     (let ((depth 1) (sub-open 0) (p (point)))
 405       (insert "<dl class=\"contents\">\n")
 406       (while contents
 407         (insert "<dt class=\"contents\">\n")
 408         (insert "<a href=\"#sec" (int-to-string index) "\">"
 409                 (muse-publish-strip-tags (cdar contents))
 410                 "</a>\n")
 411         (setq index (1+ index))
 412         (insert "</dt>\n")
 413         (setq depth (caar contents)
 414               contents (cdr contents))
 415         (if contents
 416             (cond
 417              ((< (caar contents) depth)
 418               (let ((idx (caar contents)))
 419                 (while (< idx depth)
 420                   (insert "</dl>\n</dd>\n")
 421                   (setq sub-open (1- sub-open)
 422                         idx (1+ idx)))))
 423              ((> (caar contents) depth) ; can't jump more than one ahead
 424               (insert "<dd>\n<dl class=\"contents\">\n")
 425               (setq sub-open (1+ sub-open))))))
 426       (while (> sub-open 0)
 427         (insert "</dl>\n</dd>\n")
 428         (setq sub-open (1- sub-open)))
 429       (insert "</dl>\n")
 430       (muse-publish-mark-read-only p (point)))))
 431
 432 ;; Register the Muse BLOSXOM Publisher
 433
 434 (defun muse-blosxom-browse-file (file)
 435   (browse-url (concat "file:" file)))
 436
 437 (defun muse-blosxom-encoding ()
 438   (if (stringp muse-blosxom-meta-content-encoding)
 439       muse-blosxom-meta-content-encoding
 440     (muse-blosxom-transform-content-type
 441      (or buffer-file-coding-system
 442          muse-blosxom-encoding-default))))
 443
 444 (defun muse-blosxom-prepare-buffer ()
 445   (set (make-local-variable 'muse-publish-url-transforms)
 446        (cons 'muse-blosxom-escape-string muse-publish-url-transforms))
 447   (make-local-variable 'muse-blosxom-meta-http-equiv)
 448   (set (make-local-variable 'muse-blosxom-meta-content-type)
 449        (concat muse-blosxom-meta-content-type "; charset="
 450                (muse-blosxom-encoding))))
 451
 452 (defun muse-blosxom-finalize-buffer ()
 453   (when muse-publish-generate-contents
 454     (goto-char (car muse-publish-generate-contents))
 455     (muse-blosxom-insert-contents (cdr muse-publish-generate-contents)))
 456   (when (memq buffer-file-coding-system '(no-conversion undecided-unix))
 457     ;; make it agree with the default charset
 458     (setq buffer-file-coding-system muse-blosxom-encoding-default)))
 459
 460 (unless (assoc "blosxom" muse-publishing-styles)
 461   (muse-define-style "blosxom"
 462                      :suffix    'muse-blosxom-extension
 463                      :regexps   'muse-blosxom-markup-regexps
 464                      :functions 'muse-blosxom-markup-functions
 465                      :strings   'muse-blosxom-markup-strings
 466                      :specials  'muse-blosxom-markup-specials
 467                      :before    'muse-blosxom-prepare-buffer
 468                      :after     'muse-blosxom-finalize-buffer
 469                      :header    'muse-blosxom-header
 470                      :footer    'muse-blosxom-footer
 471                      :browser   'muse-blosxom-browse-file))
 472
 473 ;;; Mode
 474
 475 ;;; Maintain (published-file . date) alist
 476
 477 (defvar blosxom-page-date-alist nil)
 478
 479 (defun muse-blosxom-markup-date-directive ()
 480   "Add a date entry to `blosxom-page-date-alist' for this page."
 481   (when (string= (match-string 1) "date")
 482     (let ((date (match-string 2)))
 483       (save-match-data
 484         (add-to-list
 485          'blosxom-page-date-alist
 486          `(,(muse-published-file) . ,date)))))
 487   "")
 488
 489 (defun blosxom-set-time (file)
 490   "Reset the modification timestamp for published FILE.
 491 Blosxom uses the modification time of a published file as its publication
 492 date-time.  Adding this function to `emacs-wiki-after-file-publish-hook'
 493 will set the modification time of the published page according to the value
 494 stored in `blosxom-page-date-alist'."
 495   (let* ((page (,use-page-name file))
 496          (published (muse-published-file page))
 497          (date (cdr (assoc published blosxom-page-date-alist))))
 498     (when date
 499       (shell-command
 500        (format "touch --date='%s' %s" date published)))))
 501
 502 (provide 'muse-blosxom)
 503
 504 ;;; muse-blosxom.el ends here