From: Jens Emmerich Date: Fri, 12 Jul 2002 23:28:08 +0000 (+0000) Subject: - add support for using PSGMLs parse tree X-Git-Tag: release/1.79.1~6^2~5430 X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=c530617fd083e2726c0f8063e1ed58e11c6ad0ca;p=docbook-dsssl - add support for using PSGMLs parse tree - seperate files for external parser (toc.pl) and PSGML-based parser - updated installation instructions in README - updated README to reflect PSGML and toc.pl support - complete support (external & PSGML) for external extities - layout improvements - require and provide --- diff --git a/contrib/tools/emacs/doctoc/README b/contrib/tools/emacs/doctoc/README index 2ea4797c0..1f9b41c4d 100644 --- a/contrib/tools/emacs/doctoc/README +++ b/contrib/tools/emacs/doctoc/README @@ -1,36 +1,73 @@ 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-. 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 @@ -38,7 +75,7 @@ Credits ------- I do miss RefTeX's/AucTeX's elaborate features, all ideas borrowed -there. +there. PSGML is great stuff, nevertheless. Contact ------- diff --git a/contrib/tools/emacs/doctoc/doctoc-ext.el b/contrib/tools/emacs/doctoc/doctoc-ext.el new file mode 100644 index 000000000..5e518af3e --- /dev/null +++ b/contrib/tools/emacs/doctoc/doctoc-ext.el @@ -0,0 +1,82 @@ +;; doctoc-ext.el --- external parser module for doctoc + +;; part of doctoc version 2.0 + +(require 'doctoc) +(require 'ffap) + +;;; parser interface + +(defun doctoc-ext-generate-toc (toc-buffer) + "Run external command to generate toc in DOCTOC-TOC-BUFFER." + (shell-command-on-region (point-min) (point-max) + doctoc-ext-toc-command toc-buffer) + (if (buffer-live-p toc-buffer) + (let ((doc-buffer (current-buffer))) + (save-excursion + (set-buffer toc-buffer) + (doctoc-ext-parse doc-buffer))) + (error "External command produced no output."))) + +;;; internally used definitions + +(defvar doctoc-ext-toc-command "toc.pl" + "Command producing the toc to stdout from stdin docbook document") + +(defvar doctoc-ext-line-number-regexp + "[^\n\r]*[ \t]:?\\([0-9]+\\)[\r\n]" +"Regexp for finding the next line number in toc. +Should also match in outline-minor-mode. +Eats up one character more that the line number.") + +(defvar doctoc-ext-level-regexp + (list + '("^ *[0-9]+ +\\(.*[^0-9]\n\\)*.*[0-9]$" . 1) + '("^ *[0-9]+\\.[0-9]+ +\\(.*[^0-9]\n\\)*.*[0-9]$" . 2) + '("^ *[0-9]+\\.[0-9]+\\.[0-9]+ +\\(.*[^0-9]\n\\)*.*[0-9]$" . 3)) + "A list of cons cells (regexp . level) determining heading levels for doctoc buffers. +The regexp is matched with point at the beginning of a line +end extends to the line number given for that toc-entry. +The first matching regexp is used.") + +(defun doctoc-ext-parse (document-buffer) + "Parse buffer and set extents for highlighting/jumping in doctoc-mode" + (goto-char 0) + (let (bgn) + (while (progn + (beginning-of-line) + (setq bgn (point)) + (re-search-forward doctoc-ext-line-number-regexp (point-max) t)) + (let* ((line-begin (match-beginning 1)) + (line-end (match-end 1)) + (line (string-to-int (buffer-substring line-begin line-end))) + (url nil) + (level nil) + (levels doctoc-ext-level-regexp) + (face nil) + (epos nil) + (upos nil)) + (save-excursion + (goto-char bgn) + (while (and levels (not level)) + (if (looking-at (caar levels)) + (setq level (cdar levels)) + (setq levels (cdr levels)))) + (goto-char (1- line-begin)) + (if (looking-at ":") + (progn + (setq url (ffap-next-guess 'back bgn)) + (when url (setq upos (cons url line)))) + (progn + (set-buffer document-buffer) + (goto-line line) + (setq epos (sgml-epos (point)))))) + (when level + (setq face (plist-get doctoc-level-faces level))) + (doctoc-set-text-properties bgn (1- (point)) face epos upos))) + (goto-char 0))) + +(setq doctoc-generate-function 'doctoc-ext-generate-toc) + +(provide 'doctoc-ext) + diff --git a/contrib/tools/emacs/doctoc/doctoc-psgml.el b/contrib/tools/emacs/doctoc/doctoc-psgml.el new file mode 100644 index 000000000..bba889f9e --- /dev/null +++ b/contrib/tools/emacs/doctoc/doctoc-psgml.el @@ -0,0 +1,99 @@ +;; 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 diff --git a/contrib/tools/emacs/doctoc/doctoc.el b/contrib/tools/emacs/doctoc/doctoc.el index 37be87a07..6aa825517 100644 --- a/contrib/tools/emacs/doctoc/doctoc.el +++ b/contrib/tools/emacs/doctoc/doctoc.el @@ -1,7 +1,7 @@ ;; doctoc.el --- Handle table of contents for docbook ;; Copyright (C) 2001, 2002 Jens Emmerich -;; Version: 1.3 +;; Version: 2.0 ;; Keywords: wp, sgml, xml, docbook ;; Maintainer: Jens Emmerich @@ -26,17 +26,20 @@ ;;; 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)) ;; @@ -58,21 +61,48 @@ ;;; 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 @@ -99,16 +129,18 @@ Should also match in outline-minor-mode.") (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 () @@ -127,17 +159,19 @@ Return the buffer holding the 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)) @@ -147,6 +181,8 @@ Return the buffer holding the toc" (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) @@ -154,74 +190,82 @@ Return the buffer holding the toc" (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 @@ -229,37 +273,79 @@ The title is shown as long as the button is pressed" (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 "]*>" (point-max) t) - (match-end 0) - nil)))) - (if tstart - (progn - (goto-char tstart) - (if (re-search-forward "" (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 "]*>" (min (point-max) (+ (point) 1000)) t) + (match-end 0)) + ((re-search-backward "]*>" (max (point-min) (- (point) 1000)) t) + (match-end 0)) + (t nil)))) + (tend (cond + (tstart + (goto-char tstart) + (and (re-search-forward "" (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))) @@ -291,66 +377,32 @@ Commands are: (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 diff --git a/contrib/tools/emacs/doctoc/toc.pl b/contrib/tools/emacs/doctoc/toc.pl index 652199050..af783ae03 100755 --- a/contrib/tools/emacs/doctoc/toc.pl +++ b/contrib/tools/emacs/doctoc/toc.pl @@ -1,36 +1,17 @@ #!/usr/bin/perl -w # Generate a table of contents for a docbook document # tags are case insensitive -# Copyright (C) 2001 Jens Emmerich -# 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 @@ -120,13 +101,14 @@ package Toc; @Toc::secnums = (0) x (max(values %Toc::levels)+1); # section numbers $Toc::parent = ""; # parent of last $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 @@ -141,11 +123,11 @@ sub max { # 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); @@ -154,6 +136,9 @@ sub tocentry { $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) { @@ -162,24 +147,35 @@ sub tocentry { $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 { @@ -214,6 +210,7 @@ sub stag { &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 @@ -253,19 +250,17 @@ sub etag { # 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);