X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9304909ed21d969e814d6530a5c4ef7ab6813a24..dc3eeeb48af706de824b7b8bae62dc868d26637e:/lisp/informat.el diff --git a/lisp/informat.el b/lisp/informat.el index 67c915f9be..96dc018041 100644 --- a/lisp/informat.el +++ b/lisp/informat.el @@ -1,6 +1,7 @@ ;;; informat.el --- info support functions package for Emacs -;; Copyright (C) 1986 Free Software Foundation, Inc. +;; Copyright (C) 1986, 2002, 2003, 2004, 2005, +;; 2006 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help @@ -19,48 +20,108 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Nowadays, the Texinfo formatting commands always tagify a buffer +;; (as does `makeinfo') since @anchor commands need tag tables. ;;; Code: (require 'info) ;;;###autoload -(defun Info-tagify () - "Create or update Info-file tag table in current buffer." +(defun Info-tagify (&optional input-buffer-name) + "Create or update Info file tag table in current buffer or in a region." (interactive) ;; Save and restore point and restrictions. ;; save-restrictions would not work ;; because it records the old max relative to the end. ;; We record it relative to the beginning. - (message "Tagifying %s ..." (file-name-nondirectory (buffer-file-name))) + (if input-buffer-name + (message "Tagifying region in %s ..." input-buffer-name) + (message + "Tagifying %s ..." (file-name-nondirectory (buffer-file-name)))) (let ((omin (point-min)) (omax (point-max)) (nomax (= (point-max) (1+ (buffer-size)))) (opoint (point))) (unwind-protect - (progn - (widen) - (goto-char (point-min)) - (if (search-forward "\^_\nIndirect:\n" nil t) - (message "Cannot tagify split info file") - (let ((regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]") - (case-fold-search t) - list) - (while (search-forward "\n\^_" nil t) - ;; We want the 0-origin character position of the ^_. - ;; That is the same as the Emacs (1-origin) position - ;; of the newline before it. - (let ((beg (match-beginning 0))) - (forward-line 2) - (if (re-search-backward regexp beg t) - (setq list - (cons (list (buffer-substring-no-properties - (match-beginning 1) - (match-end 1)) - beg) - list))))) + (progn + (widen) + (goto-char (point-min)) + (if (search-forward "\^_\nIndirect:\n" nil t) + (message + "Cannot tagify split info file. Run this before splitting.") + (let (tag-list + refillp + (case-fold-search t) + (regexp + (concat + "\\(" + + + "\\(" + "@anchor" ; match-string 2 matches @anchor + "\\)" + "\\(-no\\|-yes\\)" ; match-string 3 matches -no or -yes + "\\(" + "-refill" + "\\)" + + "\\(" + "{" + "\\)" + "\\(" + "[^}]+" ; match-string 6 matches arg to anchor + "\\)" + "\\(" + "}" + "\\)" + + "\\|" + + "\\(" + "\n\^_\\(\^L\\)?" + "\\)" + + "\\(" + "\n\\(File:[ \t]*\\([^,\n\t]*\\)[,\t\n]+[ \t\n]*\\)?" + "Node:[ \t]*" + "\\(" + "[^,\n\t]*" ; match-string 13 matches arg to node name + "\\)" + "[,\t\n]" + "\\)" + + "\\)" + ))) + (while (re-search-forward regexp nil t) + (if (string-equal "@anchor" (match-string 2)) + (progn + ;; kludge lest lose match-data + (if (string-equal "-yes" (match-string 3)) + (setq refillp t)) + (setq tag-list + (cons (list + (concat "Ref: " (match-string 6)) + (match-beginning 0)) + tag-list)) + (if (eq refillp t) + ;; set start and end so texinfo-format-refill works + (let ((texinfo-command-start (match-beginning 0)) + (texinfo-command-end (match-end 0))) + (texinfo-format-refill)) + (delete-region (match-beginning 0) (match-end 0)))) + ;; else this is a Node + (setq tag-list + (cons (list + (concat "Node: " (match-string-no-properties 13)) + (1+ (match-beginning 10))) + tag-list)))) + (goto-char (point-max)) (forward-line -8) (let ((buffer-read-only nil)) @@ -70,20 +131,26 @@ (beginning-of-line) (delete-region (point) end))) (goto-char (point-max)) + (or (bolp) + (newline)) (insert "\^_\f\nTag table:\n") (if (eq major-mode 'info-mode) (move-marker Info-tag-table-marker (point))) - (setq list (nreverse list)) - (while list - (insert "Node: " (car (car list)) ?\177) - (princ (car (cdr (car list))) (current-buffer)) + (setq tag-list (nreverse tag-list)) + (while tag-list + (insert (car (car tag-list)) ?\177) + (princ (car (cdr (car tag-list))) (current-buffer)) (insert ?\n) - (setq list (cdr list))) + (setq tag-list (cdr tag-list))) (insert "\^_\nEnd tag table\n"))))) (goto-char opoint) (narrow-to-region omin (if nomax (1+ (buffer-size)) (min omax (point-max)))))) - (message "Tagifying %s ... done" (file-name-nondirectory (buffer-file-name)))) + (if input-buffer-name + (message "Tagifying region in %s done" input-buffer-name) + (message + "Tagifying %s done" (file-name-nondirectory (buffer-file-name))))) + ;;;###autoload (defun Info-split () @@ -153,6 +220,10 @@ contains just the tag table and a directory of subfiles." (search-forward "\nTag Table:\n") (insert "(Indirect)\n"))) +(defvar Info-validate-allnodes) +(defvar Info-validate-thisnode) +(defvar Info-validate-lossages) + ;;;###autoload (defun Info-validate () "Check current buffer for validity as an Info file. @@ -166,76 +237,79 @@ Check that every node pointer points to an existing node." (error "Don't yet know how to validate indirect info files: \"%s\"" (buffer-name (current-buffer)))) (goto-char (point-min)) - (let ((allnodes '(("*"))) + (let ((Info-validate-allnodes '(("*"))) (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]") (case-fold-search t) (tags-losing nil) - (lossages ())) + (Info-validate-lossages ())) (while (search-forward "\n\^_" nil t) (forward-line 1) (let ((beg (point))) (forward-line 1) (if (re-search-backward regexp beg t) (let ((name (downcase - (buffer-substring-no-properties - (match-beginning 1) - (progn - (goto-char (match-end 1)) - (skip-chars-backward " \t") - (point)))))) - (if (assoc name allnodes) - (setq lossages + (buffer-substring-no-properties + (match-beginning 1) + (progn + (goto-char (match-end 1)) + (skip-chars-backward " \t") + (point)))))) + (if (assoc name Info-validate-allnodes) + (setq Info-validate-lossages (cons (list name "Duplicate node-name" nil) - lossages)) - (setq allnodes - (cons (list name - (progn - (end-of-line) - (and (re-search-backward - "prev[ious]*:" beg t) - (progn - (goto-char (match-end 0)) - (downcase - (Info-following-node-name))))) - beg) - allnodes))))))) + Info-validate-lossages)) + (setq Info-validate-allnodes + (cons (list name + (progn + (end-of-line) + (and (re-search-backward + "prev[ious]*:" beg t) + (progn + (goto-char (match-end 0)) + (downcase + (Info-following-node-name))))) + beg) + Info-validate-allnodes))))))) (goto-char (point-min)) (while (search-forward "\n\^_" nil t) (forward-line 1) (let ((beg (point)) - thisnode next) + Info-validate-thisnode next) (forward-line 1) (if (re-search-backward regexp beg t) (save-restriction - (search-forward "\n\^_" nil 'move) - (narrow-to-region beg (point)) - (setq thisnode (downcase - (buffer-substring-no-properties - (match-beginning 1) - (progn - (goto-char (match-end 1)) - (skip-chars-backward " \t") - (point))))) + (let ((md (match-data))) + (search-forward "\n\^_" nil 'move) + (narrow-to-region beg (point)) + (set-match-data md)) + (setq Info-validate-thisnode (downcase + (buffer-substring-no-properties + (match-beginning 1) + (progn + (goto-char (match-end 1)) + (skip-chars-backward " \t") + (point))))) (end-of-line) (and (search-backward "next:" nil t) (setq next (Info-validate-node-name "invalid Next")) - (assoc next allnodes) - (if (equal (car (cdr (assoc next allnodes))) - thisnode) + (assoc next Info-validate-allnodes) + (if (equal (car (cdr (assoc next Info-validate-allnodes))) + Info-validate-thisnode) ;; allow multiple `next' pointers to one node - (let ((tem lossages)) + (let ((tem Info-validate-lossages)) (while tem (if (and (equal (car (cdr (car tem))) "should have Previous") (equal (car (car tem)) next)) - (setq lossages (delq (car tem) lossages))) + (setq Info-validate-lossages + (delq (car tem) Info-validate-lossages))) (setq tem (cdr tem)))) - (setq lossages + (setq Info-validate-lossages (cons (list next "should have Previous" - thisnode) - lossages)))) + Info-validate-thisnode) + Info-validate-lossages)))) (end-of-line) (if (re-search-backward "prev[ious]*:" nil t) (Info-validate-node-name "invalid Previous")) @@ -245,12 +319,12 @@ Check that every node pointer points to an existing node." (if (re-search-forward "\n* Menu:" nil t) (while (re-search-forward "\n\\* " nil t) (Info-validate-node-name - (concat "invalid menu item " - (buffer-substring (point) - (save-excursion - (skip-chars-forward "^:") - (point)))) - (Info-extract-menu-node-name)))) + (concat "invalid menu item " + (buffer-substring (point) + (save-excursion + (skip-chars-forward "^:") + (point)))) + (Info-extract-menu-node-name)))) (goto-char (point-min)) (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t) (goto-char (+ (match-beginning 0) 5)) @@ -263,29 +337,29 @@ Check that every node pointer points to an existing node." (point)))) (Info-extract-menu-node-name "Bad format cross-reference"))))))) (setq tags-losing (not (Info-validate-tags-table))) - (if (or lossages tags-losing) + (if (or Info-validate-lossages tags-losing) (with-output-to-temp-buffer " *problems in info file*" - (while lossages + (while Info-validate-lossages (princ "In node \"") - (princ (car (car lossages))) + (princ (car (car Info-validate-lossages))) (princ "\", ") - (let ((tem (nth 1 (car lossages)))) + (let ((tem (nth 1 (car Info-validate-lossages)))) (cond ((string-match "\n" tem) (princ (substring tem 0 (match-beginning 0))) (princ "...")) (t (princ tem)))) - (if (nth 2 (car lossages)) + (if (nth 2 (car Info-validate-lossages)) (progn (princ ": ") - (let ((tem (nth 2 (car lossages)))) + (let ((tem (nth 2 (car Info-validate-lossages)))) (cond ((string-match "\n" tem) (princ (substring tem 0 (match-beginning 0))) (princ "...")) (t (princ tem)))))) (terpri) - (setq lossages (cdr lossages))) + (setq Info-validate-lossages (cdr Info-validate-lossages))) (if tags-losing (princ "\nTags table must be recomputed\n"))) ;; Here if info file is valid. ;; If we already made a list of problems, clear it out. @@ -307,16 +381,17 @@ Check that every node pointer points to an existing node." (buffer-substring-no-properties (point) (progn - (skip-chars-forward "^,\t\n") - (skip-chars-backward " ") - (point)))))) + (skip-chars-forward "^,\t\n") + (skip-chars-backward " ") + (point)))))) (if (null name) nil (setq name (downcase name)) (or (and (> (length name) 0) (= (aref name 0) ?\()) - (assoc name allnodes) - (setq lossages - (cons (list thisnode kind name) lossages)))) + (assoc name Info-validate-allnodes) + (setq Info-validate-lossages + (cons (list Info-validate-thisnode kind name) + Info-validate-lossages)))) name) (defun Info-validate-tags-table () @@ -328,7 +403,7 @@ Check that every node pointer points to an existing node." (start (progn (search-backward "\nTag table:\n") (1- (match-end 0)))) tem) - (setq tem allnodes) + (setq tem Info-validate-allnodes) (while tem (goto-char start) (or (equal (car (car tem)) "*") @@ -343,7 +418,7 @@ Check that every node pointer points to an existing node." (setq tem (downcase (buffer-substring-no-properties (match-beginning 1) (match-end 1)))) - (setq tem (assoc tem allnodes)) + (setq tem (assoc tem Info-validate-allnodes)) (if (or (not tem) (< 1000 (progn (goto-char (match-beginning 2)) @@ -365,7 +440,7 @@ Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" (if (not noninteractive) - (error "batch-info-validate may only be used -batch.")) + (error "batch-info-validate may only be used -batch")) (let ((version-control t) (auto-save-default nil) (find-file-run-dired nil) @@ -379,7 +454,7 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" (cond ((not (file-exists-p file)) (message ">> %s does not exist!" file) (setq error 1 - command-line-args-left (cdr command-line-args-left))) + command-line-args-left (cdr command-line-args-left))) ((file-directory-p file) (setq command-line-args-left (nconc (directory-files file) (cdr command-line-args-left)))) @@ -427,4 +502,7 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" (error (message ">> Error: %s" (prin1-to-string err)))))) (kill-emacs error)))) +(provide 'informat) + +;;; arch-tag: 581c440e-5be1-4f31-b005-2d5824bbf569 ;;; informat.el ends here