DOCbook Table Of Contents -- doctoc
===================================
+This is doctoc version 2.0.
+Copyright (C) 2001, 2002 Jens Emmerich, see doctoc.el for conditions.
+
Overview
--------
The doctoc package provides a navigation aid for editing richly
structured DocBook documents with (X)Emacs. It generates a table of
-contents (TOC) for the current buffer using an external perl script at
-the moment. The TOC is displayed in a seperate buffer with a suiteable
-major mode to jump to the respective destination.
+contents (TOC) for the current buffer using an external perl script or
+using PSGML's parse tree. The TOC is displayed in a seperate buffer
+with a suiteable major mode to jump to or view the respective
+destination.
-Most of the current implementation was meant to be a prototype but
-turned out to be extremely useful for me already. Speed is no issue
-compared to PSGML's parsing time.
+Speed is better using the external parser compared to
+PSGML. Installation is easier and integration is a little smoother
+with PSGML.
Installation
------------
+Both versions: Simply put the lisp files somewhere into your
+load-path. They can be byte-compiled, but that's not neccesary if you
+use the external parser: haven't seen any noticeable delay caused by
+doctoc.el in comparison to toc.pl. Some more installation instructions
+and the keys can be found directly in doctoc.el.
+
+a) PSGML Version
+
+Put something like
+
+(defun my-sgml-setup ()
+ "Customize psgml for docbook."
+ (require 'doctoc-psgml)
+ ;; ... more customizations
+ (define-key sgml-mode-map [(control c)(=)] 'doctoc-toc-current-line))
+
+(add-hook 'sgml-mode-hook 'my-sgml-setup)
+
+into your .xemacs/init.el or .emacs file.
+
+b) External Parser Version
+
Put toc.pl somewhere in your $PATH. It needs perl5 with XML::Parser
-module. Installation instructions for doctoc.el can be found directly
-in the file. It can be byte-compiled, but that's not neccesary,
-haven't seen any noticeable delay caused by doctoc.el in comparison to
-toc.pl.
+module.
+
+(defun my-sgml-setup ()
+ "Customize psgml for docbook."
+ (require 'doctoc-ext)
+ ;; ... more customizations
+ (define-key sgml-mode-map [(control c)(=)] 'doctoc-toc-current-line))
+
+(add-hook 'sgml-mode-hook 'my-sgml-setup)
+
+You should be able to switch between both at any time by
+M-x load-library doctoc-<variant>.
Future Plans
------------
+(Priorities might differ from numbering:)
+
1. Removal of XEmacs specific stuff
2. Use autoloads, customize package, other Emacs conventions
-3. Check if PSGMLs parse tree can/should be used
+3. Check if PSGMLs parse tree can/should be used -- done
4. Support for parsed external entities, i.e. documents split into
- multiple files, with single TOC (not possible with XML::Parser)
+ multiple files, with single TOC (*is* possible with XML::Parser)
+ -- done
5. Look into using speedbar
6. ID/IDREF display/selection in TOC
-------
I do miss RefTeX's/AucTeX's elaborate features, all ideas borrowed
-there.
+there. PSGML is great stuff, nevertheless.
Contact
-------
--- /dev/null
+;; doctoc-psgml.el --- PSGML's parser module for doctoc
+
+;; part of doctoc version 2.0
+
+(require 'doctoc)
+(require 'psgml)
+
+;;; parser interface
+
+(defun doctoc-psgml-generate-toc (toc-buffer)
+ "Insert TOC for document in current psgml parse tree."
+ (interactive)
+ (unless (fboundp 'sgml-top-element)
+ (error "Need PSGML-mode for TOC."))
+ (sgml-parse-to (point-max))
+ (message nil)
+ (doctoc-psgml-traverse (sgml-top-element) 0 toc-buffer))
+
+;;; internally used definitions
+
+(defun doctoc-psgml-traverse (element level toc-buffer)
+ "Insert TOC for subtree ELEMENT on LEVEL."
+ (let ((c (sgml-element-content element)))
+ (while c
+ (if (member (downcase (sgml-element-gi c)) '("title" "refname" "refdescriptor"))
+ (doctoc-psgml-handle-title c level toc-buffer)
+ (doctoc-psgml-traverse c (+ 1 level) toc-buffer))
+ (setq c (sgml-element-next c)))))
+
+(defun doctoc-psgml-handle-title (element level toc-buffer)
+ "Generate TOC entry for ELEMENT on LEVEL.
+Tests if LEVEL is correct, i.e. parent is not .*info.
+If it is, level is decremented."
+ (save-excursion
+ (let* ((epos (sgml-element-stag-epos element))
+ (bgn (progn
+ (sgml-goto-epos epos)
+ (forward-char (sgml-element-stag-len element))
+ (skip-chars-forward " \t\n\r")
+ (point)))
+ (end (progn
+ (sgml-goto-epos (sgml-element-etag-epos element))
+ (skip-chars-backward " \t\n\r")
+ (point)))
+ (toc-text (buffer-substring-no-properties bgn end))
+ (line (count-lines (point-min) bgn))
+ (parent (sgml-element-parent element))
+ (infoelement (or (string-match "info$" (sgml-element-gi parent))
+ (member (downcase (sgml-element-gi parent))
+ '("title" "refname" "refdescriptor"))))
+ (sect-level (if infoelement (1- level) level))
+ (sect-element (if infoelement (sgml-element-parent parent) parent))
+ (indent (* 3 (1- sect-level)))
+ bor)
+ (setq toc-text (doctoc-psgml-effective-text toc-text sect-element))
+ (unless (not toc-text)
+ (set-buffer toc-buffer)
+ (setq bor (point))
+ (setq left-margin indent)
+ (insert toc-text)
+ (unless (sgml-bpos-p epos)
+ (insert " [entity "
+ (sgml-entity-name (sgml-eref-entity (sgml-epos-eref epos)))
+ "]"))
+ (fill-region-as-paragraph bor (point))
+ (skip-chars-backward " \t\n\r")
+ (when (> (current-column) 72)
+ (newline))
+ (insert " ")
+ (insert (make-string (- 73 (current-column)) ?\.))
+ (insert (format "%5i\n" line))
+ (doctoc-set-text-properties bor (point)
+ (plist-get doctoc-level-faces sect-level)
+ epos)
+ (when (= sect-level 0) (insert "\n"))
+ ))))
+
+(defvar doctoc-psgml-format
+ '("figure" "· Fig: "
+ "table" "· Tab: ")
+ "Property list controlling TOC display.
+The CAR is the GI of the identifier.
+The CDR is
+ 'nil if the TOC text needs no modification
+ This is the default if no entry matches.
+ 't if there should be no TOC entry
+ STRING if the entry is to be prefixed with STRING.")
+
+(defun doctoc-psgml-effective-text (text element)
+ (let* ((gi (downcase (sgml-element-gi parent)))
+ (format (lax-plist-get doctoc-psgml-format gi)))
+ (cond
+ ((not format) text)
+ ((stringp format) (concat format text))
+ (t nil))))
+
+(setq doctoc-generate-function 'doctoc-psgml-generate-toc)
+
+(provide 'doctoc-psgml)
\ No newline at end of file
;; doctoc.el --- Handle table of contents for docbook
;; Copyright (C) 2001, 2002 Jens Emmerich <Jens.Emmerich@itp.uni-leipzig.de>
-;; Version: 1.3
+;; Version: 2.0
;; Keywords: wp, sgml, xml, docbook
;; Maintainer: Jens Emmerich
;;; Commentary:
-;; This file provides support for am interactive table of contents for
-;; docbook(x) documents using an external parser (toc.pl). In fact it
-;; is quite general, it only (re-)starts a process, pipes the current
-;; buffer through it and can jump to the line given at the end of the
-;; line. Unlike RefTeX, it only handles the current buffer.
+;; `doctoc' provides support for an interactive table of contents for
+;; DocBook(x) documents using an external parser (toc.pl) or the psgml
+;; parse tree. Currently, only the psgml-version is complete.
+
+;; For the external parser it is quite general, it only (re-)starts a
+;; process, pipes the current buffer through it and can jump to the
+;; line given at the end of output lines. Unlike RefTeX, it only
+;; handles the current buffer in this case.
;; Install into load-path and add something like
;;
;; (defun my-sgml-setup ()
;; "Customize psgml for xml."
-;; (load "doctoc")
+;; (require 'doctoc-psgml)
;; ;; ... more customizations
;; (define-key sgml-mode-map [(control c)(=)] 'doctoc-toc-current-line))
;;
;;; Code:
+;; dependencies on psgml are entity-handling for parsing with an
+;; external parser and additionally the parse-tree for the internal
+;; (psgml-based) parser
+
+(require 'psgml)
+
+;;; Variables for customizations
(defvar doctoc-toc-buffer "*TOC %s*"
"Buffer holding the toc for a docbook document")
-(defvar doctoc-toc-command "toc.pl 2> /dev/null"
- "Command producing the toc to stdout from stdin docbook document")
+(defvar doctoc-generate-function 'doctoc-psgml-generate-toc
+ "Function to run to generate TOC.
+It is called in the document buffer
+with the TOC buffer as argument.")
+
+;; Faces used for Highlighting
+
+(make-face 'doctoc-level1-face)
+(set-face-foreground 'doctoc-level1-face "red")
+(make-face-bold 'doctoc-level1-face)
+(make-face 'doctoc-level2-face)
+(set-face-foreground 'doctoc-level2-face "blue")
+(make-face-bold 'doctoc-level2-face)
+(make-face 'doctoc-level3-face)
+(set-face-foreground 'doctoc-level3-face "blue")
+
+(defvar doctoc-level-faces
+ (list
+ 0 'doctoc-level1-face
+ 1 'doctoc-level1-face
+ 2 'doctoc-level2-face
+ 3 'doctoc-level3-face)
+ "A property list of level - face relations.")
-(defvar doctoc-line-number-regexp
- "[^\n\r]* \\([0-9]+\\)[\r\n]"
-"Regexp for finding the next line number in toc.
-Should also match in outline-minor-mode.")
+;;; TOC generation / document buffer commands
(defun doctoc-toc ()
"Create or select a table of contents for current (docbook-) buffer"
(interactive)
+ (when (and (boundp 'sgml-parent-document) sgml-parent-document)
+ (find-file sgml-parent-document))
(let
((buffer (get-buffer (format doctoc-toc-buffer (buffer-name)))))
(if buffer
(erase-buffer)
(save-excursion
(set-buffer doc-buffer)
- (shell-command-on-region (point-min) (point-max)
- doctoc-toc-command toc-buffer))
- (doctoc-make-extents)
+ (funcall doctoc-generate-function toc-buffer))
+ (goto-char (point-min))
+ (insert (format "Table of Contents for %s\n\n" (buffer-name doc-buffer)))
+ (doctoc-set-text-properties (point-min) (1- (point))
+ (plist-get doctoc-level-faces 0) 0)
(setq buffer-read-only t)
(message "Regenerating toc ... done")
(goto-line line)
;; strange, but recenter fixes a problem (only lines in current
;; window are displayed, otherwise goto-line has no effect)
(recenter '(t))
- (sit-for 4e4 t)
+ (sit-for 2)
(message nil)))
(defun doctoc-make-toc ()
(setq buffer-read-only nil)
(erase-buffer))
(message "Generating toc ... ")
- (shell-command-on-region (point-min) (point-max)
- doctoc-toc-command toc-buffer)
+ (funcall doctoc-generate-function toc-buffer)
(switch-to-buffer-other-window toc-buffer)
+ (goto-char (point-min))
+ (insert (format "Table of Contents for %s\n\n" (buffer-name doc-buffer)))
+ (doctoc-set-text-properties (point-min) (point)
+ (plist-get doctoc-level-faces 0) 0)
(doctoc-mode)
(make-local-variable 'document-buffer)
(make-local-variable 'window-configuration)
(setq document-buffer doc-buffer
window-configuration win-config)
- (doctoc-make-extents)
(message "Generating toc ... done")
- (sit-for 4e4)
+ (sit-for 2)
(message nil)
toc-buffer))
(pop-to-buffer buffer)
(setq window-configuration win-config)))
+;;; TOC buffer commands
+
(defun doctoc-back ()
"Leave doctoc buffer and switch back to buffer 'doc-buffer"
(interactive)
(set-window-configuration window-configuration)
(switch-to-buffer dest-buffer)))
-(defun doctoc-find-line ()
- "Search for next line number as given by 'doctoc-line-number-regexp
-Line number is returned, nil if not found. Keep point."
- (save-excursion
- (doctoc-find-line-move)))
-
-(defun doctoc-find-line-move ()
- "Search for next line number as given by 'doctoc-line-number-regexp
-Line number is returned, nil if not found. Point is left at beginning
-of matching line."
- (beginning-of-line)
- (while (not (or (looking-at doctoc-line-number-regexp) (eobp)))
- (forward-line))
- (if (looking-at doctoc-line-number-regexp)
- (string-to-int (buffer-substring
- (match-beginning 1) (match-end 1)))
- nil))
-
-(defun doctoc-goto-line-toc (line)
- "Search LINE in toc and move point to it.
-Goto first line where line number at end <= LINE."
- (while
- (let
- ((found-line (doctoc-find-line-move)))
- (and found-line (< found-line line) (not (eobp))))
- (forward-line)))
+(defun doctoc-goto-epos-toc (epos)
+ "Search EPOS in toc and move point to it.
+Goto first line in toc where title epos <= EPOS."
+ (let ((pos
+ (map-extents 'doctoc-compare-extent nil nil nil epos)))
+ (goto-char
+ (if pos pos (point-max)))))
+(defun doctoc-compare-extent (extent epos)
+ "Return start of extent if epos property is not after EPOS"
+ (let ((tocentry-epos (extent-property extent 'epos)))
+ (if tocentry-epos
+ (if (<= (sgml-epos-before tocentry-epos) (sgml-epos-before epos))
+ (extent-start-position extent)
+ nil)
+ nil)))
+
(defun doctoc-toc-current-line ()
"Goto toc entry corresponding to point"
(interactive)
- (let ((goal-line (line-number)))
+ (let ((epos (sgml-epos (point))))
(doctoc-toc)
- (doctoc-goto-line-toc goal-line)))
+ (doctoc-goto-epos-toc epos)))
+
+(defun doctoc-find-epos ()
+ "Return epos of toc entry at point."
+ (let ((extent (extent-at (point) nil 'epos)))
+ (if extent
+ (extent-property extent 'epos)
+ nil)))
+
+(defun doctoc-find-upos ()
+ "Return upos of toc entry at point."
+ (let ((extent (extent-at (point) nil 'upos)))
+ (if extent
+ (extent-property extent 'upos)
+ nil)))
(defun doctoc-jump ()
- "Jump back to line given by the number at eol to buffer 'doc-buffer"
+ "Jump to position pointed to by current toc entry."
(interactive)
- (let ((dest-buffer document-buffer)
- (lineno (doctoc-find-line)))
- (if lineno
- (progn
- (set-window-configuration window-configuration)
- (switch-to-buffer dest-buffer)
- (goto-line lineno))
- (message "No toc entry at point."))))
+ (let ((epos (doctoc-find-epos))
+ (upos (doctoc-find-upos)))
+ (cond
+ (epos (set-window-configuration window-configuration)
+ (doctoc-goto-epos epos))
+ (upos (set-window-configuration window-configuration)
+ (doctoc-goto-upos upos))
+ (t (message "No toc entry at point.")))))
(defun doctoc-jump-mouse ()
(interactive)
(goto-char (event-closest-point current-mouse-event))
(doctoc-jump))
-
+
(defun doctoc-show ()
"Show the line given by the number at eol 'doc-buffer in other window"
(interactive)
(let
- ((lineno (doctoc-find-line)))
- (if lineno
- (let ((extent
- (progn
- (save-selected-window
- (switch-to-buffer-other-window document-buffer)
- (goto-line lineno)
- (recenter '(t))
- (doctoc-highlight-title)))))
- (if (extentp extent)
- (let ((inhibit-quit t))
- (sit-for 4e4) ; 'for-e-ver'
- (delete-extent extent)))))))
+ ((epos (doctoc-find-epos))
+ (upos (doctoc-find-upos)))
+ (when (or epos upos)
+ (let ((extent
+ (progn
+ (save-selected-window
+ (switch-to-buffer-other-window document-buffer)
+ (if epos
+ (doctoc-goto-epos epos)
+ (doctoc-goto-upos upos))
+ (recenter '(t))
+ (doctoc-highlight-title)))))
+ (if (extentp extent)
+ (let ((inhibit-quit t))
+ (sit-for 4e4) ; 'for-e-ver'
+ (delete-extent extent))
+ (message "Can't find title, regenerate TOC!"))))))
(defun doctoc-show-mouse ()
"Show the line given by the number at eol 'doc-buffer in other window
(interactive)
(goto-char (event-closest-point current-mouse-event))
(let
- ((lineno (doctoc-find-line)))
- (if lineno
- (save-window-excursion
- (let ((extent
- (progn
- (switch-to-buffer-other-window document-buffer)
- (goto-line lineno)
- (recenter '(t))
- (doctoc-highlight-title))))
- (if (extentp extent)
- (let ((inhibit-quit t))
- (sit-for 4e4) ; 'for-e-ver'
- (delete-extent extent))))))))
+ ((epos (doctoc-find-epos))
+ (upos (doctoc-find-upos)))
+ (when (or epos upos)
+ (save-window-excursion
+ (let ((extent
+ (progn
+ (switch-to-buffer-other-window document-buffer)
+ (if epos
+ (doctoc-goto-epos epos)
+ (doctoc-goto-upos upos))
+ (recenter '(t))
+ (doctoc-highlight-title))))
+ (if (extentp extent)
+ (let ((inhibit-quit t))
+ (sit-for 4e4) ; 'for-e-ver'
+ (delete-extent extent))
+ (message "Can't find title, regenerate TOC!")))))))
-;; highlight next title at/after current line and return extent
-;; return nil if no title was found
-(defun doctoc-highlight-title ()
- (let ((tstart (progn
- (beginning-of-line)
- (if (re-search-forward "<title[^>]*>" (point-max) t)
- (match-end 0)
- nil))))
- (if tstart
- (progn
- (goto-char tstart)
- (if (re-search-forward "</title>" (point-max) t)
- (let ((extent
- (make-extent tstart (match-beginning 0))))
- (set-extent-face extent 'highlight)
- extent))))))
+(defun doctoc-highlight-title ()
+ "Highlight next title in document buffer
+Highlight next title at/after current line and return extent.
+Return nil if no title was found."
+ (let* ((tstart (save-excursion
+ (beginning-of-line)
+ (cond
+ ((re-search-forward "<title[^>]*>" (min (point-max) (+ (point) 1000)) t)
+ (match-end 0))
+ ((re-search-backward "<title[^>]*>" (max (point-min) (- (point) 1000)) t)
+ (match-end 0))
+ (t nil))))
+ (tend (cond
+ (tstart
+ (goto-char tstart)
+ (and (re-search-forward "</title>" (point-max) t)
+ (match-beginning 0)))
+ (t nil))))
+ (when (and tstart tend)
+ (let ((extent (make-extent tstart tend)))
+ (set-extent-face extent 'highlight)
+ extent))))
+
+(defun doctoc-goto-epos (epos)
+ "Goto a position in an entity given by EPOS.
+Opens the file in case of an external entity."
+ (assert epos)
+ (cond ((sgml-bpos-p epos)
+ (goto-char epos))
+ (t
+ (let*
+ ((eref (sgml-epos-eref epos))
+ (entity (sgml-eref-entity eref))
+ (file (if (consp (sgml-entity-text entity))
+ (sgml-external-file (sgml-entity-text entity)
+ (sgml-entity-type entity)
+ (sgml-entity-name entity))
+ nil)))
+ (cond (file
+ (find-file file)
+ (goto-char (sgml-epos-pos epos)))
+ (t
+ (sgml-goto-epos epos)
+ (switch-to-buffer (current-buffer))))))))
+
+(defun doctoc-goto-upos (upos)
+ "Goto a position in an entity referenced by UPOS.
+UPOS is defined as (URL.LINE)"
+ (assert (consp upos))
+ (require 'ffap)
+ (find-file-at-point (car upos))
+ (goto-line (cdr upos)))
+
+;;; Major mode definition
(defvar doctoc-mode-map
(let ((m (make-sparse-keymap)))
(setq mode-name "doctoc")
(setq truncate-lines t)
;; length of match defines level => also match spaces
- (setq outline-regexp "^[0-9]+\\(\\.[0-9]+\\)* +\\b")
- (outline-minor-mode 1)
+ (when (featurep 'outline)
+ (setq outline-regexp "^\\([0-9]+\\(\\.[0-9]+\\)*\\)? +\\b")
+ (outline-minor-mode 1))
;; turn off horizontal scrollbars in this buffer
;; toc.pl produces short enough lines
(when (featurep 'scrollbar)
(set-specifier scrollbar-height (cons (current-buffer) 0)))
+ (setq indent-tabs-mode nil)
(run-hooks 'doctoc-mode-hook))
-;;; Faces used for Highlighting
-
-(make-face 'doctoc-level1-face)
-(set-face-foreground 'doctoc-level1-face "red")
-(make-face-bold 'doctoc-level1-face)
-(make-face 'doctoc-level2-face)
-(set-face-foreground 'doctoc-level2-face "blue")
-(make-face-bold 'doctoc-level2-face)
-(make-face 'doctoc-level3-face)
-(set-face-foreground 'doctoc-level3-face "blue")
-
-;; 'doctoc-level-faces a la font-lock-keywords
-(defvar doctoc-level-faces
- (list
- '("^ *[0-9]+ +\\(.*[^0-9]\n\\)*.*[0-9]$" . doctoc-level1-face)
- '("^ *[0-9]+\\.[0-9]+ +\\(.*[^0-9]\n\\)*.*[0-9]$" . doctoc-level2-face)
- '("^ *[0-9]+\\.[0-9]+\\.[0-9]+ +\\(.*[^0-9]\n\\)*.*[0-9]$" . doctoc-level3-face))
- "A list of cons cells (regexp . face) determining faces for doctoc buffers
-The regexp is matched at the beginning of a line end extends
-to the line number given for that toc-entry. The first
-matching regexp is used.")
-
-;;;; Extent handling
-;;; This is probably stronly XEmacs dependent
-
-;; parse buffer and set extents for highlighting
-(defun doctoc-make-extents ()
- (goto-char 0)
- (while (not (eobp))
- (let ((bgn (progn
- (beginning-of-line)
- (point)))
- (end (progn
- (re-search-forward doctoc-line-number-regexp (point-max) t)
- (re-search-backward "\\>" (point-min) t))))
- (doctoc-set-text-properties bgn end)
- (forward-line)))
- (goto-char 0))
-
-;; make extent from start to end and set face according
-;; to doctoc-level-faces
-(defun doctoc-set-text-properties (start end)
- (let ((title-extent (make-extent start end))
- (faces doctoc-level-faces)
- (face nil))
- (save-excursion
- (goto-char start)
- (while (and faces (not face))
- (if (looking-at (caar faces))
- (setq face (cdar faces))
- (setq faces (cdr faces)))))
- (set-extent-property title-extent 'start-open t)
- (set-extent-property title-extent 'end-open t)
- (set-extent-face title-extent (or face 'default))
- (set-extent-mouse-face title-extent 'highlight)))
+;;; Extent handling
+;; This is probably stronly XEmacs dependent
+
+(defun doctoc-set-text-properties (start end &optional title-face epos upos)
+ "Make extent from START to END, set FACE and jump-destination EPOS or UPOS.
+EPOS is as defined in psgml-parse.el
+UPOS is (URL . line)"
+ (let ((title-extent (make-extent start end)))
+ (set-extent-property title-extent 'start-open t)
+ (set-extent-property title-extent 'end-open t)
+ (when epos
+ (set-extent-property title-extent 'epos epos))
+ (when upos
+ (set-extent-property title-extent 'upos upos))
+ (when title-face
+ (set-extent-face title-extent title-face))
+ (set-extent-mouse-face title-extent 'highlight)))
+
+(provide 'doctoc)
\ No newline at end of file
#!/usr/bin/perl -w
# Generate a table of contents for a docbook document
# tags are case insensitive
-# Copyright (C) 2001 Jens Emmerich <Jens.Emmerich@itp.uni-leipzig.de>
-# 2001-04-13 Jens Emmerich
-#
-## This Program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License as
-## published by the Free Software Foundation; version 2.
-##
-## This Program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## This program is intended (but not limited) to be used together with (X)Emacs.
-## You should have received a copy of the GNU General Public License
-## along with GNU Emacs or XEmacs; see the file COPYING. If not,
-## write to the Free Software Foundation Inc., 59 Temple Place - Suite
-## 330, Boston, MA 02111-1307, USA.
+# part of doctoc version 2.0
use XML::Parser;
use integer;
use strict;
-#use utf8; # for recent perl versions; can be
- # omitted, results in some "garbage" in
- # output then
-use Unicode::String; # used to convert utf8 to latin1
+#use utf8;
package Toc;
# levels:
# >=0 absolute level
-# -1 additional level relative to current, numbered
+# -1 additional level relative to current, numbered
# -2 additional level relative to current, not numbered,
# doesn't increase level
# -3 don't include into toc
@Toc::secnums = (0) x (max(values %Toc::levels)+1); # section numbers
$Toc::parent = ""; # parent of last <title>
$Toc::parentline_no = 0; # line no of parent
+$Toc::parentbase = ""; # base URL of parent
$Toc::minlevel = 0; # =0 for book, =1 for article
# detected automatically
$Toc::currentlevel = 0; # level of current $title
$Toc::title = ""; # current <title> or <titleabbrev>
$Toc::extraindent_step = 0; # additionally indent toc entry
# by this much per level
-$Toc::width = 75; # 3 characters needed for emacs' outline minor mode
+$Toc::width = 75; # 3 characters needed for outline minor mode
$Toc::fill_character = "."; # "·" might be nice in some fonts
# return largest
# emit an toc entry for $parent, $title
sub tocentry {
use Text::Wrap;
- use TexT::Tabs;
my $text = $Toc::title;
$Toc::title = "";
my $parent_level = $Toc::levels{$Toc::parent};
my $line_no = $Toc::parentline_no;
+ my $base = $Toc::parentbase;
my $clevel = $Toc::currentlevel;
my $mlevel = $Toc::minlevel;
my $extra_indent = max(0,($clevel-$mlevel)*$Toc::extraindent_step);
$text=~s/<[^>]+>//g;
$text=~s/\s+/ /g;
+ # prepend base URL to line number
+ $line_no = "$base :$line_no" unless $base eq "-";
+
# generate complete number
my $num="";
if($parent_level > -2) {
$num .= $Toc::secnums[$i].".";
}
chop($num) if $num;
- $num .= " " x (3*($clevel-$mlevel )-1-length($num));
+ $num .= " " x (3*($clevel-$mlevel)-1-length($num));
} else {
- $num = " " x (3*($clevel-$mlevel+2)-1); # unnumbered entry
+ # unnumbered entry
+ $num = " " x (3*($clevel-$mlevel+1)-1);
}
# wrap title
- my $pre1 = (" " x $extra_indent).$num." ";
+ my $pre1 = " " x $extra_indent.$num." ";
my $pre2 = " " x length($pre1);
- my $lp = length($line_no);
- $Text::Wrap::columns = $Toc::width-1-$lp;
- $text =~ tr/\t/ /;
+ $Text::Wrap::columns = $Toc::width-1-6; # 6 digits for line number
$text = wrap($pre1, $pre2, $text);
- $text = Text::Tabs::expand($text);
-
+ $text =~ tr/\t/ /;
# fill last line with points, $l is bare length of last line
my $l=length($text)-(rindex($text,"\n")+1);
+ my $lp = length($line_no);
+ # take possibly long position into account
my $fill=$Toc::width-$lp-$l;
+ if($fill < 0) {
+ # needs to be on line by itself
+ $fill=$Toc::width-$l-6;
+ if($lp > $Toc::width-length($pre2)) {
+ # doesn't even fit on a regular line
+ $line_no = "\n". $pre2 . $line_no;
+ } else {
+ # fits
+ $line_no = "\n". " " x ($Toc::width-$lp) . $line_no;
+ }
+ }
unless($fill < 2) {
$fill = " ".($Toc::fill_character x ($fill-2))." ";
} else {
&tocentry if $Toc::title; # title was not yet emitted to toc
$Toc::parent=$tagname;
$Toc::parentline_no = $parser->current_line();
+ $Toc::parentbase = $parser->base();
$element_level=$Toc::levels{$tagname};
if($element_level>=0) {
# look for gaps
# character data handler
sub cdata {
- # translate utf8 to latin1
- # (solution on http://www.perldoc.com/perl5.6/pod/perlunicode.html does not work with
- # the cygnus perl 5.6.0 tr-operator)
- my $u= Unicode::String::utf8( $_[1]); # create Unicode::String
- $Toc::title .= $u->latin1; # convert string to latin1
+ $Toc::title .= $_[1];
}
# "main"
+
my $file = '-';
unshift(@ARGV, $file) unless @ARGV;
+
while(defined($file = shift)) {
- my $parser = new XML::Parser(ErrorContext => 2, NoLWP => 1);
+ my $parser = new XML::Parser(ErrorContext => 2);
$parser->setHandlers(Start => \&first_stag,
End => \&etag);
$parser->parsefile($file);
projects / docbook-dsssl / commitdiff