1 ;;; docbook.el --- Info-like viewer for DocBook -*- lexical-binding: t -*-
3 ;; Copyright (C) 2013 Free Software Foundation, Inc.
5 ;; Author: Chong Yidong <cyd@gnu.org>
6 ;; Keywords: docs, help
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; An Info-like viewer for DocBook manuals.
28 ;; Entry point: M-x docbook-find-file
40 ;; see, primaryie, secondaryie
47 "The Emacs DocBook reader."
52 '((t :inherit button))
53 "Face for DocBook cross references."
56 (defface docbook-warning
57 '((t :inherit font-lock-warning-face))
58 "Face for warning text in DocBook documents."
61 (defface docbook-emphasis
63 "Face for emphasized text in DocBook documents."
66 (defface docbook-literal
67 '((t :inherit (font-lock-constant-face fixed-pitch)))
68 "Face for DocBook text marked as being literal."
71 (defface docbook-computer
72 '((t :inherit (font-lock-type-face fixed-pitch)))
73 "Face for DocBook text marked as computer output."
76 (defface docbook-computer-term
77 '((t :inherit (font-lock-keyword-face fixed-pitch)))
78 "Face for DocBook text marked as computer terminology."
81 (defface docbook-replaceable
82 '((t :inherit (font-lock-string-face bold)))
83 "Face for DocBook text marked as replaceable."
86 (defface docbook-citation
88 "Face for DocBook text marked as non-xref citations."
91 (defface docbook-label
92 '((t :weight bold :underline t))
93 "Face for DocBook text marked as labels for Q&A entries,"
96 (defface docbook-small '((t :height 0.8))
97 "Face for DocBook text marked as small."
100 (defface docbook-chapter-title
101 '((((type tty pc) (class color) (background light))
102 :foreground "green" :weight bold :underline t)
103 (((type tty pc) (class color) (background dark))
104 :foreground "yellow" :weight bold :underline t)
105 (t :height 1.5 :inherit docbook-section-title))
106 "Face for DocBook chapter titles."
109 (defface docbook-section-title
110 '((((type tty pc) (class color))
111 :foreground "lightblue" :weight bold :underline t)
112 (t :height 1.2 :inherit docbook-subsection-title))
113 "Face for DocBook section titles."
116 (defface docbook-subsection-title
117 '((t :weight bold :height 1.1 :inherit variable-pitch))
118 "Face for DocBook subsection titles."
121 (defface docbook-misc-title '((t :weight bold :underline t))
122 "Face for miscellaneous DocBook titles."
125 (defvar docbook-title-markup-alist
126 '((book . docbook-chapter-title)
127 (chapter . docbook-chapter-title)
128 (sect1 . docbook-section-title)
129 (sect2 . docbook-subsection-title)
130 (sect3 . docbook-subsection-title)
131 (sect4 . docbook-subsection-title)
132 (sect5 . docbook-subsection-title)
133 (section . docbook-section-title)
134 (simplesect . docbook-section-title))
135 "Alist mapping DocBook section types to title faces")
137 (defvar docbook-text-markup-alist
138 '((emphasis . docbook-emphasis)
139 (foreignphrase . docbook-emphasis)
140 (firstterm . docbook-emphasis)
141 (bridgehead . docbook-section-title)
142 (refname . docbook-section-title)
143 (refpurpose . docbook-emphasis)
144 (citetitle . docbook-citation)
145 (subscript . docbook-small)
146 (superscript . docbook-small)
147 (replaceable . docbook-replaceable)
149 (accel . docbook-computer)
150 (computeroutput . docbook-computer)
151 (guibutton . docbook-computer)
152 (guiicon . docbook-computer)
153 (guilabel . docbook-computer)
154 (guimenu . docbook-computer)
155 (guimenuitem . docbook-computer)
156 (guisubmenu . docbook-computer)
157 (keycap . docbook-computer)
158 (keycode . docbook-computer)
159 (keycombo . docbook-computer)
160 (keysym . docbook-computer)
161 (markup . docbook-computer)
162 (menuchoice . docbook-computer)
163 (mousebutton . docbook-computer)
164 (msgset . docbook-computer)
165 (prompt . docbook-computer)
166 (shortcut . docbook-computer)
167 (tag . docbook-computer)
168 (userinput . docbook-computer)
169 ;; Computer terminology
170 (application . docbook-computer-term)
171 (classname . docbook-computer-term)
172 (command . docbook-computer-term)
173 (constant . docbook-computer-term)
174 (database . docbook-computer-term)
175 (envar . docbook-computer-term)
176 (errorcode . docbook-computer-term)
177 (errorname . docbook-computer-term)
178 (errortype . docbook-computer-term)
179 (filename . docbook-computer-term)
180 (function . docbook-computer-term)
181 (hardware . docbook-computer-term)
182 (option . docbook-computer-term)
183 (optional . docbook-computer-term)
184 (parameter . docbook-computer-term)
185 (property . docbook-computer-term)
186 (returnvalue . docbook-computer-term)
187 (symbol . docbook-computer-term)
188 (systemitem . docbook-computer-term)
189 (token . docbook-computer-term)
190 (type . docbook-computer-term)
191 (varname . docbook-computer-term)
193 (literal . docbook-literal)
195 (caution . docbook-warning)
196 (important . docbook-emphasis)
197 (tip . docbook-emphasis)
198 (warning . docbook-warning))
199 "Alist mapping DocBook element types to markup faces.")
201 (defvar docbook-page-types
202 '(acknowledgements appendix article bibliography book chapter colophon
203 dedication glossary part preface sect1 sect2 sect3 sect4 sect5
204 section set setindex toc)
205 "List of DocBook sectioning element types.
206 DocBook mode shows one section at a time, as a single page.")
208 (defvar docbook-block-types
209 '(para simpara formalpara equation informalequation
210 informalexample figure informalfigure
211 blockquote epigraph msgset sidebar
212 bridgehead caution important note tip warning
214 "List of DocBook block types which require no additional processing.")
216 (defvar docbook-list-types
217 '(calloutlist bibliolist glosslist itemizedlist orderedlist
218 segmentedlist simplelist variablelist qandaset
219 task procedure substeps)
220 "List of DocBook block-level list types")
222 (defvar docbook-literal-block-types
223 '(address literallayout programlisting screen screenco
225 "List of DocBook block element types which preserve whitespace.")
227 (defvar docbook-suppressed-types
228 '(comment info bookinfo chapterinfo sectioninfo articleinfo label
230 "List of DocBook element types which are not printed.")
232 (defvar docbook-index-separator-column 30
233 "Column number of xrefs printed by `docbook--print-index'.")
235 (defvar docbook-entity-alist
236 ;; makeinfo emits these entities, even though the DocBook spec does
237 ;; not appear to define them.
251 "Alist mapping XML entities to their replacement text.
252 These elements are added to `xml-entity-alist' while parsing
257 (defvar docbook--parse-tree nil
258 "Parse tree of the current DocBook document.")
260 (defvar docbook--id-table nil
261 "Hash table mapping DocBook IDs (symbols) to node contents.
262 Each key should be a Lisp symbol. Each XML node with an XML ID
263 is keyed by an interned Lisp symbol with a matching symbol name.
264 Sectioning (page) nodes which lack their own XML IDs are keyed
265 using uninterned Lisp symbols created when parsing the XML tree.
267 Each hash table value has one of these two forms:
269 (NODE TITLE-NODE PARENT-ID PREV NEXT SUBSECTIONS)
270 (NODE TITLE-NODE PARENT-ID)
272 The first represents a node corresponding to a DocBook section,
273 which is displayed as a separate page in the DocBook reader.
274 The second represents a node which does not correspond to a
275 DocBook section, e.g. a position within a section for a
276 cross-reference to jump to.
278 NODE is the Lisp list tree corresponding to the XML node.
279 TITLE-NODE is the node corresponding to the node's title (a
281 PARENT-ID is the ID of the node's parent page, or nil.
282 PREV and NEXT are the IDs of the previous and next page.
283 SUBSECTIONS is a list of IDs of child pages.")
285 (defvar docbook-id-markers-alist nil
286 "Alist mapping DocBook node IDs to markers.
287 Each key should be a Lisp symbol, but it is not required to be
288 one of the keys in `docbook--id-table'. This alist is used to
289 record the positions of xref'ed elements on the current page.")
291 (defvar docbook-top-page nil
292 "ID of the topmost (root) page in the current DocBook document.
293 The value should be one of the keys in `docbook--id-table'.")
295 (defvar docbook-current-page nil
296 "ID of the current DocBook page.
297 The value should be one of the keys in `docbook--id-table'.")
299 (defvar docbook--last-page-registered)
300 (defvar docbook--last-page-id-registered)
301 (defvar docbook--footnotes)
302 (defvar docbook--indent-level 0)
303 (defvar docbook--list-context nil)
305 (defvar docbook--index-alist nil
306 "Alist mapping index types to index data.
307 Each list element has the form (TYPE . ALIST), where TYPE is a
308 symbol specifying the index type (nil for the default index) and
309 ALIST is an alist (TERM . ID-LIST).")
311 (defvar docbook-history nil
312 "List of DocBook node IDs which were previously viewed.")
314 (defvar docbook-history-forward nil
315 "List of DocBook node IDs visited with `docbook-history-back'.")
317 ;; Used in place of the interned version of the string "nil".
318 (defconst docbook--nil (make-symbol "nil"))
320 (defun docbook-setup (parse-tree)
321 "Set up a DocBook buffer using the XML parse tree PARSE-TREE.
322 PARSE-TREE should be a list of the sort returned by
323 `xml-parse-file' or `xml-parse-buffer'."
325 (setq docbook--parse-tree parse-tree
326 docbook--id-table (make-hash-table :test 'eq)
327 docbook--index-alist nil
329 docbook-history-forward nil)
330 (let ((docbook--last-page-registered nil)
331 (docbook--last-page-id-registered nil))
332 (docbook-register-node parse-tree nil nil))
334 (dolist (index docbook--index-alist)
335 (setcdr index (sort (cdr index) (lambda (a b)
336 (string< (car a) (car b)))))
337 (dolist (entry (cdr index))
338 (setcdr entry (nreverse (cdr entry))))))
340 ;;; Utility functions
342 (defsubst docbook--node-record (&optional node-id)
343 "Return the record keyed by NODE-ID in `docbook--id-table'.
344 If NODE-ID is nil, it defaults to ID of the current page."
345 (gethash (or node-id docbook-current-page) docbook--id-table))
347 (defsubst docbook-add-fragment-link (id)
348 "If ID is non-nil, add a marker for it to `docbook-id-markers-alist'."
349 (if id (push (cons id (point-marker)) docbook-id-markers-alist)))
351 (defun docbook--attr (attribute node)
352 "Return the value of attribute ATTRIBUTE in xml node NODE.
353 The value is automatically converted to a Lisp symbol. If the
354 node lacks the specified attribute, return nil."
355 (let ((str (cdr (assq attribute (xml-node-attributes node)))))
358 (if (equal str "nil") docbook--nil (intern str)))))
360 (defun docbook--display-string (base-string fallback)
361 "Return a string which displays as BASE-STRING on graphical terminals.
362 Use a display property so that on non-graphical terminals, the
363 string displays as the FALLBACK string."
364 (propertize base-string
365 'display `(when (not (display-graphic-p)) . ,fallback)))
367 (defun docbook--node-text (node)
368 "Return the contents of the DocBook node NODE, as a string."
369 (let ((str (mapconcat
372 (if (string-match "\\`\\s-+\\'" x) "" x))
374 (docbook--node-text x))))
375 (xml-node-children node)
377 (if (string-match "\\`\\s-+" str)
378 (setq str (substring str (match-end 0))))
379 (if (string-match "\\s-+\\'" str)
380 (setq str (substring str 0 (match-beginning 0))))
383 (defun docbook--print-block-delimiter ()
384 "Insert newlines for the start or end of a DocBook block element."
387 ((looking-back "\n\n"))
388 ((eq (char-before) ?\n) (insert ?\n))
389 (t (insert "\n\n"))))
391 (defun docbook--print-string (str &optional literal face)
392 "Insert STR (a string) at point, unless it is useless whitespace.
393 If LITERAL is non-nil, preserve whitespace. If FACE is non-nil,
394 apply it as the face for the inserted text."
395 (cond ((or literal (not (string-match "\\`\\s-+\\'" str)))
396 (insert (propertize str 'font-lock-face face)))
397 ((not (or (bolp) (memq (char-before) '(?\s ?\t))))
400 (defun docbook--merge-face (base-face face)
401 "Return a face or list of faces, by merging BASE-FACE and FACE."
403 ((null base-face) face)
404 ((null face) base-face)
405 ((eq face base-face) base-face)
407 (append (if (consp face) face (list face))
408 (if (consp base-face) base-face (list base-face))))))
410 (defun docbook--node-face (base-face type &optional parent)
411 "Return a face suitable for displaying DocBook node type TYPE.
412 BASE-FACE is the face specified by the node's parent elements.
413 If PARENT is non-nil, treat TYPE as the type of the parent node,
414 and assume that we are looking up the face of a title node."
415 (let ((face (if parent
416 (or (cdr (assq type docbook-title-markup-alist))
418 (cdr (assq type docbook-text-markup-alist)))))
419 (docbook--merge-face base-face face)))
421 ;;; Parsing the DocBook XML tree
423 (defun docbook-register-node (node parent-page-id parent-node-id)
425 NODE should be a cons cell---a subnode of the tree returned by
426 `xml-parse-file'. PARENT is the registered node ID of the parent
427 page (a symbol). PARENT-NODE-ID is the registered node ID of the
428 node's immediate parent (which may or may not correspond to a
429 page node), or nil if the parent has no ID.
431 If NODE is a page node, return its registered node ID (a symbol).
432 Otherwise, return nil."
433 (let ((type (xml-node-name node)))
436 ((eq type 'indexterm)
437 (docbook--register-indexterm node parent-page-id))
438 ((memq type docbook-page-types)
439 (docbook--register-page-node node parent-page-id))
441 (docbook--register-nonpage-node node parent-page-id
444 (defun docbook--register-indexterm (node parent-id)
445 (let ((id (docbook--attr 'id node)))
446 (if id (puthash id `(,node nil ,parent-id) docbook--id-table))
447 ;; HACK: Modify the XML tree to add an indexterm id (a symbol).
448 (setq id (make-symbol "indexterm"))
449 (setcar (cdr node) (cons (cons 'docbook-indexterm-id id)
450 (xml-node-attributes node)))
451 (puthash id `(,node nil ,parent-id) docbook--id-table)
452 (let* ((type (docbook--attr 'type node))
453 (index (assq type docbook--index-alist)))
454 ;; If there is no index of the indicated type yet, add it.
456 (setq docbook--index-alist
457 (cons (setq index (cons type nil))
458 docbook--index-alist)))
459 (dolist (subnode (xml-node-children node))
461 ((not (consp subnode)))
462 ((memq (xml-node-name subnode) '(primary secondary tertiary))
463 (let* ((term (docbook--node-text subnode))
464 (entry (assoc term (cdr index))))
466 (setcdr entry (cons id (cdr entry)))
467 (setcdr index (cons (list term id) (cdr index))))))))
470 (defun docbook--register-page-node (node parent-id)
471 (let ((id (docbook--attr 'id node)))
472 ;; If there is no ID, generate an uninterned symbol as the ID.
474 (setq id (make-symbol "Unnamed section")))
476 (setq docbook-top-page id))
477 ;; Make the node record and update the NEXT record of the last node
478 ;; processed. This must be done before descending into the tree.
479 (if docbook--last-page-registered
480 (setcar (nthcdr 4 docbook--last-page-registered) id))
481 (let ((record (list node nil parent-id
482 docbook--last-page-id-registered nil nil)))
483 (setq docbook--last-page-registered record
484 docbook--last-page-id-registered id)
485 ;; Add the entry for this page node into the hash table.
486 (if id (puthash id record docbook--id-table))
487 ;; Descend into the children, registering them.
489 (mapcar (lambda (subnode)
490 (when (consp subnode)
491 (docbook-register-node subnode id id)))
492 (xml-node-children node))))
493 ;; If this is a section node, update its record with the IDs of
494 ;; the subsections, then return the ID of this node.
495 (setcar (nthcdr 5 record) (delq nil subnodes))))
498 (defun docbook--register-nonpage-node (node parent-page-id parent-node-id)
499 (let ((id (docbook--attr 'id node)))
500 ;; If this is a title node, register it in the parent node.
501 (when (and (eq (xml-node-name node) 'title) parent-node-id)
502 (let ((parent-record (docbook--node-record parent-node-id)))
503 (if parent-record (setcar (cdr parent-record) node))))
504 ;; Construct the node record.
505 (if id (puthash id `(,node nil ,parent-page-id) docbook--id-table))
506 ;; Descend into the children, registering them.
507 (dolist (subnode (xml-node-children node))
508 (when (consp subnode)
509 (docbook-register-node subnode parent-page-id id)))
512 ;;; Rendering DocBook
514 (defun docbook-print-page (node-id &optional error-msg norecord)
515 "Print the DocBook section corresponding to NODE-ID.
516 If NODE-ID is not a registered DocBook section node, signal an
517 error. The optional argument ERROR-MSG, if non-nil, specifies a
518 default error message.
520 If optional argument NORECORD is non-nil, do not record this node
521 in `docbook-history'."
522 (let ((node-record (when (and node-id (symbolp node-id))
523 (docbook--node-record node-id))))
525 (funcall (if (fboundp 'user-error) 'user-error 'error)
526 (or error-msg "Node not found")))
528 (push node-id docbook-history)
529 (setq docbook-history-forward nil))
530 (if (= (length node-record) 3)
531 ;; If the id points to a page fragment, visit the parent page
532 ;; and jump to the relevant marker within that page.
534 (docbook-print-page (nth 2 node-record) nil t)
535 (docbook--visit-xref-marker node-id))
536 ;; If the id points to a page, visit it.
537 (let* ((inhibit-read-only t)
538 (node (car node-record))
539 (subsections (nth 5 node-record))
540 (docbook--footnotes nil))
542 ;; Add a fragment marker to the top of this page.
543 (setq docbook-id-markers-alist nil
544 docbook-current-page node-id)
545 (docbook-add-fragment-link node-id)
546 ;; Each section contains any number of blocks followed by any
547 ;; number of subsections. Loop over subnodes, printing
548 ;; block-level nodes.
549 (dolist (subnode (xml-node-children node))
550 (cond ((null subnode))
552 (docbook--print-string subnode))
553 ((not (memq (xml-node-name subnode) docbook-page-types))
554 (docbook--print-node subnode (xml-node-name node)))))
555 ;; If there are footnotes, print them.
556 (docbook--print-footnotes)
557 ;; If there are subsections, print a submenu.
559 (docbook--print-block-delimiter)
560 (docbook--print-string "Menu" nil 'docbook-misc-title)
562 (let ((bullet (docbook--display-string "• " "* "))
564 (dolist (id subsections)
565 (setq opoint (point))
567 (docbook-insert-xref id)
569 (put-text-property opoint (point) 'docbook-menu-xref id))))
570 (goto-char (point-min))))))
572 (defun docbook--print-node (node parent-type &optional literal face)
573 "Insert the contents of NODE at point.
574 NODE should be a cons cell---a subnode of the tree returned by
575 `xml-parse-file'. PARENT-TYPE should be the node type of the
576 parent node (a symbol), or nil if this is the topmost node.
578 Optional arg LITERAL, if non-nil, means to preserve whitespace
579 and newlines when printing this node.
581 Optional arg FACE, if non-nil, should be a face or list of faces
582 to use, by default, for printing this node. The node may apply
583 additional markup on top to of the specified FACE."
584 (let ((type (xml-node-name node)))
586 ((memq type docbook-suppressed-types)
587 (docbook-add-fragment-link (docbook--attr 'id node)))
589 (docbook--print-block node literal
590 (docbook--node-face face parent-type t)))
592 ;; For the sake of all the remaining node types, set FACE to
593 ;; the markup face for this node's type.
594 (setq face (docbook--node-face face type))
595 (memq type docbook-block-types))
596 (docbook--print-block node literal face))
598 ;; For the sake of all remaining node types, apply the
599 ;; fragment ID if any.
600 (docbook-add-fragment-link (docbook--attr 'id node))
602 (docbook--print-xref node literal face))
604 ((eq type 'indexterm)
605 (docbook-add-fragment-link
606 (cdr (assq 'docbook-indexterm-id (xml-node-attributes node)))))
608 (docbook--print-index (docbook--attr 'type node)))
609 ;; Refentry and friends
610 ((eq type 'refnamediv)
611 (docbook--print-refnamediv node literal face))
612 ((eq type 'refsynopsisdiv)
613 (docbook--print-refsynopsisdiv node literal face))
615 ((memq type docbook-list-types)
616 (docbook--print-list node literal face))
617 ((memq type '(listitem question answer step))
618 (docbook--print-listitem node literal face))
619 ((memq type '(term glossterm))
620 (docbook--print-term node literal face))
622 ((memq type '(link ulink))
623 (docbook--print-link node literal face))
625 (docbook--print-email node literal face))
628 (docbook--print-string (docbook--display-string "“" "`")
630 (docbook--print-children node literal face)
631 (docbook--print-string (docbook--display-string "”" "'")
634 (docbook--print-footnote-tag node))
635 ((eq type 'subscript)
636 (docbook--print-with-display-prop node literal face '(raise -0.2)))
637 ((eq type 'superscript)
638 (docbook--print-with-display-prop node literal face '(raise 0.2)))
640 (docbook--print-arg node literal face))
643 (docbook--print-children node literal face)))))
645 (defun docbook--print-block (node literal face)
646 (docbook--print-block-delimiter)
647 (let* ((type (xml-node-name node))
649 ;; If the block has an ID tag, apply it.
650 (docbook-add-fragment-link (docbook--attr 'id node))
651 ;; Print the contents of the block.
652 (docbook--print-children node literal
653 (docbook--node-face face type))
655 ;; Flush the beginning of the block to column zero, and fill.
656 (let ((stop (point)))
659 (skip-chars-forward "[:space:]" stop)
660 (delete-region beg (point))
662 (let ((left-margin docbook--indent-level))
663 (fill-region-as-paragraph beg (point))))
664 (docbook--print-block-delimiter)))
666 (defun docbook--print-list (node literal face)
667 (docbook--print-block-delimiter)
668 (let ((type (xml-node-name node))
669 (docbook--indent-level docbook--indent-level)
670 (docbook--list-context docbook--list-context))
672 ((memq type '(procedure substeps))
673 ;; We use a version list to denote (sub)steps.
674 (let* ((version (if (eq (car-safe docbook--list-context) 'procedure)
675 (append (cdr docbook--list-context) '(1))
677 (str (mapconcat 'int-to-string version ".")))
678 (setq docbook--indent-level (+ (length str) 3 docbook--indent-level)
679 docbook--list-context (cons 'procedure version))))
680 ((eq type 'orderedlist)
681 (setq docbook--indent-level (+ 4 docbook--indent-level)
682 docbook--list-context 1))
683 ((memq type '(glosslist variablelist))
684 (setq docbook--indent-level (+ 4 docbook--indent-level)
685 docbook--list-context 'variablelist))
687 (let ((label (docbook--attr 'defaultlabel node)))
688 (setq docbook--indent-level (+ 4 docbook--indent-level)
689 docbook--list-context (cons 'qandaset label))))
691 (setq docbook--indent-level (+ 2 docbook--indent-level)
692 docbook--list-context 'itemizedlist)))
693 (docbook--print-children node literal face))
694 (docbook--print-block-delimiter))
696 (defun docbook--print-term (node literal face)
697 (when (eq docbook--list-context 'variablelist)
698 (unless (eq (char-before) ?\n)
700 (let ((opoint (point)))
701 (docbook--print-children node literal face)
703 (let ((stop (point)))
705 (skip-chars-forward "[:space:]" stop)
706 (delete-region opoint (point))
707 (indent-line-to (- docbook--indent-level 4))
708 (docbook--print-string (docbook--display-string "• " "* ")
711 (defun docbook--print-listitem (node literal face)
712 (let ((opoint (point)))
713 (docbook--print-children node literal face)
714 (when (not (memq docbook--list-context '(nil variablelist)))
716 ;; A step in a procedure
717 ((eq (car-safe docbook--list-context) 'procedure)
718 (let* ((version (cdr docbook--list-context))
719 (str (concat (mapconcat 'int-to-string version ".") ". "))
720 (subversion (nthcdr (1- (length version)) version)))
721 (docbook--print-listitem-1 opoint str (length str)
723 (setcar subversion (1+ (car subversion)))))
724 ;; Question or answer
725 ((eq (car-safe docbook--list-context) 'qandaset)
726 (let ((subnodes (xml-node-children node))
728 ;; Look for a label for the question or answer.
729 (while (and (null label) subnodes)
730 (when (and (consp (car subnodes))
731 (eq (xml-node-name (car subnodes)) 'label))
732 (setq label (docbook--node-text (car subnodes))))
733 (setq subnodes (cdr subnodes)))
734 ;; If there is none, consult the default label.
735 (and (not (stringp label))
736 (eq (cdr docbook--list-context) 'qanda)
737 (setq label (if (eq (xml-node-name node) 'question)
741 ;; Use a bullet, like an itemizedlist.
742 (docbook--print-listitem-1
743 opoint (docbook--display-string "• " "* ") 2 literal face)
744 (docbook--print-listitem-1
745 opoint label 0 literal
746 (docbook--merge-face face 'docbook-label) " " face))))
748 ((integerp docbook--list-context)
749 (docbook--print-listitem-1
750 opoint (format "%2d. " docbook--list-context) 4 literal face)
751 (setq docbook--list-context (1+ docbook--list-context)))
754 (docbook--print-listitem-1
755 opoint (docbook--display-string "• " "* ") 2 literal face))))))
757 (defun docbook--print-listitem-1 (opoint bullet bullet-len literal face
758 &optional after-string after-string-face)
760 (let ((stop (point)))
762 (skip-chars-forward "[:space:]" stop)
763 (indent-line-to (- docbook--indent-level bullet-len))
764 (docbook--print-string bullet literal face)
766 (docbook--print-string after-string literal
767 after-string-face)))))
769 (defun docbook--print-footnote-tag (node)
770 (when (boundp 'docbook--footnotes)
771 (let ((n (1+ (length docbook--footnotes)))
772 (tag-id (make-symbol "footnote-id"))
773 (footnote-id (make-symbol "footnote")))
774 (docbook-add-fragment-link tag-id)
775 (docbook-insert-xref footnote-id (format "(%d)" n))
776 (push (list tag-id footnote-id node) docbook--footnotes))))
778 (defun docbook--print-footnotes ()
779 (when (bound-and-true-p docbook--footnotes)
780 (docbook--print-block-delimiter)
781 (docbook--print-string "--- Footnotes ---")
783 (dolist (footnote (nreverse docbook--footnotes))
784 (docbook--print-block-delimiter)
785 (setq opoint (point))
786 (docbook--print-children (nth 2 footnote))
789 (if (eq (char-after) ?\n) (forward-char))
790 (docbook-add-fragment-link (nth 1 footnote))
791 (docbook-insert-xref (car footnote) (format "(%d)" n))
795 (defun docbook--print-with-display-prop (node literal face prop)
796 (let ((opoint (point)))
797 (docbook--print-children node literal face)
798 (put-text-property opoint (point) 'display prop)))
800 (defun docbook--print-children (node &optional literal face)
801 "Print the child nodes of the DocBook node NODE.
802 LITERAL and FACE mean the same as in `docbook--print-node'."
803 (dolist (subnode (xml-node-children node))
807 (docbook--print-string subnode literal face))
809 (docbook--print-node subnode (xml-node-name node)
812 (defun docbook--print-refnamediv (node literal face)
813 (docbook--print-block-delimiter)
815 (dolist (subnode (xml-node-children node))
816 (cond ((not (consp subnode)))
817 ((eq (xml-node-name subnode) 'refname)
818 (push subnode names))
819 ((eq (xml-node-name subnode) 'refpurpose)
820 (setq purpose subnode))))
821 (setq names (nreverse names))
822 (indent-to docbook--indent-level)
824 (docbook--print-node (car names) 'refnamediv literal face)
825 (setq names (cdr names))
826 (if names (docbook--print-string ", " literal face)))
828 (or (eq (char-before) ?\n) (insert ?\n))
829 (indent-to docbook--indent-level)
830 (docbook--print-node purpose literal face)))
831 (docbook--print-block-delimiter))
833 (defun docbook--print-refsynopsisdiv (node literal face)
834 (docbook--print-block-delimiter)
835 (indent-to docbook--indent-level)
836 (docbook--print-string "Synopsis" nil 'docbook-misc-title)
837 (docbook--print-block-delimiter)
838 (docbook--print-children node literal face))
840 (defun docbook--print-arg (node literal face)
841 (let ((choice (docbook--attr 'choice node))
842 (repeat (docbook--attr 'rep node)))
844 (docbook--print-string "[ " literal face))
845 (docbook--print-children node literal face)
847 (docbook--print-string " ]" literal face))
848 (if (eq repeat 'repeat)
849 (docbook--print-string "..." literal face))))
851 ;;; Cross-reference handling
853 (defun docbook--print-xref (node literal face)
854 "Insert the contents of an xref node NODE."
855 (let ((target (docbook--attr 'linkend node)))
857 (let ((endterm (docbook--attr 'endterm node)))
858 ;; If an endterm attribute is present, print its contents.
859 ;; FIXME: protect against a recursion bomb.
861 (setq endterm (car (docbook--node-record endterm))))
862 (docbook--print-link endterm literal face target)
863 (docbook-insert-xref target))))))
865 (defun docbook--print-link (node literal face &optional linkend)
866 "Insert the contents of a link node NODE."
867 (let ((target (or linkend (docbook--attr 'linkend node)))
869 (action 'docbook-xref-button-action))
871 ;; If there is no linkend attribute, look for an external URL.
872 (let ((attributes (xml-node-attributes node)))
874 (or (cdr (assq 'xlink:href attributes))
875 (cdr (assq 'href attributes))
876 ;; Used by obsolete `url' elements.
877 (cdr (assq 'url attributes))))
878 (setq action 'docbook-link-button-action)))
879 (docbook--print-children node literal face)
880 (make-text-button opoint (point)
882 'docbook-target target)))
884 (defun docbook--print-email (node literal face)
885 "Insert the contents of a link node NODE."
886 (let ((opoint (point)))
887 (docbook--print-children node literal face)
888 (make-text-button opoint (point)
889 'action 'docbook-email-button-action)))
891 (defun docbook-insert-xref (node-id &optional label)
892 "Insert a cross reference to NODE-ID at point.
893 NODE-ID should be a node ID, as either a symbol or a string.
894 LABEL, if non-nil, specifies the text label."
896 (setq label (docbook-node-label node-id)))
897 (insert-text-button label
898 'action 'docbook-xref-button-action
899 'docbook-target node-id))
901 (defun docbook-node-label (node-id)
902 "Return an appropriate label for the node with ID NODE-ID."
903 (let* ((record (docbook--node-record node-id))
904 (attributes (xml-node-attributes (car record)))
905 ;; Use the target node's xreflabel attribute.
906 (label (cdr (assq 'xreflabel attributes))))
907 (when (memq label '(nil ""))
908 ;; Otherwise, use the target node's title.
909 (setq label (and (nth 1 record)
910 (docbook--node-text (nth 1 record))))
911 (when (memq label '(nil ""))
912 ;; Otherwise, default to the node ID's name.
913 (setq label (symbol-name node-id))))
916 (defun docbook--visit-xref-marker (node-id &optional noerror)
917 "Visit the position of NODE-ID on the current DocBook page.
918 Return non-nil if we found the element and jumped to it.
919 Otherwise, signal an error if NOERROR is nil, and return nil if
921 (let ((marker (cdr (assq node-id docbook-id-markers-alist))))
926 (error "Node not found")))))
928 (defun docbook-visit-xref (node-id)
929 (or (docbook--visit-xref-marker node-id t)
930 (docbook-print-page node-id)))
932 (defun docbook-xref-button-action (button)
933 "Visit the DocBook node indicated by BUTTON."
934 (docbook-visit-xref (button-get button 'docbook-target)))
936 (defun docbook-link-button-action (button)
937 "Call `browse-url' to visit the link indicated by BUTTON."
938 (let ((target (button-get button 'docbook-target)))
939 (if (string-match "\\`mailto:" target)
940 (compose-mail (substring-no-properties target (match-end 0)))
941 (browse-url (button-get button 'docbook-target)))))
943 (defun docbook-email-button-action (button)
944 "Send mail to the address indicated by BUTTON."
945 (compose-mail (buffer-substring-no-properties
946 (button-start button) (button-end button))))
948 ;; Printing the index and history list
950 (defun docbook--print-index (type)
951 "Insert the DocBook index of type TYPE at point."
952 (let ((index (assq type docbook--index-alist))
953 (bullet (docbook--display-string "• " "* "))
955 (unless (eq (char-before) ?\n) (insert ?\n))
956 (dolist (entry (cdr index))
957 (setq opoint (point))
960 (let* ((ids (cdr entry))
962 (indent-to docbook-index-separator-column 2)
964 id (docbook-node-label (nth 2 (docbook--node-record id))))
966 (put-text-property opoint (point) 'docbook-menu-xref id)
967 (if (> (length ids) 1)
968 (dolist (id (cdr ids))
969 (setq opoint (point))
970 (indent-to docbook-index-separator-column 2)
972 id (docbook-node-label
973 (nth 2 (docbook--node-record id))))
975 (put-text-property opoint (point) 'docbook-menu-xref id)))))
978 (defun docbook--print-history ()
979 "Insert the DocBook navigation history menu at point."
980 (let ((bullet (docbook--display-string "◦ " "* ")))
981 (dolist (id (reverse (cdr docbook-history)))
982 (unless (eq (char-before) ?\n) (insert ?\n))
984 (docbook-insert-xref id))
985 ;; Indicate the current page with a more prominent bullet.
986 (unless (eq (char-before) ?\n) (insert ?\n))
987 (insert (docbook--display-string "• " "* "))
988 (docbook-insert-xref (car docbook-history))
989 (dolist (id docbook-history-forward)
990 (unless (eq (char-before) ?\n) (insert ?\n))
992 (docbook-insert-xref id))
997 (defvar docbook-mode-map
998 (let ((map (make-keymap)))
999 (set-keymap-parent map (make-composed-keymap button-buffer-map
1001 (define-key map "." 'beginning-of-buffer)
1002 (define-key map " " 'docbook-scroll-up)
1003 (define-key map "\177" 'docbook-scroll-down)
1004 (define-key map "\C-m" 'docbook-follow-nearest-node)
1007 (define-key map (number-to-string (1+ n)) 'docbook-nth-menu-item))
1009 (define-key map "b" 'beginning-of-buffer)
1010 (define-key map "e" 'end-of-buffer)
1011 (define-key map "\M-n" 'clone-buffer)
1013 (define-key map "i" 'docbook-index)
1014 (define-key map "I" 'docbook-index)
1015 (define-key map "l" 'docbook-history-back)
1016 (define-key map "r" 'docbook-history-forward)
1017 (define-key map "L" 'docbook-history)
1019 (define-key map "]" 'docbook-forward-page)
1020 (define-key map "[" 'docbook-backward-page)
1021 (define-key map "n" 'docbook-forward-page)
1022 (define-key map "p" 'docbook-backward-page)
1024 ;; (define-key map "f" 'docbook-follow-reference)
1025 ;; (define-key map "g" 'docbook-goto-node)
1026 ;; (define-key map "m" 'docbook-menu)
1028 ;; (define-key map "s" 'docbook-search)
1029 ;; (define-key map "S" 'docbook-search-case-sensitively)
1030 ;; (define-key map "T" 'docbook-toc)
1031 ;; (define-key map "," 'docbook-index-next)
1033 (define-key map "t" 'docbook-top-page)
1034 (define-key map "u" 'docbook-up)
1035 (define-key map "^" 'docbook-up)
1036 (define-key map [follow-link] 'mouse-face)
1038 "Keymap containing DocBook commands.")
1040 (define-derived-mode docbook-mode special-mode "DocBook"
1041 "Major mode for viewing DocBook documents.
1042 Type \\[docbook-find-file] to visit DocBook files for viewing.
1043 Most of the commands in DocBook mode are similar to Info mode.
1045 DocBook documents are divided into \"section nodes\" (which
1046 includes chapters, sections, subsections, etc.). DocBook mode
1047 displays one section node at a time, as a single page.
1048 Navigation commands and hyperlinks can be used to view other
1051 Moving within a page:
1052 \\[docbook-scroll-up] Normally, scroll forward a full screen.
1053 If you have scrolled to the end of this page,
1055 \\[docbook-scroll-down] Normally, scroll backward a full screen.
1056 If you have scrolled to the beginning of this page,
1057 view the preceding page.
1058 \\[beginning-of-buffer] Jump to beginning of this page.
1060 Selecting other nodes:
1061 \\[docbook-follow-nearest-node] Follow a node reference near point.
1062 \\[docbook-backward-page] View the preceding page.
1063 \\[docbook-forward-page] View the next page.
1064 \\[docbook-up] View the parent of the current page.
1065 \\[docbook-top-page] View the topmost section of this document.
1066 \\[docbook-history-back] View the last page you were at.
1067 \\[docbook-history-forward] Move forward in history to the page you were at before using \\[docbook-history-back].
1068 \\[docbook-history] View a menu of visited pages."
1069 (make-local-variable 'docbook--parse-tree)
1070 (make-local-variable 'docbook--id-table)
1071 (make-local-variable 'docbook-current-page)
1072 (make-local-variable 'docbook-top-page)
1073 (make-local-variable 'docbook-id-markers-alist)
1074 (make-local-variable 'docbook--index-alist)
1075 (make-local-variable 'docbook-history)
1076 (make-local-variable 'docbook-history-foward)
1077 (setq-local adaptive-fill-mode nil)
1078 (setq indent-tabs-mode nil)
1079 (setq fill-prefix nil)
1080 (setq use-hard-newlines t))
1082 ;;; Navigation commands
1084 (defun docbook-up ()
1085 "View the parent of the current DocBook page."
1087 (docbook-print-page (nth 2 (docbook--node-record)) "No parent page"))
1089 (defun docbook-top-page ()
1090 "View the topmost page in the current DocBook document."
1092 (docbook-print-page docbook-top-page))
1094 (defun docbook-backward-page ()
1095 "View the previous DocBook page."
1097 (docbook-print-page (nth 3 (docbook--node-record)) "No previous page"))
1099 (defun docbook-forward-page ()
1100 "View the next DocBook page."
1102 (docbook-print-page (nth 4 (docbook--node-record)) "No following page"))
1104 (defun docbook-scroll-up ()
1105 "Scroll forward, or view the next DocBook page."
1109 (end-of-buffer (docbook-forward-page))))
1111 (defun docbook-scroll-down ()
1112 "Scroll backward, or view the preceding DocBook page."
1116 (beginning-of-buffer (docbook-backward-page))))
1118 (defun docbook-nth-menu-item ()
1119 "View the Nth menu item, based on the key typed."
1121 (let ((n (- (aref (this-command-keys)
1122 (1- (length (this-command-keys)))) ?0))
1123 (node-record (docbook--node-record)))
1125 (funcall (if (fboundp 'user-error) 'user-error 'error)
1126 "No menu in this node"))
1127 (let ((id (nth (1- n) (nth 5 node-record))))
1129 (funcall (if (fboundp 'user-error) 'user-error 'error)
1130 "Too few items in menu"))
1131 (docbook-visit-xref id))))
1133 (defun docbook-follow-nearest-node ()
1134 "Follow a node reference near point.
1135 If point is on a reference, follow that reference. Otherwise,
1136 if point is in a menu item description, follow that menu item."
1138 (let ((id (get-text-property (point) 'docbook-menu-xref)))
1140 (docbook-visit-xref id)
1141 (funcall (if (fboundp 'user-error) 'user-error 'error)
1142 "Point neither in reference nor in menu item description"))))
1146 (defun docbook-history-back (n)
1147 "Go back in history to the previous DocBook page viewed."
1150 (unless (cdr docbook-history)
1151 (funcall (if (fboundp 'user-error) 'user-error 'error)
1152 "This is the first node you looked at"))
1153 (push (pop docbook-history) docbook-history-forward)
1154 (docbook-print-page (car docbook-history) nil t)))
1156 (defun docbook-history-forward (n)
1157 "Go forward in history to the next DocBook page viewed."
1160 (if (null docbook-history-forward)
1161 (funcall (if (fboundp 'user-error) 'user-error 'error)
1162 "This is the last node you looked at"))
1163 (let ((id (pop docbook-history-forward)))
1164 (push id docbook-history)
1165 (docbook-print-page id nil t))))
1167 (defun docbook-history ()
1168 "Display a list of recently-visited DocBook pages."
1170 (let ((inhibit-read-only t))
1172 (docbook--print-string "Recently visited pages"
1173 nil 'docbook-chapter-title)
1175 (docbook--print-history)))
1179 (defun docbook-index (type)
1180 "Display a list of index topics fo the current DocBook document.
1181 The argument TYPE is the index type; DocBook documents can define
1182 several indices for different topics. If called interactively,
1184 (interactive (list (if (<= (length docbook--index-alist) 1)
1185 (caar docbook--index-alist)
1187 (format "View index type%s: "
1188 (if (assq nil docbook--index-alist)
1189 " (empty input for default index)"
1191 (cons "" (mapcar (lambda (x) (symbol-name (car x)))
1192 docbook--index-alist))
1194 (unless (assq type docbook--index-alist)
1195 (funcall (if (fboundp 'user-error) 'user-error 'error)
1197 (let ((inhibit-read-only t))
1199 (docbook--print-string (if type
1200 (format "Index: %s" (symbol-name type))
1202 nil 'docbook-chapter-title)
1204 (docbook--print-index type)))
1207 (defun docbook-find-file (filename)
1208 "Visit FILENAME as a DocBook document."
1209 (interactive "fView DocBook file: ")
1211 (car (let ((xml-entity-alist (append docbook-entity-alist
1213 (xml-parse-file filename))))
1214 (docbook-print-page docbook-top-page))
1218 ;;; docbook.el ends here