« back to all changes in this revision
Viewing changes to lisp/muse-docbook.el
- browse files at revision 1
- compare with another revision
- compare with revision 6
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Michael W. Olson (GNU address)
- Date: 2005-12-17 12:11:27 UTC
- Revision ID: james.westby@ubuntu.com-20051217121127-b4yfr70a7hnrexdg
Tags: upstream-3.02.5
Import upstream version 3.02.5
- files added:
- contrib
- contrib/pyblosxom
- examples
- examples/johnw
- examples/mwolson
- examples/mwolson/stylesheets
- examples/mwolson/templates
- experimental
- lisp
- scripts
added
removed
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-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 . " — ")
130
(comment-begin . "<!-- ")
131
(comment-end . " -->")
132
(rule . "")
133
(enddots . "....")
134
(dots . "...")
135
(section . "<section><title>")
136
(section-end . "</title>")
137
(subsection . "<section><title>")
138
(subsection-end . "</title>")
139
(subsubsection . "<section><title>")
140
(subsubsection-end . "</title>")
141
(section-other . "<section><title>")
142
(section-other-end . "</title>")
143
(section-close . "</section>")
144
(footnote . "<footnote><para>")
145
(footnote-end . "</para></footnote>")
146
(begin-underline . "")
147
(end-underline . "")
148
(begin-literal . "<systemitem>")
149
(end-literal . "</systemitem>")
150
(begin-emph . "<emphasis>")
151
(end-emph . "</emphasis>")
152
(begin-more-emph . "<emphasis role=\"strong\">")
153
(end-more-emph . "</emphasis>")
154
(begin-most-emph . "<emphasis role=\"strong\"><emphasis>")
155
(end-most-emph . "</emphasis></emphasis>")
156
(begin-verse . "<literallayout>\n")
157
(verse-space . " ")
158
(end-verse . "</literallayout>")
159
(begin-example . "<programlisting>")
160
(end-example . "</programlisting>")
161
(begin-center . "<para role=\"centered\">\n")
162
(end-center . "\n</para>")
163
(begin-quote . "<blockquote>\n")
164
(end-quote . "\n</blockquote>")
165
(begin-uli . "<itemizedlist mark=\"bullet\">\n<listitem><para>")
166
(end-uli . "</para></listitem>\n</itemizedlist>")
167
(begin-oli . "<orderedlist>\n<listitem><para>")
168
(end-oli . "</para></listitem>\n</orderedlist>")
169
(begin-ddt . "<variablelist>\n<varlistentry>\n<term>")
170
(start-dde . "</term>\n<listitem><para>")
171
(end-ddt . "</para></listitem>\n</varlistentry>\n</variablelist>"))
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)
177
178
(defcustom muse-docbook-markup-specials
179
'((?\" . """)
180
(?\< . "<")
181
(?\> . ">")
182
(?\& . "&"))
183
"A table of characters which must be represented specially."
184
:type '(alist :key-type character :value-type string)
185
:group 'muse-docbook)
186
187
(defcustom muse-docbook-encoding-default 'utf-8
188
"The default Emacs buffer encoding to use in published files.
189
This will be used if no special characters are found."
190
:type 'symbol
191
:group 'muse-docbook)
192
193
(defcustom muse-docbook-charset-default "utf-8"
194
"The default DocBook XML charset to use if no translation is
195
found in `muse-docbook-encoding-map'."
196
:type 'string
197
:group 'muse-docbook)
198
199
(defcustom muse-docbook-encoding-map
200
'((iso-8859-1 . "iso-8859-1")
201
(iso-2022-jp . "iso-2022-jp")
202
(utf-8 . "utf-8")
203
(japanese-iso-8bit . "euc-jp")
204
(chinese-big5 . "big5")
205
(mule-utf-8 . "utf-8")
206
(chinese-iso-8bit . "gb2312")
207
(chinese-gbk . "gbk"))
208
"An alist mapping emacs coding systems to appropriate DocBook charsets.
209
Use the base name of the coding system (i.e. without the -unix)."
210
:type '(alist :key-type coding-system :value-type string)
211
:group 'muse-docbook)
212
213
(defun muse-docbook-transform-content-type (content-type)
214
"Using `muse-docbook-encoding-map', try and resolve an emacs
215
coding system to an associated DocBook XML coding system. If no
216
match is found, `muse-docbook-charset-default' is used instead."
217
(let ((match (and (fboundp 'coding-system-base)
218
(assoc (coding-system-base content-type)
219
muse-docbook-encoding-map))))
220
(if match
221
(cdr match)
222
muse-docbook-charset-default)))
223
224
(defun muse-docbook-encoding ()
225
(muse-docbook-transform-content-type
226
(or (and (boundp 'buffer-file-coding-system)
227
buffer-file-coding-system)
228
muse-docbook-encoding-default)))
229
230
(defun muse-docbook-markup-paragraph ()
231
(let ((end (copy-marker (match-end 0) t)))
232
(goto-char (match-beginning 0))
233
(when (save-excursion
234
(save-match-data
235
(and (re-search-backward "<\\(/?\\)\\(para\\|footnote\\)[ >]"
236
nil t)
237
(or (and (string= (match-string 2) "para")
238
(not (string= (match-string 1) "/")))
239
(and (string= (match-string 2) "footnote")
240
(string= (match-string 1) "/"))))))
241
(insert "</para>"))
242
(goto-char end))
243
(cond
244
((eobp)
245
(unless (bolp)
246
(insert "\n")))
247
((eq (char-after) ?\<)
248
(when (looking-at (concat "<\\(emphasis\\|systemitem"
249
"\\|u?link\\|anchor\\|email\\)[ >]"))
250
(insert "<para>")))
251
(t
252
(insert "<para>"))))
253
254
(defun muse-docbook-insert-anchor (anchor)
255
"Insert an anchor, either before the next word, or within a tag."
256
(skip-chars-forward muse-regexp-space)
257
(when (looking-at "<\\([^ />]+\\)>")
258
(goto-char (match-end 0)))
259
(insert "<anchor id=\"" anchor "\" />\n"))
260
261
(defun muse-docbook-markup-anchor ()
262
(save-match-data
263
(muse-docbook-insert-anchor (match-string 2)))
264
(match-string 1))
265
266
(defun muse-docbook-markup-table ()
267
(let* ((str (prog1
268
(match-string 1)
269
(delete-region (match-beginning 0) (match-end 0))))
270
(fields (split-string str "\\s-*|+\\s-*"))
271
(type (and (string-match "\\s-*\\(|+\\)\\s-*" str)
272
(length (match-string 1 str))))
273
(part (cond ((= type 1) "tbody")
274
((= type 2) "thead")
275
((= type 3) "tfoot"))))
276
(insert "<informaltable>\n"
277
" <tgroup cols='" (number-to-string (length fields)) "'>\n"
278
" <" part ">\n"
279
" <row>\n")
280
(dolist (field fields)
281
(insert " <entry>" field "</entry>\n"))
282
(insert " </row>\n"
283
" </" part ">\n"
284
" </tgroup>\n"
285
"</informaltable>\n")))
286
287
(defun muse-docbook-get-author (&optional author)
288
"Split the AUTHOR directive into separate fields.
289
AUTHOR should be of the form: \"Firstname Other Names Lastname\",
290
and anything after `Firstname' is optional."
291
(setq author (save-match-data (split-string author)))
292
(let ((num-el (length author)))
293
(cond ((eq num-el 1)
294
(concat "<firstname>" (car author) "</firstname>"))
295
((eq num-el 2)
296
(concat "<firstname>" (nth 0 author) "</firstname>"
297
"<surname>" (nth 1 author) "</surname>"))
298
((eq num-el 3)
299
(concat "<firstname>" (nth 0 author) "</firstname>"
300
"<othername>" (nth 1 author) "</othername>"
301
"<surname>" (nth 2 author) "</surname>"))
302
(t
303
(let (first last)
304
(setq first (car author))
305
(setq author (nreverse (cdr author)))
306
(setq last (car author))
307
(setq author (nreverse (cdr author)))
308
(concat "<firstname>" first "</firstname>"
309
"<othername>"
310
(mapconcat 'identity author " ")
311
"</othername>"
312
"<surname>" last "</surname>"))))))
313
314
(defun muse-docbook-fixup-tables ()
315
"Sort table parts."
316
(goto-char (point-min))
317
(let (last)
318
(while (re-search-forward "^ *<tgroup[^>]*>$" nil t)
319
(unless (get-text-property (point) 'read-only)
320
(forward-line 1)
321
(save-restriction
322
(let ((beg (point)))
323
(narrow-to-region beg (and (re-search-forward "^ *</tgroup>"
324
nil t)
325
(match-beginning 0))))
326
(goto-char (point-min))
327
(let ((inhibit-read-only t))
328
(sort-subr nil
329
(function
330
(lambda ()
331
(if (re-search-forward
332
"^\\s-*<t\\(head\\|body\\|foot\\)>$" nil t)
333
(goto-char (match-beginning 0))
334
(goto-char (point-max)))))
335
(function
336
(lambda ()
337
(if (re-search-forward
338
"^\\s-*</t\\(head\\|body\\|foot\\)>$" nil t)
339
(goto-char (match-end 0))
340
(goto-char (point-max)))))
341
(function
342
(lambda ()
343
(looking-at "\\s-*<t\\(head\\|body\\|foot\\)>")
344
(cond ((string= (match-string 1) "head") 1)
345
((string= (match-string 1) "foot") 2)
346
(t 3)))))))))))
347
348
(defun muse-docbook-finalize-buffer ()
349
(when (boundp 'buffer-file-coding-system)
350
(when (memq buffer-file-coding-system '(no-conversion undecided-unix))
351
;; make it agree with the default charset
352
(setq buffer-file-coding-system muse-docbook-encoding-default))))
353
354
;; Register the Muse DocBook XML Publisher
355
356
(unless (assoc "docbook" muse-publishing-styles)
357
(muse-define-style "docbook"
358
:suffix 'muse-docbook-extension
359
:regexps 'muse-docbook-markup-regexps
360
:functions 'muse-docbook-markup-functions
361
:strings 'muse-docbook-markup-strings
362
:specials 'muse-docbook-markup-specials
363
:before-end 'muse-docbook-fixup-tables
364
:after 'muse-docbook-finalize-buffer
365
:header 'muse-docbook-header
366
:footer 'muse-docbook-footer
367
:browser 'find-file))
368
369
(provide 'muse-docbook)
370
371
;;; muse-docbook.el ends here
Loggerhead is a web-based interface for Breezy
Version: 2.0.1