← Back to branch summary

~ubuntu-branches/ubuntu/vivid/muse-el/vivid

« back to all changes in this revision

Viewing changes to lisp/muse-docbook.el

  • Committer: Bazaar Package Importer
  • Author(s): Michael W. Olson (GNU address)
  • Date: 2007-06-25 08:17:44 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070625081744-h9xfz7c72h1pfyo6
Tags: 3.03-1ubuntu1
https://launchpad.net/bugs/123907
* Closes LP: #123907
* Sync with Debian.  Remaining changes:
  - Keep (add) manual.
* debian/control:
  - Set Ubuntu MOTU to be Maintainer and myself as
    XSBC-Original-Maintainer to silence warning.
* debian/rules;
  - Manual is now in texi/ directory.
  - Clean generated html files and info file for the manual.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/muse-docbook.el
1
1
;;; muse-docbook.el --- publish DocBook files
2
2
 
3
 
;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
 
3
;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
4
 
5
5
;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
6
6
 
36
36
 
37
37
(require 'muse-publish)
38
38
(require 'muse-regexps)
 
39
(require 'muse-xml-common)
39
40
 
40
41
(defgroup muse-docbook nil
41
42
  "Options controlling the behavior of Muse DocBook XML publishing.
74
75
  :group 'muse-docbook)
75
76
 
76
77
(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))
 
78
  `(;; Beginning of doc, end of doc, or plain paragraph separator
 
79
    (10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*"
 
80
                    "\\([" muse-regexp-blank "]*\n\\)\\)"
 
81
                    "\\|\\`\\s-*\\|\\s-*\\'\\)")
 
82
           3 muse-docbook-markup-paragraph))
105
83
  "List of markup rules for publishing a Muse page to DocBook XML.
106
84
For more on the structure of this list, see `muse-publish-markup-regexps'."
107
85
  :type '(repeat (choice
114
92
  :group 'muse-docbook)
115
93
 
116
94
(defcustom muse-docbook-markup-functions
117
 
  '((anchor . muse-docbook-markup-anchor)
118
 
    (table . muse-docbook-markup-table))
 
95
  '((anchor . muse-xml-markup-anchor)
 
96
    (table . muse-xml-markup-table))
119
97
  "An alist of style types to custom functions for that kind of text.
120
98
For more on the structure of this list, see
121
99
`muse-publish-markup-functions'."
123
101
  :group 'muse-docbook)
124
102
 
125
103
(defcustom muse-docbook-markup-strings
126
 
  '((url-link        . "<ulink url=\"%s\">%s</ulink>")
127
 
    (internal-link   . "<link linkend=\"%s\">%s</link>")
 
104
  '((image-with-desc . "<mediaobject>
 
105
<imageobject>
 
106
<imagedata fileref=\"%1%.%2%\" format=\"%2%\" />
 
107
</imageobject>
 
108
<caption><para>%3%</para></caption>
 
109
</mediaobject>")
 
110
    (image           . "<inlinemediaobject><imageobject>
 
111
<imagedata fileref=\"%1%.%2%\" format=\"%2%\" />
 
112
</imageobject></inlinemediaobject>")
 
113
    (image-link      . "<ulink url=\"%1%\"><inlinemediaobject><imageobject>
 
114
<imagedata fileref=\"%2%.%3%\" format=\"%3%\" />
 
115
</imageobject></inlinemediaobject></ulink>")
 
116
    (anchor-ref      . "<link linkend=\"%s\">%s</link>")
 
117
    (url             . "<ulink url=\"%s\">%s</ulink>")
 
118
    (link            . "<ulink url=\"%s\">%s</ulink>")
 
119
    (link-and-anchor . "<ulink url=\"%s#%s\">%s</ulink>")
128
120
    (email-addr      . "<email>%s</email>")
129
 
    (emdash          . " &mdash; ")
 
121
    (anchor          . "<anchor id=\"%s\" />\n")
 
122
    (emdash          . "%s&mdash;%s")
130
123
    (comment-begin   . "<!-- ")
131
124
    (comment-end     . " -->")
132
125
    (rule            . "")
163
156
    (end-center      . "\n</para>")
164
157
    (begin-quote     . "<blockquote>\n")
165
158
    (end-quote       . "\n</blockquote>")
166
 
    (begin-uli       . "<itemizedlist mark=\"bullet\">\n<listitem><para>")
167
 
    (end-uli         . "</para></listitem>\n</itemizedlist>")
168
 
    (begin-oli       . "<orderedlist>\n<listitem><para>")
169
 
    (end-oli         . "</para></listitem>\n</orderedlist>")
170
 
    (begin-ddt       . "<variablelist>\n<varlistentry>\n<term>")
171
 
    (start-dde       . "</term>\n<listitem><para>")
172
 
    (end-ddt         . "</para></listitem>\n</varlistentry>\n</variablelist>"))
 
159
    (begin-quote-item . "<para>")
 
160
    (end-quote-item  . "</para>")
 
161
    (begin-uli       . "<itemizedlist mark=\"bullet\">\n")
 
162
    (end-uli         . "\n</itemizedlist>")
 
163
    (begin-uli-item  . "<listitem><para>")
 
164
    (end-uli-item    . "</para></listitem>")
 
165
    (begin-oli       . "<orderedlist>\n")
 
166
    (end-oli         . "\n</orderedlist>")
 
167
    (begin-oli-item  . "<listitem><para>")
 
168
    (end-oli-item    . "</para></listitem>")
 
169
    (begin-dl        . "<variablelist>\n")
 
170
    (end-dl          . "\n</variablelist>")
 
171
    (begin-dl-item   . "<varlistentry>\n")
 
172
    (end-dl-item     . "\n</varlistentry>")
 
173
    (begin-ddt       . "<term>")
 
174
    (end-ddt         . "</term>")
 
175
    (begin-dde       . "<listitem><para>")
 
176
    (end-dde         . "</para></listitem>")
 
177
    (begin-table     . "<informaltable>\n")
 
178
    (end-table       . "</informaltable>")
 
179
    (begin-table-group . "  <tgroup cols='%s'>\n")
 
180
    (end-table-group . "  </tgroup>\n")
 
181
    (begin-table-row . "    <row>\n")
 
182
    (end-table-row   . "    </row>\n")
 
183
    (begin-table-entry . "      <entry>")
 
184
    (end-table-entry . "</entry>\n"))
173
185
  "Strings used for marking up text.
174
186
These cover the most basic kinds of markup, the handling of which
175
187
differs little between the various styles."
176
188
  :type '(alist :key-type symbol :value-type string)
177
189
  :group 'muse-docbook)
178
190
 
179
 
(defcustom muse-docbook-markup-specials
180
 
  '((?\" . "&quot;")
181
 
    (?\< . "&lt;")
182
 
    (?\> . "&gt;")
183
 
    (?\& . "&amp;"))
184
 
  "A table of characters which must be represented specially."
185
 
  :type '(alist :key-type character :value-type string)
186
 
  :group 'muse-docbook)
187
 
 
188
191
(defcustom muse-docbook-encoding-default 'utf-8
189
192
  "The default Emacs buffer encoding to use in published files.
190
193
This will be used if no special characters are found."
197
200
  :type 'string
198
201
  :group 'muse-docbook)
199
202
 
200
 
(defcustom muse-docbook-encoding-map
201
 
  '((iso-8859-1         . "iso-8859-1")
202
 
    (iso-2022-jp        . "iso-2022-jp")
203
 
    (utf-8              . "utf-8")
204
 
    (japanese-iso-8bit  . "euc-jp")
205
 
    (chinese-big5       . "big5")
206
 
    (mule-utf-8         . "utf-8")
207
 
    (chinese-iso-8bit   . "gb2312")
208
 
    (chinese-gbk        . "gbk"))
209
 
  "An alist mapping emacs coding systems to appropriate DocBook charsets.
210
 
Use the base name of the coding system (i.e. without the -unix)."
211
 
  :type '(alist :key-type coding-system :value-type string)
212
 
  :group 'muse-docbook)
213
 
 
214
 
(defun muse-docbook-transform-content-type (content-type)
215
 
  "Using `muse-docbook-encoding-map', try and resolve an emacs
216
 
coding system to an associated DocBook XML coding system. If no
217
 
match is found, `muse-docbook-charset-default' is used instead."
218
 
  (let ((match (and (fboundp 'coding-system-base)
219
 
                    (assoc (coding-system-base content-type)
220
 
                           muse-docbook-encoding-map))))
221
 
    (if match
222
 
        (cdr match)
223
 
      muse-docbook-charset-default)))
224
 
 
225
203
(defun muse-docbook-encoding ()
226
 
  (muse-docbook-transform-content-type
 
204
  (muse-xml-transform-content-type
227
205
   (or (and (boundp 'buffer-file-coding-system)
228
206
            buffer-file-coding-system)
229
 
       muse-docbook-encoding-default)))
 
207
       muse-docbook-encoding-default)
 
208
   muse-docbook-charset-default))
230
209
 
231
210
(defun muse-docbook-markup-paragraph ()
232
 
  (let ((end (copy-marker (match-end 0) t)))
233
 
    (goto-char (match-beginning 0))
234
 
    (when (save-excursion
235
 
            (save-match-data
236
 
              (and (re-search-backward "<\\(/?\\)\\(para\\|footnote\\)[ >]"
237
 
                                       nil t)
238
 
                   (or (and (string= (match-string 2) "para")
239
 
                            (not (string= (match-string 1) "/")))
240
 
                       (and (string= (match-string 2) "footnote")
241
 
                            (string= (match-string 1) "/"))))))
242
 
      (insert "</para>"))
243
 
    (goto-char end))
244
 
  (cond
245
 
   ((eobp)
246
 
    (unless (bolp)
247
 
      (insert "\n")))
248
 
   ((eq (char-after) ?\<)
249
 
    (when (looking-at (concat "<\\(emphasis\\|systemitem"
250
 
                              "\\|u?link\\|anchor\\|email\\)[ >]"))
251
 
      (insert "<para>")))
252
 
   (t
253
 
    (insert "<para>"))))
254
 
 
255
 
(defun muse-docbook-insert-anchor (anchor)
256
 
  "Insert an anchor, either before the next word, or within a tag."
257
 
  (unless (get-text-property (match-end 1) 'noemphasis)
258
 
    (skip-chars-forward (concat muse-regexp-blank "\n"))
259
 
    (when (looking-at "<\\([^ />]+\\)>")
260
 
      (goto-char (match-end 0)))
261
 
    (insert "<anchor id=\"" anchor "\" />\n")))
262
 
 
263
 
(defun muse-docbook-markup-anchor ()
264
 
  (save-match-data
265
 
    (muse-docbook-insert-anchor (match-string 2)))
266
 
  (match-string 1))
267
 
 
268
 
(defun muse-docbook-markup-table ()
269
 
  (let* ((str (prog1
270
 
                  (match-string 1)
271
 
                (delete-region (match-beginning 0) (match-end 0))))
272
 
         (fields (split-string str "\\s-*|+\\s-*"))
273
 
         (type (and (string-match "\\s-*\\(|+\\)\\s-*" str)
274
 
                    (length (match-string 1 str))))
275
 
         (part (cond ((= type 1) "tbody")
276
 
                     ((= type 2) "thead")
277
 
                     ((= type 3) "tfoot"))))
278
 
    (insert "<informaltable>\n"
279
 
            "  <tgroup cols='" (number-to-string (length fields)) "'>\n"
280
 
            "  <" part ">\n"
281
 
            "    <row>\n")
282
 
    (dolist (field fields)
283
 
      (insert "      <entry>" field "</entry>\n"))
284
 
    (insert "    </row>\n"
285
 
            "  </" part ">\n"
286
 
            "  </tgroup>\n"
287
 
            "</informaltable>\n")))
 
211
  (catch 'bail-out
 
212
    (let ((end (copy-marker (match-end 0) t)))
 
213
      (goto-char (match-beginning 0))
 
214
      (when (save-excursion
 
215
              (save-match-data
 
216
                (and (re-search-backward
 
217
                      "<\\(/?\\)\\(para\\|footnote\\|literallayout\\)[ >]"
 
218
                      nil t)
 
219
                     (cond ((string= (match-string 2) "literallayout")
 
220
                            (throw 'bail-out t))
 
221
                           ((string= (match-string 2) "para")
 
222
                            (and
 
223
                             (not (string= (match-string 1) "/"))
 
224
                             ;; don't mess up nested lists
 
225
                             (not (and (muse-looking-back "<listitem>")
 
226
                                       (throw 'bail-out t)))))
 
227
                           ((string= (match-string 2) "footnote")
 
228
                            (string= (match-string 1) "/"))
 
229
                           (t nil)))))
 
230
        (when (get-text-property (1- (point)) 'end-list)
 
231
          (goto-char (previous-single-property-change (1- (point)) 'end-list)))
 
232
        (muse-insert-markup "</para>"))
 
233
      (goto-char end))
 
234
    (cond
 
235
     ((eobp)
 
236
      (unless (bolp)
 
237
        (insert "\n")))
 
238
     ((eq (char-after) ?\<)
 
239
      (when (looking-at (concat "<\\(emphasis\\|systemitem\\|inlinemediaobject"
 
240
                                "\\|u?link\\|anchor\\|email\\)[ >]"))
 
241
        (muse-insert-markup "<para>")))
 
242
     (t
 
243
      (muse-insert-markup "<para>")))))
288
244
 
289
245
(defun muse-docbook-get-author (&optional author)
290
246
  "Split the AUTHOR directive into separate fields.
313
269
                     "</othername>"
314
270
                     "<surname>" last "</surname>"))))))
315
271
 
316
 
(defun muse-docbook-fixup-tables ()
317
 
  "Sort table parts."
 
272
(defun muse-docbook-fixup-images ()
318
273
  (goto-char (point-min))
319
 
  (let (last)
320
 
    (while (re-search-forward "^ *<tgroup[^>]*>$" nil t)
321
 
      (unless (get-text-property (point) 'read-only)
322
 
        (forward-line 1)
323
 
        (save-restriction
324
 
          (let ((beg (point)))
325
 
            (narrow-to-region beg (and (re-search-forward "^ *</tgroup>"
326
 
                                                          nil t)
327
 
                                       (match-beginning 0))))
328
 
          (goto-char (point-min))
329
 
          (let ((inhibit-read-only t))
330
 
            (sort-subr nil
331
 
                       (function
332
 
                        (lambda ()
333
 
                          (if (re-search-forward
334
 
                               "^\\s-*<t\\(head\\|body\\|foot\\)>$" nil t)
335
 
                              (goto-char (match-beginning 0))
336
 
                            (goto-char (point-max)))))
337
 
                       (function
338
 
                        (lambda ()
339
 
                          (if (re-search-forward
340
 
                               "^\\s-*</t\\(head\\|body\\|foot\\)>$" nil t)
341
 
                              (goto-char (match-end 0))
342
 
                            (goto-char (point-max)))))
343
 
                       (function
344
 
                        (lambda ()
345
 
                          (looking-at "\\s-*<t\\(head\\|body\\|foot\\)>")
346
 
                          (cond ((string= (match-string 1) "head") 1)
347
 
                                ((string= (match-string 1) "foot") 2)
348
 
                                (t 3)))))))))))
 
274
  (while (re-search-forward (concat "<imagedata fileref=\"[^\"]+\""
 
275
                                    " format=\"\\([^\"]+\\)\" />$")
 
276
                            nil t)
 
277
    (replace-match (upcase (match-string 1)) t t nil 1)))
 
278
 
 
279
(defun muse-docbook-munge-buffer ()
 
280
  (muse-docbook-fixup-images))
349
281
 
350
282
(defun muse-docbook-finalize-buffer ()
351
283
  (when (boundp 'buffer-file-coding-system)
353
285
      ;; make it agree with the default charset
354
286
      (setq buffer-file-coding-system muse-docbook-encoding-default))))
355
287
 
356
 
;; Register the Muse DocBook XML Publisher
 
288
;;; Register the Muse DocBook XML Publisher
357
289
 
358
 
(unless (assoc "docbook" muse-publishing-styles)
359
 
  (muse-define-style "docbook"
360
 
                     :suffix     'muse-docbook-extension
361
 
                     :regexps    'muse-docbook-markup-regexps
362
 
                     :functions  'muse-docbook-markup-functions
363
 
                     :strings    'muse-docbook-markup-strings
364
 
                     :specials   'muse-docbook-markup-specials
365
 
                     :before-end 'muse-docbook-fixup-tables
366
 
                     :after      'muse-docbook-finalize-buffer
367
 
                     :header     'muse-docbook-header
368
 
                     :footer     'muse-docbook-footer
369
 
                     :browser    'find-file))
 
290
(muse-define-style "docbook"
 
291
                   :suffix     'muse-docbook-extension
 
292
                   :regexps    'muse-docbook-markup-regexps
 
293
                   :functions  'muse-docbook-markup-functions
 
294
                   :strings    'muse-docbook-markup-strings
 
295
                   :specials   'muse-xml-decide-specials
 
296
                   :before-end 'muse-docbook-munge-buffer
 
297
                   :after      'muse-docbook-finalize-buffer
 
298
                   :header     'muse-docbook-header
 
299
                   :footer     'muse-docbook-footer
 
300
                   :browser    'find-file)
370
301
 
371
302
(provide 'muse-docbook)
372
303