lisp/muse-docbook.el

   1 ;;; muse-docbook.el --- publish DocBook files
   2
   3 ;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
   4
   5 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
   6
   7 ;; Emacs Muse is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published
   9 ;; by the Free Software Foundation; either version 2, or (at your
  10 ;; option) any later version.
  11
  12 ;; Emacs Muse is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with Emacs Muse; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 ;; Boston, MA 02110-1301, USA.
  21
  22 ;;; Commentary:
  23
  24 ;;; Contributors:
  25
  26 ;; Dale P. Smith (dpsm AT en DOT com) improved the markup
  27 ;; significantly and made many valuable suggestions.
  28
  29 ;;; Code:
  30
  31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32 ;;
  33 ;; Muse DocBook XML Publishing
  34 ;;
  35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  36
  37 (require 'muse-publish)
  38 (require 'muse-regexps)
  39
  40 (defgroup muse-docbook nil
  41   "Options controlling the behavior of Muse DocBook XML publishing.
  42 See `muse-docbook' for more information."
  43   :group 'muse-publish)
  44
  45 (defcustom muse-docbook-extension ".xml"
  46   "Default file extension for publishing DocBook XML files."
  47   :type 'string
  48   :group 'muse-docbook)
  49
  50 (defcustom muse-docbook-header
  51   "<?xml version=\"1.0\" encoding=\"<lisp>
  52   (muse-docbook-encoding)</lisp>\"?>
  53 <!DOCTYPE article PUBLIC \"-//OASIS//DTD DocBook V4.2//EN\"
  54                   \"http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd\">
  55 <article>
  56   <articleinfo>
  57     <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
  58     <author><lisp>(muse-docbook-get-author
  59                     (muse-publishing-directive \"author\"))</lisp></author>
  60     <pubdate><lisp>(muse-publishing-directive \"date\")</lisp></pubdate>
  61   </articleinfo>
  62   <!-- Page published by Emacs Muse begins here -->\n"
  63   "Header used for publishing DocBook XML files.
  64 This may be text or a filename."
  65   :type 'string
  66   :group 'muse-docbook)
  67
  68 (defcustom muse-docbook-footer "
  69   <!-- Page published by Emacs Muse ends here -->
  70 </article>\n"
  71   "Footer used for publishing DocBook XML files.
  72 This may be text or a filename."
  73   :type 'string
  74   :group 'muse-docbook)
  75
  76 (defcustom muse-docbook-markup-regexps
  77   `(;; Join together the parts of a table
  78     (10000 ,(concat "  </t\\(body\\|head\\|foot\\)>\\s-*"
  79                     "</tgroup>\\s-*</informaltable>"
  80                     "\\([" muse-regexp-blank "]*\n\\)\\{0,2\\}"
  81                     "[" muse-regexp-blank "]*"
  82                     "<informaltable[^>]*>\\s-*<tgroup[^>]*>\\s-*"
  83                     "<t\\1>\n")
  84            0 "")
  85     (10100 ,(concat "  </tgroup>\\s-*</informaltable>"
  86                     "\\([" muse-regexp-blank "]*\n\\)\\{0,2\\}"
  87                     "[" muse-regexp-blank "]*"
  88                     "<informaltable[^>]*>\\s-*<tgroup[^>]*>\n")
  89            0 "")
  90
  91     ;; Join together the parts of a list
  92     (10200 ,(concat "</\\(itemized\\|ordered\\|variable\\)list>"
  93                     "\\([" muse-regexp-blank "]*\n\\)\\{0,2\\}"
  94                     "[" muse-regexp-blank "]*"
  95                     "<\\1list" "[^>]*>\\s-*")
  96            0 "")
  97
  98     ;; Beginning of doc, end of doc, or plain paragraph separator
  99     (10300 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?"
 100                     "\\(\\(\n\\(["
 101                     muse-regexp-blank
 102                     "]*\n\\)+\\)\\|\\`\\s-*\\|\\s-*\\'\\)"
 103                     "\\(<\\(blockquote\\|center\\)>\n\\)?")
 104            0 muse-docbook-markup-paragraph))
 105   "List of markup rules for publishing a Muse page to DocBook XML.
 106 For more on the structure of this list, see `muse-publish-markup-regexps'."
 107   :type '(repeat (choice
 108                   (list :tag "Markup rule"
 109                         integer
 110                         (choice regexp symbol)
 111                         integer
 112                         (choice string function symbol))
 113                   function))
 114   :group 'muse-docbook)
 115
 116 (defcustom muse-docbook-markup-functions
 117   '((anchor . muse-docbook-markup-anchor)
 118     (table . muse-docbook-markup-table))
 119   "An alist of style types to custom functions for that kind of text.
 120 For more on the structure of this list, see
 121 `muse-publish-markup-functions'."
 122   :type '(alist :key-type symbol :value-type function)
 123   :group 'muse-docbook)
 124
 125 (defcustom muse-docbook-markup-strings
 126   '((url-link        . "<ulink url=\"%s\">%s</ulink>")
 127     (internal-link   . "<link linkend=\"%s\">%s</link>")
 128     (email-addr      . "<email>%s</email>")
 129     (emdash          . " &mdash; ")
 130     (comment-begin   . "<!-- ")
 131     (comment-end     . " -->")
 132     (rule            . "")
 133     (no-break-space  . "&nbsp;")
 134     (enddots         . "....")
 135     (dots            . "...")
 136     (section         . "<section><title>")
 137     (section-end     . "</title>")
 138     (subsection      . "<section><title>")
 139     (subsection-end  . "</title>")
 140     (subsubsection   . "<section><title>")
 141     (subsubsection-end . "</title>")
 142     (section-other   . "<section><title>")
 143     (section-other-end . "</title>")
 144     (section-close   . "</section>")
 145     (footnote        . "<footnote><para>")
 146     (footnote-end    . "</para></footnote>")
 147     (begin-underline . "")
 148     (end-underline   . "")
 149     (begin-literal   . "<systemitem>")
 150     (end-literal     . "</systemitem>")
 151     (begin-emph      . "<emphasis>")
 152     (end-emph        . "</emphasis>")
 153     (begin-more-emph . "<emphasis role=\"strong\">")
 154     (end-more-emph   . "</emphasis>")
 155     (begin-most-emph . "<emphasis role=\"strong\"><emphasis>")
 156     (end-most-emph   . "</emphasis></emphasis>")
 157     (begin-verse     . "<literallayout>\n")
 158     (verse-space     . "  ")
 159     (end-verse       . "</literallayout>")
 160     (begin-example   . "<programlisting>")
 161     (end-example     . "</programlisting>")
 162     (begin-center    . "<para role=\"centered\">\n")
 163     (end-center      . "\n</para>")
 164     (begin-quote     . "<blockquote>\n")
 165     (end-quote       . "\n</blockquote>")
 166     (begin-uli       . "<itemizedlist mark=\"bullet\">\n<listitem><para>")
 167     (end-uli         . "</para></listitem>\n</itemizedlist>")
 168     (begin-oli       . "<orderedlist>\n<listitem><para>")
 169     (end-oli         . "</para></listitem>\n</orderedlist>")
 170     (begin-ddt       . "<variablelist>\n<varlistentry>\n<term>")
 171     (start-dde       . "</term>\n<listitem><para>")
 172     (end-ddt         . "</para></listitem>\n</varlistentry>\n</variablelist>"))
 173   "Strings used for marking up text.
 174 These cover the most basic kinds of markup, the handling of which
 175 differs little between the various styles."
 176   :type '(alist :key-type symbol :value-type string)
 177   :group 'muse-docbook)
 178
 179 (defcustom muse-docbook-markup-specials
 180   '((?\" . "&quot;")
 181     (?\< . "&lt;")
 182     (?\> . "&gt;")
 183     (?\& . "&amp;"))
 184   "A table of characters which must be represented specially."
 185   :type '(alist :key-type character :value-type string)
 186   :group 'muse-docbook)
 187
 188 (defcustom muse-docbook-encoding-default 'utf-8
 189   "The default Emacs buffer encoding to use in published files.
 190 This will be used if no special characters are found."
 191   :type 'symbol
 192   :group 'muse-docbook)
 193
 194 (defcustom muse-docbook-charset-default "utf-8"
 195   "The default DocBook XML charset to use if no translation is
 196 found in `muse-docbook-encoding-map'."
 197   :type 'string
 198   :group 'muse-docbook)
 199
 200 (defcustom muse-docbook-encoding-map
 201   '((iso-8859-1         . "iso-8859-1")
 202     (iso-2022-jp        . "iso-2022-jp")
 203     (utf-8              . "utf-8")
 204     (japanese-iso-8bit  . "euc-jp")
 205     (chinese-big5       . "big5")
 206     (mule-utf-8         . "utf-8")
 207     (chinese-iso-8bit   . "gb2312")
 208     (chinese-gbk        . "gbk"))
 209   "An alist mapping emacs coding systems to appropriate DocBook charsets.
 210 Use the base name of the coding system (i.e. without the -unix)."
 211   :type '(alist :key-type coding-system :value-type string)
 212   :group 'muse-docbook)
 213
 214 (defun muse-docbook-transform-content-type (content-type)
 215   "Using `muse-docbook-encoding-map', try and resolve an emacs
 216 coding system to an associated DocBook XML coding system. If no
 217 match is found, `muse-docbook-charset-default' is used instead."
 218   (let ((match (and (fboundp 'coding-system-base)
 219                     (assoc (coding-system-base content-type)
 220                            muse-docbook-encoding-map))))
 221     (if match
 222         (cdr match)
 223       muse-docbook-charset-default)))
 224
 225 (defun muse-docbook-encoding ()
 226   (muse-docbook-transform-content-type
 227    (or (and (boundp 'buffer-file-coding-system)
 228             buffer-file-coding-system)
 229        muse-docbook-encoding-default)))
 230
 231 (defun muse-docbook-markup-paragraph ()
 232   (let ((end (copy-marker (match-end 0) t)))
 233     (goto-char (match-beginning 0))
 234     (when (save-excursion
 235             (save-match-data
 236               (and (re-search-backward "<\\(/?\\)\\(para\\|footnote\\)[ >]"
 237                                        nil t)
 238                    (or (and (string= (match-string 2) "para")
 239                             (not (string= (match-string 1) "/")))
 240                        (and (string= (match-string 2) "footnote")
 241                             (string= (match-string 1) "/"))))))
 242       (insert "</para>"))
 243     (goto-char end))
 244   (cond
 245    ((eobp)
 246     (unless (bolp)
 247       (insert "\n")))
 248    ((eq (char-after) ?\<)
 249     (when (looking-at (concat "<\\(emphasis\\|systemitem"
 250                               "\\|u?link\\|anchor\\|email\\)[ >]"))
 251       (insert "<para>")))
 252    (t
 253     (insert "<para>"))))
 254
 255 (defun muse-docbook-insert-anchor (anchor)
 256   "Insert an anchor, either before the next word, or within a tag."
 257   (unless (get-text-property (match-end 1) 'noemphasis)
 258     (skip-chars-forward (concat muse-regexp-blank "\n"))
 259     (when (looking-at "<\\([^ />]+\\)>")
 260       (goto-char (match-end 0)))
 261     (insert "<anchor id=\"" anchor "\" />\n")))
 262
 263 (defun muse-docbook-markup-anchor ()
 264   (save-match-data
 265     (muse-docbook-insert-anchor (match-string 2)))
 266   (match-string 1))
 267
 268 (defun muse-docbook-markup-table ()
 269   (let* ((str (prog1
 270                   (match-string 1)
 271                 (delete-region (match-beginning 0) (match-end 0))))
 272          (fields (split-string str "\\s-*|+\\s-*"))
 273          (type (and (string-match "\\s-*\\(|+\\)\\s-*" str)
 274                     (length (match-string 1 str))))
 275          (part (cond ((= type 1) "tbody")
 276                      ((= type 2) "thead")
 277                      ((= type 3) "tfoot"))))
 278     (insert "<informaltable>\n"
 279             "  <tgroup cols='" (number-to-string (length fields)) "'>\n"
 280             "  <" part ">\n"
 281             "    <row>\n")
 282     (dolist (field fields)
 283       (insert "      <entry>" field "</entry>\n"))
 284     (insert "    </row>\n"
 285             "  </" part ">\n"
 286             "  </tgroup>\n"
 287             "</informaltable>\n")))
 288
 289 (defun muse-docbook-get-author (&optional author)
 290   "Split the AUTHOR directive into separate fields.
 291 AUTHOR should be of the form: \"Firstname Other Names Lastname\",
 292 and anything after `Firstname' is optional."
 293   (setq author (save-match-data (split-string author)))
 294   (let ((num-el (length author)))
 295     (cond ((eq num-el 1)
 296            (concat "<firstname>" (car author) "</firstname>"))
 297           ((eq num-el 2)
 298            (concat "<firstname>" (nth 0 author) "</firstname>"
 299                    "<surname>" (nth 1 author) "</surname>"))
 300           ((eq num-el 3)
 301            (concat "<firstname>" (nth 0 author) "</firstname>"
 302                    "<othername>" (nth 1 author) "</othername>"
 303                    "<surname>" (nth 2 author) "</surname>"))
 304           (t
 305            (let (first last)
 306              (setq first (car author))
 307              (setq author (nreverse (cdr author)))
 308              (setq last (car author))
 309              (setq author (nreverse (cdr author)))
 310              (concat "<firstname>" first "</firstname>"
 311                      "<othername>"
 312                      (mapconcat 'identity author " ")
 313                      "</othername>"
 314                      "<surname>" last "</surname>"))))))
 315
 316 (defun muse-docbook-fixup-tables ()
 317   "Sort table parts."
 318   (goto-char (point-min))
 319   (let (last)
 320     (while (re-search-forward "^ *<tgroup[^>]*>$" nil t)
 321       (unless (get-text-property (point) 'read-only)
 322         (forward-line 1)
 323         (save-restriction
 324           (let ((beg (point)))
 325             (narrow-to-region beg (and (re-search-forward "^ *</tgroup>"
 326                                                           nil t)
 327                                        (match-beginning 0))))
 328           (goto-char (point-min))
 329           (let ((inhibit-read-only t))
 330             (sort-subr nil
 331                        (function
 332                         (lambda ()
 333                           (if (re-search-forward
 334                                "^\\s-*<t\\(head\\|body\\|foot\\)>$" nil t)
 335                               (goto-char (match-beginning 0))
 336                             (goto-char (point-max)))))
 337                        (function
 338                         (lambda ()
 339                           (if (re-search-forward
 340                                "^\\s-*</t\\(head\\|body\\|foot\\)>$" nil t)
 341                               (goto-char (match-end 0))
 342                             (goto-char (point-max)))))
 343                        (function
 344                         (lambda ()
 345                           (looking-at "\\s-*<t\\(head\\|body\\|foot\\)>")
 346                           (cond ((string= (match-string 1) "head") 1)
 347                                 ((string= (match-string 1) "foot") 2)
 348                                 (t 3)))))))))))
 349
 350 (defun muse-docbook-finalize-buffer ()
 351   (when (boundp 'buffer-file-coding-system)
 352     (when (memq buffer-file-coding-system '(no-conversion undecided-unix))
 353       ;; make it agree with the default charset
 354       (setq buffer-file-coding-system muse-docbook-encoding-default))))
 355
 356 ;; Register the Muse DocBook XML Publisher
 357
 358 (unless (assoc "docbook" muse-publishing-styles)
 359   (muse-define-style "docbook"
 360                      :suffix     'muse-docbook-extension
 361                      :regexps    'muse-docbook-markup-regexps
 362                      :functions  'muse-docbook-markup-functions
 363                      :strings    'muse-docbook-markup-strings
 364                      :specials   'muse-docbook-markup-specials
 365                      :before-end 'muse-docbook-fixup-tables
 366                      :after      'muse-docbook-finalize-buffer
 367                      :header     'muse-docbook-header
 368                      :footer     'muse-docbook-footer
 369                      :browser    'find-file))
 370
 371 (provide 'muse-docbook)
 372
 373 ;;; muse-docbook.el ends here