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
  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-publishing-directive \"author\")</lisp></author>
  59     <pubdate><lisp>(muse-publishing-directive \"date\")</lisp></pubdate>
  60   </articleinfo>
  61   <!-- Page published by Emacs Muse begins here -->\n"
  62   "Header used for publishing DocBook XML files."
  63   :type '(choice string file)
  64   :group 'muse-docbook)
  65
  66 (defcustom muse-docbook-footer "
  67   <!-- Page published by Emacs Muse ends here -->
  68 </article>\n"
  69   "Footer used for publishing DocBook XML files."
  70   :type '(choice string file)
  71   :group 'muse-docbook)
  72
  73 (defcustom muse-docbook-markup-regexps
  74   `(;; join together the parts of a list or table
  75     (10000 "</\\([oud]l\\)>\\s-*<\\1>\\s-*" 0 "")
  76     (10100 "</tbody>\\s-*</table>\\s-*<table[^>]*>\\s-*<tbody>\\s-*" 0 "")
  77     (10200 "</table>\\s-*<table[^>]*>\\s-*" 0 "")
  78
  79     ;; Merge consecutive list tags
  80     (10300 ,(concat "</\\(itemized\\|ordered\\|variable\\)list>"
  81                     "\\s-*<\\1list" "[^>]*>\\s-*") 0 "")
  82
  83     ;; beginning of doc, end of doc, or plain paragraph separator
  84     (10400 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?"
  85                     "\\(?:\n\\(["
  86                     muse-regexp-blank
  87                     "]*\n\\)+\\|\\`\\s-*\\|\\s-*\\'\\)"
  88                     "\\(<\\(blockquote\\|center\\)>\n\\)?")
  89            0 muse-docbook-markup-paragraph))
  90   "List of markup rules for publishing a Muse page to DocBook XML.
  91 For more on the structure of this list, see `muse-publish-markup-regexps'."
  92   :type '(repeat (choice
  93                   (list :tag "Markup rule"
  94                         integer
  95                         (choice regexp symbol)
  96                         integer
  97                         (choice string function symbol))
  98                   function))
  99   :group 'muse-docbook)
 100
 101 (defcustom muse-docbook-markup-functions
 102   '((table . muse-docbook-markup-table))
 103   "An alist of style types to custom functions for that kind of text.
 104 For more on the structure of this list, see
 105 `muse-publish-markup-functions'."
 106   :type '(alist :key-type symbol :value-type function)
 107   :group 'muse-docbook)
 108
 109 (defcustom muse-docbook-markup-strings
 110   '((url-link        . "<ulink url=\"%s\">%s</ulink>")
 111     (email-addr      . "<email>%s</email>")
 112     (emdash          . " &mdash; ")
 113     (rule            . "")
 114     (enddots         . "....")
 115     (dots            . "...")
 116     (section         . "<section><title>")
 117     (section-end     . "</title>")
 118     (subsection      . "<section><title>")
 119     (subsection-end  . "</title>")
 120     (subsubsection   . "<section><title>")
 121     (subsubsection-end . "</title>")
 122     (footnote        . "<footnote><para>")
 123     (footnote-end    . "</para></footnote>")
 124     (begin-underline . "")
 125     (end-underline   . "")
 126     (begin-literal   . "<filename>")
 127     (end-literal     . "</filename>")
 128     (begin-emph      . "<emphasis>")
 129     (end-emph        . "</emphasis>")
 130     (begin-more-emph . "<emphasis role=\"strong\">")
 131     (end-more-emph   . "</emphasis>")
 132     (begin-most-emph . "<emphasis role=\"strong\"><emphasis>")
 133     (end-most-emph   . "</emphasis></emphasis>")
 134     (begin-verse     . "<literallayout>\n")
 135     (verse-space     . "  ")
 136     (end-verse       . "</literallayout>")
 137     (begin-example   . "<programlisting>")
 138     (end-example     . "</programlisting>")
 139     (begin-center    . "<center>\n")
 140     (end-center      . "\n</center>")
 141     (begin-quote     . "<blockquote>\n")
 142     (end-quote       . "\n</blockquote>")
 143     (begin-uli       . "<itemizedlist mark=\"bullet\">\n<listitem><para>")
 144     (end-uli         . "</para></listitem>\n</itemizedlist>")
 145     (begin-oli       . "<orderedlist>\n<listitem><para>")
 146     (end-oli         . "</para></listitem>\n</orderedlist>")
 147     (begin-ddt       . "<variablelist>\n<varlistentry>\n<term>")
 148     (start-dde       . "</term>\n<listitem><para>")
 149     (end-ddt         . "</para></listitem>\n</varlistentry>\n</variablelist>"))
 150   "Strings used for marking up text.
 151 These cover the most basic kinds of markup, the handling of which
 152 differs little between the various styles."
 153   :type '(alist :key-type symbol :value-type string)
 154   :group 'muse-docbook)
 155
 156 (defcustom muse-docbook-markup-specials
 157   '((?\" . "&quot;")
 158     (?\< . "&lt;")
 159     (?\> . "&gt;")
 160     (?\& . "&amp;"))
 161   "A table of characters which must be represented specially."
 162   :type '(alist :key-type character :value-type string)
 163   :group 'muse-docbook)
 164
 165 (defcustom muse-docbook-encoding-default 'utf-8
 166   "The default Emacs buffer encoding to use in published files.
 167 This will be used if no special characters are found."
 168   :type 'symbol
 169   :group 'muse-docbook)
 170
 171 (defcustom muse-docbook-charset-default "utf-8"
 172   "The default DocBook XML charset to use if no translation is
 173 found in `muse-docbook-encoding-map'."
 174   :type 'string
 175   :group 'muse-docbook)
 176
 177 (defcustom muse-docbook-encoding-map
 178   '((iso-8859-1         . "iso-8859-1")
 179     (iso-2022-jp        . "iso-2022-jp")
 180     (utf-8              . "utf-8")
 181     (japanese-iso-8bit  . "euc-jp")
 182     (chinese-big5       . "big5")
 183     (mule-utf-8         . "utf-8")
 184     (chinese-iso-8bit   . "gb2312")
 185     (chinese-gbk        . "gbk"))
 186   "An alist mapping emacs coding systems to appropriate DocBook charsets.
 187 Use the base name of the coding system (i.e. without the -unix)."
 188   :type '(alist :key-type coding-system :value-type string)
 189   :group 'muse-docbook)
 190
 191 (defun muse-docbook-transform-content-type (content-type)
 192   "Using `muse-docbook-encoding-map', try and resolve an emacs
 193 coding system to an associated DocBook XML coding system. If no
 194 match is found, `muse-docbook-charset-default' is used instead."
 195   (let ((match (assoc (coding-system-base content-type)
 196                       muse-docbook-encoding-map)))
 197     (if match
 198         (cdr match)
 199       muse-docbook-charset-default)))
 200
 201 (defun muse-docbook-encoding ()
 202   (muse-docbook-transform-content-type
 203    (or buffer-file-coding-system
 204        muse-docbook-encoding-default)))
 205
 206 (defun muse-docbook-markup-paragraph ()
 207   (let ((end (copy-marker (match-end 0) t)))
 208     (goto-char (match-beginning 0))
 209     (when (save-excursion
 210             (save-match-data
 211               (and (re-search-backward "<\\(/?\\)para[ >]" nil t)
 212                    (not (string-equal (match-string 1) "/")))))
 213       (insert "</para>"))
 214     (goto-char end))
 215   (if (eobp)
 216       (cond
 217        ((bolp)
 218         nil)
 219        (t
 220         (insert "\n")))
 221     (unless (eq (char-after) ?\<)
 222       (insert "<para>"))))
 223
 224 (defun muse-docbook-markup-table ()
 225   (let* ((str (save-match-data
 226                 (if (featurep 'xemacs)
 227                     ;; more emacs divergence. :(
 228                     (replace-in-string (match-string 1) " *|+ *$" "")
 229                   (match-string 1))))
 230          (fields (append (save-match-data
 231                            (split-string str (concat "["
 232                                                      muse-regexp-blank
 233                                                      "]*|+["
 234                                                      muse-regexp-blank
 235                                                      "]*")))
 236                          (list (match-string 4))))
 237          (len (length (match-string 3)))
 238          (row (cond ((= len 1) "tbody")
 239                     ((= len 2) "thead")
 240                     ((= len 3) "tfoot")))
 241          (col "entry"))
 242     (concat "<table>\n" "<" row ">\n" "<row>\n<" col ">"
 243             (mapconcat 'identity fields (format "</%s><%s>" col col))
 244             "</" col ">\n" "</row>\n" "</" row ">\n"
 245             "</table>\n")))
 246
 247 (defun muse-docbook-fixup-sections ()
 248   "Add </section> tags."
 249   (goto-char (point-min))
 250   (let (last)
 251     (while (re-search-forward "\n*<section>" nil t)
 252       (when last
 253         (replace-match "\n</section>\n\n<section>"))
 254       (setq last (match-beginning 0)))
 255     (when last
 256       (goto-char (point-max))
 257       (insert "</section>"))))
 258
 259 (defun muse-docbook-finalize-buffer ()
 260   (when (memq buffer-file-coding-system '(no-conversion undecided-unix))
 261     ;; make it agree with the default charset
 262     (setq buffer-file-coding-system muse-docbook-encoding-default)))
 263
 264 ;; Register the Muse DocBook XML Publisher
 265
 266 (unless (assoc "docbook" muse-publishing-styles)
 267   (muse-define-style "docbook"
 268                      :suffix     'muse-docbook-extension
 269                      :regexps    'muse-docbook-markup-regexps
 270                      :functions  'muse-docbook-markup-functions
 271                      :strings    'muse-docbook-markup-strings
 272                      :specials   'muse-docbook-markup-specials
 273                      :before-end 'muse-docbook-fixup-sections
 274                      :after      'muse-docbook-finalize-buffer
 275                      :header     'muse-docbook-header
 276                      :footer     'muse-docbook-footer
 277                      :browser    'find-file))
 278
 279 (provide 'muse-docbook)
 280
 281 ;;; muse-docbook.el ends here