muse-docbook.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Muse HTML Publishing
   4 ;;
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 (require 'muse-publish)
   8 (require 'muse-regexps)
   9
  10 (defgroup muse-docbook nil
  11   "Options controlling the behaviour of Muse DocBook XML publishing.
  12 See `muse-docbook' for more information."
  13   :group 'muse-publish)
  14
  15 (defcustom muse-docbook-extension ".xml"
  16   "Default file extension for publishing DocBook XML files."
  17   :type 'string
  18   :group 'muse-docbook)
  19
  20 (defcustom muse-docbook-header
  21   "<!DOCTYPE article PUBLIC \"-//OASIS//DTD DocBook V4.2//EN\">
  22 <article>
  23   <articleinfo>
  24     <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
  25     <author><lisp>(muse-publishing-directive \"author\")</lisp></author>
  26     <pubdate><lisp>(muse-publishing-directive \"date\")</lisp></pubdate>
  27   </articleinfo>
  28   <!-- Page published by Emacs Muse begins here -->\n"
  29   "Header used for publishing DocBook XML files."
  30   :type '(choice string file)
  31   :group 'muse-docbook)
  32
  33 (defcustom muse-docbook-footer "
  34   <!-- Page published by Emacs Muse ends here -->
  35 </article>\n"
  36   "Footer used for publishing DocBook XML files."
  37   :type '(choice string file)
  38   :group 'muse-docbook)
  39
  40 (defcustom muse-docbook-markup-regexps
  41   `(;; join together the parts of a list or table
  42     (10000 "</\\([oud]l\\)>\\s-*<\\1>\\s-*" 0 "")
  43     (10100 "</tbody>\\s-*</table>\\s-*<table[^>]*>\\s-*<tbody>\\s-*" 0 "")
  44     (10200 "</table>\\s-*<table[^>]*>\\s-*" 0 "")
  45
  46     ;; the beginning of the buffer begins the first paragraph
  47     (10300 "\\`\n*\\([^<]\\)" 0 "<para>\\1")
  48     ;; plain paragraph separator
  49     (10400 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?\n"
  50                     "\\(["
  51                     muse-regexp-blank
  52                     "]*\n\\)+\\(<\\(blockquote\\|center\\)>\n\\)?")
  53            0 muse-docbook-markup-paragraph)
  54     (10500 ,(concat "\\([^>"
  55                     muse-regexp-space
  56                     "]\\)\\s-+\\'")
  57            0 "\\1</para>\n"))
  58   "List of markup rules for publishing a Muse page to DocBook XML.
  59 For more on the structure of this list, see `muse-publish-markup-regexps'."
  60   :type '(repeat (choice
  61                   (list :tag "Markup rule"
  62                         integer
  63                         (choice regexp symbol)
  64                         integer
  65                         (choice string function symbol))
  66                   function))
  67   :group 'muse-docbook)
  68
  69 (defcustom muse-docbook-markup-functions
  70   '((table . muse-docbook-markup-table))
  71   "An alist of style types to custom functions for that kind of text.
  72 For more on the structure of this list, see
  73 `muse-publish-markup-functions'."
  74   :type '(alist :key-type symbol :value-type function)
  75   :group 'muse-docbook)
  76
  77 (defcustom muse-docbook-markup-strings
  78   '((url-link        . "<ulink url=\"%s\">%s</ulink>")
  79     (email-addr      . "<email>%s</email>")
  80     (emdash          . " &mdash; ")
  81     (rule            . "")
  82     (enddots         . "....")
  83     (dots            . "...")
  84     (section         . "<section><title>")
  85     (section-end     . "</title>")
  86     (subsection      . "<section><title>")
  87     (subsection-end  . "</title>")
  88     (subsubsection   . "<section><title>")
  89     (subsubsection-end . "</title>")
  90     (footnote        . "<footnote>")
  91     (footnote-end    . "</footnote>")
  92     (begin-underline . "")
  93     (end-underline   . "")
  94     (begin-literal   . "<filename>")
  95     (end-literal     . "</filename>")
  96     (begin-emph      . "<emphasis>")
  97     (end-emph        . "</emphasis>")
  98     (begin-more-emph . "<emphasis role=\"strong\">")
  99     (end-more-emph   . "</emphasis>")
 100     (begin-most-emph . "<emphasis role=\"strong\"><emphasis>")
 101     (end-most-emph   . "</emphasis>></emphasis role=\"strong\">")
 102     (begin-verse     . "<literallayout>\n")
 103     (verse-space     . "  ")
 104     (end-verse       . "</literallayout>")
 105     (begin-example   . "<example>")
 106     (end-example     . "</example>")
 107     (begin-center    . "<center>\n")
 108     (end-center      . "\n</center>")
 109     (begin-quote     . "<blockquote>\n")
 110     (end-quote       . "\n</blockquote>")
 111     (begin-uli       . "<itemizedlist mark=\"bullet\">\n<listitem>")
 112     (end-uli         . "</listitem>\n</itemizedlist>")
 113     (begin-oli       . "<orderedlist>\n<listitem>")
 114     (end-oli         . "</listitem>\n</orderedlist>")
 115     (begin-ddt       . "<dl>\n<dt>")
 116     (start-dde       . "</dt>\n  <dd>")
 117     (end-ddt         . "</dd>\n</dl>"))
 118   "Strings used for marking up text.
 119 These cover the most basic kinds of markup, the handling of which
 120 differs little between the various styles."
 121   :type '(alist :key-type symbol :value-type string)
 122   :group 'muse-docbook)
 123
 124 (defcustom muse-docbook-markup-specials
 125   '((?\" . "&quot;")
 126     (?\< . "&lt;")
 127     (?\> . "&gt;")
 128     (?\& . "&amp;"))
 129   "A table of characters which must be represented specially."
 130   :type '(alist :key-type character :value-type string)
 131   :group 'muse-docbook)
 132
 133 (unless (fboundp 'looking-back)
 134   (defun looking-back (regexp &optional limit)
 135     (save-excursion
 136       (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
 137
 138 (defun muse-docbook-markup-paragraph ()
 139   (let ((end (copy-marker (match-end 0) t)))
 140     (goto-char (match-beginning 0))
 141     (unless (eq (char-before) ?\>) (insert "</para>"))
 142     (goto-char end)
 143     (unless (eq (char-after) ?\<)
 144       (insert "<para>"))))
 145
 146 (defun muse-docbook-markup-table ()
 147   (let* ((str (save-match-data
 148                 (if (featurep 'xemacs)
 149                     ;; more emacs divergence. :(
 150                     (replace-in-string (match-string 1) " *|+ *$" "")
 151                   (match-string 1))))
 152          (fields (append (save-match-data
 153                            (split-string str (concat "["
 154                                                      muse-regexp-blank
 155                                                      "]*|+["
 156                                                      muse-regexp-blank
 157                                                      "]*")))
 158                          (list (match-string 4))))
 159          (len (length (match-string 3)))
 160          (row (cond ((= len 1) "tbody")
 161                     ((= len 2) "thead")
 162                     ((= len 3) "tfoot")))
 163          (col "entry"))
 164     (concat "<table>\n" "<" row ">\n" "<row>\n<" col ">"
 165             (mapconcat 'identity fields (format "</%s><%s>" col col))
 166             "</" col ">\n" "</row>\n" "</" row ">\n"
 167             "</table>\n")))
 168
 169 (defun muse-docbook-fixup-sections ()
 170   (goto-char (point-min))
 171   (let (last)
 172     (while (re-search-forward "\n*<section>" nil t)
 173       (when last
 174         (replace-match "\n</section>\n\n<section>"))
 175       (setq last (match-beginning 0)))
 176     (when last
 177       (goto-char (point-max))
 178       (insert "</section>"))))
 179
 180 ;; Register the Muse DocBook XML Publisher
 181
 182 (unless (assoc "docbook" muse-publishing-styles)
 183   (muse-define-style "docbook"
 184                      :suffix     'muse-docbook-extension
 185                      :regexps    'muse-docbook-markup-regexps
 186                      :functions  'muse-docbook-markup-functions
 187                      :strings    'muse-docbook-markup-strings
 188                      :specials   'muse-docbook-markup-specials
 189                      :before-end 'muse-docbook-fixup-sections
 190                      :header     'muse-docbook-header
 191                      :footer     'muse-docbook-footer
 192                      :browser    'find-file))
 193
 194 (provide 'muse-docbook)
 195
 196 ;;; muse-docbook.el ends here