lisp/muse-docbook.el

   1 ;;; muse-docbook.el --- publish DocBook files
   2
   3 ;; Copyright (C) 2004, 2005  Free Software Foundation, Inc.
   4
   5 ;; This file is not part of GNU Emacs.
   6
   7 ;; This is free software; you can redistribute it and/or modify it under
   8 ;; the terms of the GNU General Public License as published by the Free
   9 ;; Software Foundation; either version 2, or (at your option) any later
  10 ;; version.
  11 ;;
  12 ;; This is distributed in the hope that it will be useful, but WITHOUT
  13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 ;; for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; 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 (require 'muse-xml-common)
  40
  41 (defgroup muse-docbook nil
  42   "Options controlling the behavior of Muse DocBook XML publishing.
  43 See `muse-docbook' for more information."
  44   :group 'muse-publish)
  45
  46 (defcustom muse-docbook-extension ".xml"
  47   "Default file extension for publishing DocBook XML files."
  48   :type 'string
  49   :group 'muse-docbook)
  50
  51 (defcustom muse-docbook-header
  52   "<?xml version=\"1.0\" encoding=\"<lisp>
  53   (muse-docbook-encoding)</lisp>\"?>
  54 <!DOCTYPE article PUBLIC \"-//OASIS//DTD DocBook V4.2//EN\"
  55                   \"http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd\">
  56 <article>
  57   <articleinfo>
  58     <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
  59     <author><lisp>(muse-docbook-get-author
  60                     (muse-publishing-directive \"author\"))</lisp></author>
  61     <pubdate><lisp>(muse-publishing-directive \"date\")</lisp></pubdate>
  62   </articleinfo>
  63   <!-- Page published by Emacs Muse begins here -->\n"
  64   "Header used for publishing DocBook XML files.
  65 This may be text or a filename."
  66   :type 'string
  67   :group 'muse-docbook)
  68
  69 (defcustom muse-docbook-footer "
  70   <!-- Page published by Emacs Muse ends here -->
  71 </article>\n"
  72   "Footer used for publishing DocBook XML files.
  73 This may be text or a filename."
  74   :type 'string
  75   :group 'muse-docbook)
  76
  77 (defcustom muse-docbook-markup-regexps
  78   `(;; Join together the parts of a list
  79     (10000 ,(concat "</\\(itemized\\|ordered\\|variable\\)list>"
  80                     "\\([" muse-regexp-blank "]*\n\\)\\{0,2\\}"
  81                     "[" muse-regexp-blank "]*"
  82                     "<\\1list" "[^>]*>\\s-*")
  83            0 "")
  84
  85     ;; Beginning of doc, end of doc, or plain paragraph separator
  86     (10100 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?"
  87                     "\\(\\(\n\\(["
  88                     muse-regexp-blank
  89                     "]*\n\\)+\\)\\|\\`\\s-*\\|\\s-*\\'\\)"
  90                     "\\(<\\(blockquote\\|center\\)>\n\\)?")
  91            0 muse-docbook-markup-paragraph))
  92   "List of markup rules for publishing a Muse page to DocBook XML.
  93 For more on the structure of this list, see `muse-publish-markup-regexps'."
  94   :type '(repeat (choice
  95                   (list :tag "Markup rule"
  96                         integer
  97                         (choice regexp symbol)
  98                         integer
  99                         (choice string function symbol))
 100                   function))
 101   :group 'muse-docbook)
 102
 103 (defcustom muse-docbook-markup-functions
 104   '((anchor . muse-docbook-markup-anchor)
 105     (table . muse-xml-markup-table))
 106   "An alist of style types to custom functions for that kind of text.
 107 For more on the structure of this list, see
 108 `muse-publish-markup-functions'."
 109   :type '(alist :key-type symbol :value-type function)
 110   :group 'muse-docbook)
 111
 112 (defcustom muse-docbook-markup-strings
 113   '((url-link        . "<ulink url=\"%s\">%s</ulink>")
 114     (internal-link   . "<link linkend=\"%s\">%s</link>")
 115     (email-addr      . "<email>%s</email>")
 116     (emdash          . " &mdash; ")
 117     (comment-begin   . "<!-- ")
 118     (comment-end     . " -->")
 119     (rule            . "")
 120     (enddots         . "....")
 121     (dots            . "...")
 122     (section         . "<section><title>")
 123     (section-end     . "</title>")
 124     (subsection      . "<section><title>")
 125     (subsection-end  . "</title>")
 126     (subsubsection   . "<section><title>")
 127     (subsubsection-end . "</title>")
 128     (section-other   . "<section><title>")
 129     (section-other-end . "</title>")
 130     (section-close   . "</section>")
 131     (footnote        . "<footnote><para>")
 132     (footnote-end    . "</para></footnote>")
 133     (begin-underline . "")
 134     (end-underline   . "")
 135     (begin-literal   . "<systemitem>")
 136     (end-literal     . "</systemitem>")
 137     (begin-emph      . "<emphasis>")
 138     (end-emph        . "</emphasis>")
 139     (begin-more-emph . "<emphasis role=\"strong\">")
 140     (end-more-emph   . "</emphasis>")
 141     (begin-most-emph . "<emphasis role=\"strong\"><emphasis>")
 142     (end-most-emph   . "</emphasis></emphasis>")
 143     (begin-verse     . "<literallayout>\n")
 144     (verse-space     . "  ")
 145     (end-verse       . "</literallayout>")
 146     (begin-example   . "<programlisting>")
 147     (end-example     . "</programlisting>")
 148     (begin-center    . "<para role=\"centered\">\n")
 149     (end-center      . "\n</para>")
 150     (begin-quote     . "<blockquote>\n")
 151     (end-quote       . "\n</blockquote>")
 152     (begin-uli       . "<itemizedlist mark=\"bullet\">\n<listitem><para>")
 153     (end-uli         . "</para></listitem>\n</itemizedlist>")
 154     (begin-oli       . "<orderedlist>\n<listitem><para>")
 155     (end-oli         . "</para></listitem>\n</orderedlist>")
 156     (begin-ddt       . "<variablelist>\n<varlistentry>\n<term>")
 157     (start-dde       . "</term>\n<listitem><para>")
 158     (end-ddt         . "</para></listitem>\n</varlistentry>\n</variablelist>")
 159     (begin-table     . "<informaltable>\n")
 160     (end-table       . "</informaltable>\n")
 161     (begin-table-group . "  <tgroup cols='%s'>\n")
 162     (end-table-group . "  </tgroup>\n")
 163     (begin-table-row . "    <row>\n")
 164     (end-table-row   . "    </row>\n")
 165     (begin-table-entry . "      <entry>")
 166     (end-table-entry . "</entry>\n"))
 167   "Strings used for marking up text.
 168 These cover the most basic kinds of markup, the handling of which
 169 differs little between the various styles."
 170   :type '(alist :key-type symbol :value-type string)
 171   :group 'muse-docbook)
 172
 173 (defcustom muse-docbook-markup-specials
 174   '((?\" . "&quot;")
 175     (?\< . "&lt;")
 176     (?\> . "&gt;")
 177     (?\& . "&amp;"))
 178   "A table of characters which must be represented specially."
 179   :type '(alist :key-type character :value-type string)
 180   :group 'muse-docbook)
 181
 182 (defcustom muse-docbook-encoding-default 'utf-8
 183   "The default Emacs buffer encoding to use in published files.
 184 This will be used if no special characters are found."
 185   :type 'symbol
 186   :group 'muse-docbook)
 187
 188 (defcustom muse-docbook-charset-default "utf-8"
 189   "The default DocBook XML charset to use if no translation is
 190 found in `muse-docbook-encoding-map'."
 191   :type 'string
 192   :group 'muse-docbook)
 193
 194 (defun muse-docbook-encoding ()
 195   (muse-xml-transform-content-type
 196    (or (and (boundp 'buffer-file-coding-system)
 197             buffer-file-coding-system)
 198        muse-docbook-encoding-default)
 199    muse-docbook-charset-default))
 200
 201 (defun muse-docbook-markup-paragraph ()
 202   (let ((end (copy-marker (match-end 0) t)))
 203     (goto-char (match-beginning 0))
 204     (when (save-excursion
 205             (save-match-data
 206               (and (re-search-backward "<\\(/?\\)\\(para\\|footnote\\)[ >]"
 207                                        nil t)
 208                    (or (and (string= (match-string 2) "para")
 209                             (not (string= (match-string 1) "/")))
 210                        (and (string= (match-string 2) "footnote")
 211                             (string= (match-string 1) "/"))))))
 212       (muse-insert-markup "</para>"))
 213     (goto-char end))
 214   (cond
 215    ((eobp)
 216     (unless (bolp)
 217       (insert "\n")))
 218    ((eq (char-after) ?\<)
 219     (when (looking-at (concat "<\\(emphasis\\|systemitem"
 220                               "\\|u?link\\|anchor\\|email\\)[ >]"))
 221       (muse-insert-markup "<para>")))
 222    (t
 223     (muse-insert-markup "<para>"))))
 224
 225 (defun muse-docbook-insert-anchor (anchor)
 226   "Insert an anchor, either before the next word, or within a tag."
 227   (skip-chars-forward muse-regexp-space)
 228   (when (looking-at "<\\([^ />]+\\)>")
 229     (goto-char (match-end 0)))
 230   (muse-insert-markup "<anchor id=\"" anchor "\" />\n"))
 231
 232 (defun muse-docbook-markup-anchor ()
 233   (save-match-data
 234     (muse-docbook-insert-anchor (match-string 2)))
 235   (match-string 1))
 236
 237 (defun muse-docbook-get-author (&optional author)
 238   "Split the AUTHOR directive into separate fields.
 239 AUTHOR should be of the form: \"Firstname Other Names Lastname\",
 240 and anything after `Firstname' is optional."
 241   (setq author (save-match-data (split-string author)))
 242   (let ((num-el (length author)))
 243     (cond ((eq num-el 1)
 244            (concat "<firstname>" (car author) "</firstname>"))
 245           ((eq num-el 2)
 246            (concat "<firstname>" (nth 0 author) "</firstname>"
 247                    "<surname>" (nth 1 author) "</surname>"))
 248           ((eq num-el 3)
 249            (concat "<firstname>" (nth 0 author) "</firstname>"
 250                    "<othername>" (nth 1 author) "</othername>"
 251                    "<surname>" (nth 2 author) "</surname>"))
 252           (t
 253            (let (first last)
 254              (setq first (car author))
 255              (setq author (nreverse (cdr author)))
 256              (setq last (car author))
 257              (setq author (nreverse (cdr author)))
 258              (concat "<firstname>" first "</firstname>"
 259                      "<othername>"
 260                      (mapconcat 'identity author " ")
 261                      "</othername>"
 262                      "<surname>" last "</surname>"))))))
 263
 264 (defun muse-docbook-finalize-buffer ()
 265   (when (boundp 'buffer-file-coding-system)
 266     (when (memq buffer-file-coding-system '(no-conversion undecided-unix))
 267       ;; make it agree with the default charset
 268       (setq buffer-file-coding-system muse-docbook-encoding-default))))
 269
 270 ;; Register the Muse DocBook XML Publisher
 271
 272 (unless (assoc "docbook" muse-publishing-styles)
 273   (muse-define-style "docbook"
 274                      :suffix     'muse-docbook-extension
 275                      :regexps    'muse-docbook-markup-regexps
 276                      :functions  'muse-docbook-markup-functions
 277                      :strings    'muse-docbook-markup-strings
 278                      :specials   'muse-docbook-markup-specials
 279                      :before     'muse-docbook-prepare-buffer
 280                      :after      'muse-docbook-finalize-buffer
 281                      :header     'muse-docbook-header
 282                      :footer     'muse-docbook-footer
 283                      :browser    'find-file))
 284
 285 (provide 'muse-docbook)
 286
 287 ;;; muse-docbook.el ends here