lisp/muse-docbook.el

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