Add COPYING file; update headers.
[muse-el.git] / lisp / muse-docbook.el
blobf11cec8a1bd5f00b11342cd960a54342266781fb
1 ;;; muse-docbook.el --- publish DocBook files
3 ;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
5 ;; This file is part of Emacs Muse. It is not part of GNU Emacs.
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.
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.
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.
22 ;;; Commentary:
24 ;;; Contributors:
26 ;; Dale P. Smith (dpsm AT en DOT com) improved the markup
27 ;; significantly and made many valuable suggestions.
29 ;;; Code:
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 ;; Muse DocBook XML Publishing
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37 (require 'muse-publish)
38 (require 'muse-regexps)
39 (require 'muse-xml-common)
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)
46 (defcustom muse-docbook-extension ".xml"
47 "Default file extension for publishing DocBook XML files."
48 :type 'string
49 :group 'muse-docbook)
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)
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)
77 (defcustom muse-docbook-markup-regexps
78 `(;; Beginning of doc, end of doc, or plain paragraph separator
79 (10000 ,(concat "\\(\\(\n\\([" muse-regexp-blank "]*\n\\)+\\)"
80 "\\|\\`\\s-*\\|\\s-*\\'\\)")
81 0 muse-docbook-markup-paragraph))
82 "List of markup rules for publishing a Muse page to DocBook XML.
83 For more on the structure of this list, see `muse-publish-markup-regexps'."
84 :type '(repeat (choice
85 (list :tag "Markup rule"
86 integer
87 (choice regexp symbol)
88 integer
89 (choice string function symbol))
90 function))
91 :group 'muse-docbook)
93 (defcustom muse-docbook-markup-functions
94 '((anchor . muse-xml-markup-anchor)
95 (table . muse-xml-markup-table))
96 "An alist of style types to custom functions for that kind of text.
97 For more on the structure of this list, see
98 `muse-publish-markup-functions'."
99 :type '(alist :key-type symbol :value-type function)
100 :group 'muse-docbook)
102 (defcustom muse-docbook-markup-strings
103 '((anchor-ref . "<link linkend=\"%s\">%s</link>")
104 (url . "<ulink url=\"%s\">%s</ulink>")
105 (link . "<ulink url=\"%s\">%s</ulink>")
106 (link-and-anchor . "<ulink url=\"%s#%s\">%s</ulink>")
107 (email-addr . "<email>%s</email>")
108 (anchor . "<anchor id=\"%s\" />\n")
109 (emdash . " &mdash; ")
110 (comment-begin . "<!-- ")
111 (comment-end . " -->")
112 (rule . "")
113 (no-break-space . "&nbsp;")
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 (section-other . "<section><title>")
123 (section-other-end . "</title>")
124 (section-close . "</section>")
125 (footnote . "<footnote><para>")
126 (footnote-end . "</para></footnote>")
127 (begin-underline . "")
128 (end-underline . "")
129 (begin-literal . "<systemitem>")
130 (end-literal . "</systemitem>")
131 (begin-emph . "<emphasis>")
132 (end-emph . "</emphasis>")
133 (begin-more-emph . "<emphasis role=\"strong\">")
134 (end-more-emph . "</emphasis>")
135 (begin-most-emph . "<emphasis role=\"strong\"><emphasis>")
136 (end-most-emph . "</emphasis></emphasis>")
137 (begin-verse . "<literallayout>\n")
138 (verse-space . " ")
139 (end-verse . "</literallayout>")
140 (begin-example . "<programlisting>")
141 (end-example . "</programlisting>")
142 (begin-center . "<para role=\"centered\">\n")
143 (end-center . "\n</para>")
144 (begin-quote . "<blockquote>\n")
145 (end-quote . "\n</blockquote>")
146 (begin-quote-item . "<para>")
147 (end-quote-item . "</para>")
148 (begin-uli . "<itemizedlist mark=\"bullet\">\n")
149 (end-uli . "\n</itemizedlist>")
150 (begin-uli-item . "<listitem><para>")
151 (end-uli-item . "</para></listitem>")
152 (begin-oli . "<orderedlist>\n")
153 (end-oli . "\n</orderedlist>")
154 (begin-oli-item . "<listitem><para>")
155 (end-oli-item . "</para></listitem>")
156 (begin-dl . "<variablelist>\n")
157 (end-dl . "\n</variablelist>")
158 (begin-dl-item . "<varlistentry>\n")
159 (end-dl-item . "\n</varlistentry>")
160 (begin-ddt . "<term>")
161 (end-ddt . "</term>")
162 (begin-dde . "<listitem><para>")
163 (end-dde . "</para></listitem>")
164 (begin-table . "<informaltable>\n")
165 (end-table . "</informaltable>")
166 (begin-table-group . " <tgroup cols='%s'>\n")
167 (end-table-group . " </tgroup>\n")
168 (begin-table-row . " <row>\n")
169 (end-table-row . " </row>\n")
170 (begin-table-entry . " <entry>")
171 (end-table-entry . "</entry>\n"))
172 "Strings used for marking up text.
173 These cover the most basic kinds of markup, the handling of which
174 differs little between the various styles."
175 :type '(alist :key-type symbol :value-type string)
176 :group 'muse-docbook)
178 (defcustom muse-docbook-encoding-default 'utf-8
179 "The default Emacs buffer encoding to use in published files.
180 This will be used if no special characters are found."
181 :type 'symbol
182 :group 'muse-docbook)
184 (defcustom muse-docbook-charset-default "utf-8"
185 "The default DocBook XML charset to use if no translation is
186 found in `muse-docbook-encoding-map'."
187 :type 'string
188 :group 'muse-docbook)
190 (defun muse-docbook-encoding ()
191 (muse-xml-transform-content-type
192 (or (and (boundp 'buffer-file-coding-system)
193 buffer-file-coding-system)
194 muse-docbook-encoding-default)
195 muse-docbook-charset-default))
197 (defun muse-docbook-markup-paragraph ()
198 (let ((end (copy-marker (match-end 0) t)))
199 (goto-char (match-beginning 0))
200 (when (save-excursion
201 (save-match-data
202 (and (re-search-backward "<\\(/?\\)\\(para\\|footnote\\)[ >]"
203 nil t)
204 (or (and (string= (match-string 2) "para")
205 (not (string= (match-string 1) "/")))
206 (and (string= (match-string 2) "footnote")
207 (string= (match-string 1) "/"))))))
208 (when (get-text-property (1- (point)) 'end-list)
209 (goto-char (previous-single-property-change (1- (point)) 'end-list)))
210 (muse-insert-markup "</para>"))
211 (goto-char end))
212 (cond
213 ((eobp)
214 (unless (bolp)
215 (insert "\n")))
216 ((eq (char-after) ?\<)
217 (when (looking-at (concat "<\\(emphasis\\|systemitem"
218 "\\|u?link\\|anchor\\|email\\)[ >]"))
219 (muse-insert-markup "<para>")))
221 (muse-insert-markup "<para>"))))
223 (defun muse-docbook-get-author (&optional author)
224 "Split the AUTHOR directive into separate fields.
225 AUTHOR should be of the form: \"Firstname Other Names Lastname\",
226 and anything after `Firstname' is optional."
227 (setq author (save-match-data (split-string author)))
228 (let ((num-el (length author)))
229 (cond ((eq num-el 1)
230 (concat "<firstname>" (car author) "</firstname>"))
231 ((eq num-el 2)
232 (concat "<firstname>" (nth 0 author) "</firstname>"
233 "<surname>" (nth 1 author) "</surname>"))
234 ((eq num-el 3)
235 (concat "<firstname>" (nth 0 author) "</firstname>"
236 "<othername>" (nth 1 author) "</othername>"
237 "<surname>" (nth 2 author) "</surname>"))
239 (let (first last)
240 (setq first (car author))
241 (setq author (nreverse (cdr author)))
242 (setq last (car author))
243 (setq author (nreverse (cdr author)))
244 (concat "<firstname>" first "</firstname>"
245 "<othername>"
246 (mapconcat 'identity author " ")
247 "</othername>"
248 "<surname>" last "</surname>"))))))
250 (defun muse-docbook-finalize-buffer ()
251 (when (boundp 'buffer-file-coding-system)
252 (when (memq buffer-file-coding-system '(no-conversion undecided-unix))
253 ;; make it agree with the default charset
254 (setq buffer-file-coding-system muse-docbook-encoding-default))))
256 ;; Register the Muse DocBook XML Publisher
258 (unless (assoc "docbook" muse-publishing-styles)
259 (muse-define-style "docbook"
260 :suffix 'muse-docbook-extension
261 :regexps 'muse-docbook-markup-regexps
262 :functions 'muse-docbook-markup-functions
263 :strings 'muse-docbook-markup-strings
264 :specials 'muse-xml-decide-specials
265 :after 'muse-docbook-finalize-buffer
266 :header 'muse-docbook-header
267 :footer 'muse-docbook-footer
268 :browser 'find-file))
270 (provide 'muse-docbook)
272 ;;; muse-docbook.el ends here