code.delx.au - gnu-emacs-elpa/blob - packages/docbook/docbook.el

   1 ;;; docbook.el --- Info-like viewer for DocBook  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2013  Free Software Foundation, Inc.
   4
   5 ;; Author: Chong Yidong <cyd@gnu.org>
   6 ;; Keywords: docs, help
   7 ;; Version: 0.1
   8
   9 ;; This file is part of GNU Emacs.
  10
  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.
  15
  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.
  20
  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/>.
  23
  24 ;;; Commentary:
  25
  26 ;; An Info-like viewer for DocBook manuals.
  27 ;;
  28 ;; Entry point: M-x docbook-find-file
  29
  30 ;;; TODO:
  31
  32 ;; table
  33 ;; informaltable
  34 ;; graphics
  35 ;;
  36 ;; funcsynopsis
  37 ;; classsynopsis
  38 ;; citerefentry
  39 ;;
  40 ;; see, primaryie, secondaryie
  41
  42 ;;; Code:
  43
  44 (require 'xml)
  45
  46 (defgroup docbook nil
  47   "The Emacs DocBook reader."
  48   :group 'help
  49   :group 'docs)
  50
  51 (defface docbook-xref
  52   '((t :inherit button))
  53   "Face for DocBook cross references."
  54   :group 'docbook)
  55
  56 (defface docbook-warning
  57   '((t :inherit font-lock-warning-face))
  58   "Face for warning text in DocBook documents."
  59   :group 'docbook)
  60
  61 (defface docbook-emphasis
  62   '((t :slant italic))
  63   "Face for emphasized text in DocBook documents."
  64   :group 'docbook)
  65
  66 (defface docbook-literal
  67   '((t :inherit (font-lock-constant-face fixed-pitch)))
  68   "Face for DocBook text marked as being literal."
  69   :group 'docbook)
  70
  71 (defface docbook-computer
  72   '((t :inherit (font-lock-type-face fixed-pitch)))
  73   "Face for DocBook text marked as computer output."
  74   :group 'docbook)
  75
  76 (defface docbook-computer-term
  77   '((t :inherit (font-lock-keyword-face fixed-pitch)))
  78   "Face for DocBook text marked as computer terminology."
  79   :group 'docbook)
  80
  81 (defface docbook-replaceable
  82   '((t :inherit (font-lock-string-face bold)))
  83   "Face for DocBook text marked as replaceable."
  84   :group 'docbook)
  85
  86 (defface docbook-citation
  87   '((t :slant italic))
  88   "Face for DocBook text marked as non-xref citations."
  89   :group 'docbook)
  90
  91 (defface docbook-label
  92   '((t :weight bold :underline t))
  93   "Face for DocBook text marked as labels for Q&A entries,"
  94   :group 'docbook)
  95
  96 (defface docbook-small '((t :height 0.8))
  97   "Face for DocBook text marked as small."
  98   :group 'docbook)
  99
 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."
 107   :group 'docbook)
 108
 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."
 114   :group 'docbook)
 115
 116 (defface docbook-subsection-title
 117   '((t :weight bold :height 1.1 :inherit variable-pitch))
 118   "Face for DocBook subsection titles."
 119   :group 'docbook)
 120
 121 (defface docbook-misc-title '((t :weight bold :underline t))
 122   "Face for miscellaneous DocBook titles."
 123   :group 'docbook)
 124
 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")
 136
 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)
 148     ;; Computer output
 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)
 192     ;; docbook-literal
 193     (literal . docbook-literal)
 194     ;; Admonitions
 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.")
 200
 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.")
 207
 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
 213     cmdsynopsis)
 214   "List of DocBook block types which require no additional processing.")
 215
 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")
 221
 222 (defvar docbook-literal-block-types
 223   '(address literallayout programlisting screen screenco
 224     screenshot synopsis)
 225   "List of DocBook block element types which preserve whitespace.")
 226
 227 (defvar docbook-suppressed-types
 228   '(comment info bookinfo chapterinfo sectioninfo articleinfo label
 229     refmeta refclass)
 230   "List of DocBook element types which are not printed.")
 231
 232 (defvar docbook-index-separator-column 30
 233   "Column number of xrefs printed by `docbook--print-index'.")
 234
 235 (defvar docbook-entity-alist
 236   ;; makeinfo emits these entities, even though the DocBook spec does
 237   ;; not appear to define them.
 238   '(("lsquo" . "`")
 239     ("rsquo" . "'")
 240     ("ldquo" . "\"")
 241     ("rdquo" . "\"")
 242     ("copy" . "(C)")
 243     ("tex" . "TeX")
 244     ("latex" . "LaTeX")
 245     ("hellip" . "...")
 246     ("period" . ".")
 247     ("minus" . "-")
 248     ("colon" . ":")
 249     ("mdash" . "--")
 250     ("ndash" . "-"))
 251   "Alist mapping XML entities to their replacement text.
 252 These elements are added to `xml-entity-alist' while parsing
 253 DocBook documents.")
 254
 255 ;;; Buffer setup
 256
 257 (defvar docbook--parse-tree nil
 258   "Parse tree of the current DocBook document.")
 259
 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.
 266
 267 Each hash table value has one of these two forms:
 268
 269  (NODE TITLE-NODE PARENT-ID PREV NEXT SUBSECTIONS)
 270  (NODE TITLE-NODE PARENT-ID)
 271
 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.
 277
 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
 280 string), or nil.
 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.")
 284
 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.")
 290
 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'.")
 294
 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'.")
 298
 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)
 304
 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).")
 310
 311 (defvar docbook-history nil
 312   "List of DocBook node IDs which were previously viewed.")
 313
 314 (defvar docbook-history-forward nil
 315   "List of DocBook node IDs visited with `docbook-history-back'.")
 316
 317 ;; Used in place of the interned version of the string "nil".
 318 (defconst docbook--nil (make-symbol "nil"))
 319
 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'."
 324   (docbook-mode)
 325   (setq docbook--parse-tree parse-tree
 326         docbook--id-table (make-hash-table :test 'eq)
 327         docbook--index-alist nil
 328         docbook-history 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))
 333   ;; Sort indices
 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))))))
 339
 340 ;;; Utility functions
 341
 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))
 346
 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)))
 350
 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)))))
 356     (and (stringp str)
 357          (not (equal str ""))
 358          (if (equal str "nil") docbook--nil (intern str)))))
 359
 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)))
 366
 367 (defun docbook--node-text (node)
 368   "Return the contents of the DocBook node NODE, as a string."
 369   (let ((str (mapconcat
 370               (lambda (x)
 371                 (cond ((stringp x)
 372                        (if (string-match "\\`\\s-+\\'" x) "" x))
 373                       ((consp x)
 374                        (docbook--node-text x))))
 375               (xml-node-children node)
 376               "")))
 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))))
 381     str))
 382
 383 (defun docbook--print-block-delimiter ()
 384   "Insert newlines for the start or end of a DocBook block element."
 385   (cond
 386    ((bobp))
 387    ((looking-back "\n\n"))
 388    ((eq (char-before) ?\n) (insert ?\n))
 389    (t (insert "\n\n"))))
 390
 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))))
 398          (insert " "))))
 399
 400 (defun docbook--merge-face (base-face face)
 401   "Return a face or list of faces, by merging BASE-FACE and FACE."
 402   (cond
 403    ((null base-face) face)
 404    ((null face)      base-face)
 405    ((eq face base-face) base-face)
 406    (t
 407     (append (if (consp face) face (list face))
 408             (if (consp base-face) base-face (list base-face))))))
 409
 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))
 417                       'docbook-misc-title)
 418                 (cdr (assq type docbook-text-markup-alist)))))
 419     (docbook--merge-face base-face face)))
 420
 421 ;;; Parsing the DocBook XML tree
 422
 423 (defun docbook-register-node (node parent-page-id parent-node-id)
 424   "Register NODE.
 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.
 430
 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)))
 434     (cond
 435      ((eq type 'comment))
 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))
 440      (t
 441       (docbook--register-nonpage-node node parent-page-id
 442                                       parent-node-id)))))
 443
 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.
 455       (unless index
 456         (setq docbook--index-alist
 457               (cons (setq index (cons type nil))
 458                     docbook--index-alist)))
 459       (dolist (subnode (xml-node-children node))
 460         (cond
 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))))
 465             (if entry
 466                 (setcdr entry (cons id (cdr entry)))
 467               (setcdr index (cons (list term id) (cdr index))))))))
 468       nil)))
 469
 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.
 473     (unless id
 474       (setq id (make-symbol "Unnamed section")))
 475     (unless parent-id
 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.
 488       (let ((subnodes
 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))))
 496     id))
 497
 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)))
 510     nil))
 511
 512 ;;; Rendering DocBook
 513
 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.
 519
 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))))
 524     (unless node-record
 525       (funcall (if (fboundp 'user-error) 'user-error 'error)
 526                (or error-msg "Node not found")))
 527     (unless norecord
 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.
 533         (progn
 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))
 541         (erase-buffer)
 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))
 551                 ((stringp 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.
 558         (when subsections
 559           (docbook--print-block-delimiter)
 560           (docbook--print-string "Menu" nil 'docbook-misc-title)
 561           (insert "\n")
 562           (let ((bullet (docbook--display-string "• " "* "))
 563                 opoint)
 564             (dolist (id subsections)
 565               (setq opoint (point))
 566               (insert bullet)
 567               (docbook-insert-xref id)
 568               (insert ?\n)
 569               (put-text-property opoint (point) 'docbook-menu-xref id))))
 570         (goto-char (point-min))))))
 571
 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.
 577
 578 Optional arg LITERAL, if non-nil, means to preserve whitespace
 579 and newlines when printing this node.
 580
 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)))
 585     (cond
 586      ((memq type docbook-suppressed-types)
 587       (docbook-add-fragment-link (docbook--attr 'id node)))
 588      ((eq type 'title)
 589       (docbook--print-block node literal
 590                             (docbook--node-face face parent-type t)))
 591      ((progn
 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))
 597      ((progn
 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))
 601         (eq type 'xref))
 602       (docbook--print-xref node literal face))
 603      ;; Index handling
 604      ((eq type 'indexterm)
 605       (docbook-add-fragment-link
 606        (cdr (assq 'docbook-indexterm-id (xml-node-attributes node)))))
 607      ((eq type 'index)
 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))
 614      ;; List handling
 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))
 621      ;; Cross References
 622      ((memq type '(link ulink))
 623       (docbook--print-link node literal face))
 624      ((eq type 'email)
 625       (docbook--print-email node literal face))
 626      ;; Misc markup
 627      ((eq type 'quote)
 628       (docbook--print-string (docbook--display-string "“" "`")
 629                              literal face)
 630       (docbook--print-children node literal face)
 631       (docbook--print-string (docbook--display-string "”" "'")
 632                              literal face))
 633      ((eq type 'footnote)
 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)))
 639      ((eq type 'arg)
 640       (docbook--print-arg node literal face))
 641      ((eq type 'anchor))
 642      (t
 643       (docbook--print-children node literal face)))))
 644
 645 (defun docbook--print-block (node literal face)
 646   (docbook--print-block-delimiter)
 647   (let* ((type (xml-node-name node))
 648          (beg (point)))
 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))
 654     (unless literal
 655       ;; Flush the beginning of the block to column zero, and fill.
 656       (let ((stop (point)))
 657         (save-excursion
 658           (goto-char beg)
 659           (skip-chars-forward "[:space:]" stop)
 660           (delete-region beg (point))
 661           (setq beg (point))))
 662       (let ((left-margin docbook--indent-level))
 663         (fill-region-as-paragraph beg (point))))
 664     (docbook--print-block-delimiter)))
 665
 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))
 671     (cond
 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))
 676                         '(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))
 686      ((eq type 'qandaset)
 687       (let ((label (docbook--attr 'defaultlabel node)))
 688         (setq docbook--indent-level (+ 4 docbook--indent-level)
 689               docbook--list-context (cons 'qandaset label))))
 690      (t
 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))
 695
 696 (defun docbook--print-term (node literal face)
 697   (when (eq docbook--list-context 'variablelist)
 698     (unless (eq (char-before) ?\n)
 699       (insert "\n"))
 700     (let ((opoint (point)))
 701       (docbook--print-children node literal face)
 702       (save-excursion
 703         (let ((stop (point)))
 704           (goto-char opoint)
 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 "• " "* ")
 709                                  literal face))))))
 710
 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)))
 715       (cond
 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)
 722                                      literal face)
 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))
 727               label)
 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)
 738                                "Q:"
 739                              "A:")))
 740           (if (null label)
 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))))
 747        ;; orderedlist
 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)))
 752        ;; itemizedlist
 753        (t
 754         (docbook--print-listitem-1
 755          opoint (docbook--display-string "• " "* ") 2 literal face))))))
 756
 757 (defun docbook--print-listitem-1 (opoint bullet bullet-len literal face
 758                                   &optional after-string after-string-face)
 759   (save-excursion
 760     (let ((stop (point)))
 761       (goto-char opoint)
 762       (skip-chars-forward "[:space:]" stop)
 763       (indent-line-to (- docbook--indent-level bullet-len))
 764       (docbook--print-string bullet literal face)
 765       (if after-string
 766           (docbook--print-string after-string literal
 767                                  after-string-face)))))
 768
 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))))
 777
 778 (defun docbook--print-footnotes ()
 779   (when (bound-and-true-p docbook--footnotes)
 780     (docbook--print-block-delimiter)
 781     (docbook--print-string "--- Footnotes ---")
 782     (let ((n 1) opoint)
 783       (dolist (footnote (nreverse docbook--footnotes))
 784         (docbook--print-block-delimiter)
 785         (setq opoint (point))
 786         (docbook--print-children (nth 2 footnote))
 787         (save-excursion
 788           (goto-char opoint)
 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))
 792           (insert " "))
 793         (setq n (1+ n))))))
 794
 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)))
 799
 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))
 804     (cond
 805      ((null subnode))
 806      ((stringp subnode)
 807       (docbook--print-string subnode literal face))
 808      (t
 809       (docbook--print-node subnode (xml-node-name node)
 810                            literal face)))))
 811
 812 (defun docbook--print-refnamediv (node literal face)
 813   (docbook--print-block-delimiter)
 814   (let (names purpose)
 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)
 823     (while names
 824       (docbook--print-node (car names) 'refnamediv literal face)
 825       (setq names (cdr names))
 826       (if names (docbook--print-string ", " literal face)))
 827     (when purpose
 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))
 832
 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))
 839
 840 (defun docbook--print-arg (node literal face)
 841   (let ((choice (docbook--attr 'choice node))
 842         (repeat (docbook--attr 'rep node)))
 843     (if (eq choice 'opt)
 844         (docbook--print-string "[ " literal face))
 845     (docbook--print-children node literal face)
 846     (if (eq choice 'opt)
 847         (docbook--print-string " ]" literal face))
 848     (if (eq repeat 'repeat)
 849         (docbook--print-string "..." literal face))))
 850
 851 ;;; Cross-reference handling
 852
 853 (defun docbook--print-xref (node literal face)
 854   "Insert the contents of an xref node NODE."
 855   (let ((target (docbook--attr 'linkend node)))
 856     (when target
 857       (let ((endterm (docbook--attr 'endterm node)))
 858         ;; If an endterm attribute is present, print its contents.
 859         ;; FIXME: protect against a recursion bomb.
 860         (if (and endterm
 861                  (setq endterm (car (docbook--node-record endterm))))
 862             (docbook--print-link endterm literal face target)
 863           (docbook-insert-xref target))))))
 864
 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)))
 868         (opoint (point))
 869         (action 'docbook-xref-button-action))
 870     (unless target
 871       ;; If there is no linkend attribute, look for an external URL.
 872       (let ((attributes (xml-node-attributes node)))
 873         (setq target
 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)
 881                       'action action
 882                       'docbook-target target)))
 883
 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)))
 890
 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."
 895   (unless 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))
 900
 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))))
 914     label))
 915
 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
 920 NOERROR is non-nil."
 921   (let ((marker (cdr (assq node-id docbook-id-markers-alist))))
 922     (cond
 923      ((markerp marker)
 924       (goto-char marker))
 925      ((null noerror)
 926       (error "Node not found")))))
 927
 928 (defun docbook-visit-xref (node-id)
 929   (or (docbook--visit-xref-marker node-id t)
 930       (docbook-print-page node-id)))
 931
 932 (defun docbook-xref-button-action (button)
 933   "Visit the DocBook node indicated by BUTTON."
 934   (docbook-visit-xref (button-get button 'docbook-target)))
 935
 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)))))
 942
 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))))
 947
 948 ;; Printing the index and history list
 949
 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 "• " "* "))
 954         opoint)
 955     (unless (eq (char-before) ?\n) (insert ?\n))
 956     (dolist (entry (cdr index))
 957       (setq opoint (point))
 958       (insert bullet)
 959       (insert (car entry))
 960       (let* ((ids (cdr entry))
 961              (id (car ids)))
 962         (indent-to docbook-index-separator-column 2)
 963         (docbook-insert-xref
 964          id (docbook-node-label (nth 2 (docbook--node-record id))))
 965         (insert ?\n)
 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)
 971               (docbook-insert-xref
 972                id (docbook-node-label
 973                    (nth 2 (docbook--node-record id))))
 974               (insert ?\n)
 975               (put-text-property opoint (point) 'docbook-menu-xref id)))))
 976     (insert ?\n)))
 977
 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))
 983       (insert bullet)
 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))
 991       (insert bullet)
 992       (docbook-insert-xref id))
 993     (insert ?\n)))
 994
 995 ;;; Major mode
 996
 997 (defvar docbook-mode-map
 998   (let ((map (make-keymap)))
 999     (set-keymap-parent map (make-composed-keymap button-buffer-map
1000                                                  special-mode-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)
1005
1006     (dotimes (n 9)
1007       (define-key map (number-to-string (1+ n)) 'docbook-nth-menu-item))
1008
1009     (define-key map "b" 'beginning-of-buffer)
1010     (define-key map "e" 'end-of-buffer)
1011     (define-key map "\M-n" 'clone-buffer)
1012
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)
1018
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)
1023
1024     ;; (define-key map "f" 'docbook-follow-reference)
1025     ;; (define-key map "g" 'docbook-goto-node)
1026     ;; (define-key map "m" 'docbook-menu)
1027
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)
1032
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)
1037     map)
1038   "Keymap containing DocBook commands.")
1039
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.
1044
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
1049 pages.
1050
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,
1054         view the next 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.
1059
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))
1081
1082 ;;; Navigation commands
1083
1084 (defun docbook-up ()
1085   "View the parent of the current DocBook page."
1086   (interactive)
1087   (docbook-print-page (nth 2 (docbook--node-record)) "No parent page"))
1088
1089 (defun docbook-top-page ()
1090   "View the topmost page in the current DocBook document."
1091   (interactive)
1092   (docbook-print-page docbook-top-page))
1093
1094 (defun docbook-backward-page ()
1095   "View the previous DocBook page."
1096   (interactive)
1097   (docbook-print-page (nth 3 (docbook--node-record)) "No previous page"))
1098
1099 (defun docbook-forward-page ()
1100   "View the next DocBook page."
1101   (interactive)
1102   (docbook-print-page (nth 4 (docbook--node-record)) "No following page"))
1103
1104 (defun docbook-scroll-up ()
1105   "Scroll forward, or view the next DocBook page."
1106   (interactive)
1107   (condition-case nil
1108       (scroll-up nil)
1109     (end-of-buffer (docbook-forward-page))))
1110
1111 (defun docbook-scroll-down ()
1112   "Scroll backward, or view the preceding DocBook page."
1113   (interactive)
1114   (condition-case nil
1115       (scroll-down nil)
1116     (beginning-of-buffer (docbook-backward-page))))
1117
1118 (defun docbook-nth-menu-item ()
1119   "View the Nth menu item, based on the key typed."
1120   (interactive)
1121   (let ((n (- (aref (this-command-keys)
1122                     (1- (length (this-command-keys)))) ?0))
1123         (node-record (docbook--node-record)))
1124     (unless 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))))
1128       (unless id
1129         (funcall (if (fboundp 'user-error) 'user-error 'error)
1130                  "Too few items in menu"))
1131       (docbook-visit-xref id))))
1132
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."
1137   (interactive)
1138   (let ((id (get-text-property (point) 'docbook-menu-xref)))
1139     (if id
1140         (docbook-visit-xref id)
1141       (funcall (if (fboundp 'user-error) 'user-error 'error)
1142                "Point neither in reference nor in menu item description"))))
1143
1144 ;; History commands
1145
1146 (defun docbook-history-back (n)
1147   "Go back in history to the previous DocBook page viewed."
1148   (interactive "p")
1149   (dotimes (_i n)
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)))
1155
1156 (defun docbook-history-forward (n)
1157   "Go forward in history to the next DocBook page viewed."
1158   (interactive "p")
1159   (dotimes (_i n)
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))))
1166
1167 (defun docbook-history ()
1168   "Display a list of recently-visited DocBook pages."
1169   (interactive)
1170   (let ((inhibit-read-only t))
1171     (erase-buffer)
1172     (docbook--print-string "Recently visited pages"
1173                            nil 'docbook-chapter-title)
1174     (insert ?\n ?\n)
1175     (docbook--print-history)))
1176
1177 ;; Misc commands
1178
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,
1183 prompt for TYPE."
1184   (interactive (list (if (<= (length docbook--index-alist) 1)
1185                          (caar docbook--index-alist)
1186                        (completing-read
1187                         (format "View index type%s: "
1188                                 (if (assq nil docbook--index-alist)
1189                                     " (empty input for default index)"
1190                                   ""))
1191                         (cons "" (mapcar (lambda (x) (symbol-name (car x)))
1192                                          docbook--index-alist))
1193                         nil t))))
1194   (unless (assq type docbook--index-alist)
1195     (funcall (if (fboundp 'user-error) 'user-error 'error)
1196              "Index is empty"))
1197   (let ((inhibit-read-only t))
1198     (erase-buffer)
1199     (docbook--print-string (if type
1200                                (format "Index: %s" (symbol-name type))
1201                              "Index")
1202                            nil 'docbook-chapter-title)
1203     (insert ?\n ?\n)
1204     (docbook--print-index type)))
1205
1206 ;;;###autoload
1207 (defun docbook-find-file (filename)
1208   "Visit FILENAME as a DocBook document."
1209   (interactive "fView DocBook file: ")
1210   (docbook-setup
1211    (car (let ((xml-entity-alist (append docbook-entity-alist
1212                                         xml-entity-alist)))
1213           (xml-parse-file filename))))
1214   (docbook-print-page docbook-top-page))
1215
1216 (provide 'docbook)
1217
1218 ;;; docbook.el ends here