X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/745bc783eb8bd84b07a7d512660947ec214e71eb..a988c1c2396bd51bed71af9cb64444ba787c10f1:/lisp/informat.el diff --git a/lisp/informat.el b/lisp/informat.el index 1f91cb5b8b..18a459ba0f 100644 --- a/lisp/informat.el +++ b/lisp/informat.el @@ -1,11 +1,16 @@ -;; Info support functions package for Emacs -;; Copyright (C) 1986 Free Software Foundation, Inc. +;;; informat.el --- info support functions package for Emacs + +;; Copyright (C) 1986, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007 Free Software Foundation, Inc. + +;; Maintainer: FSF +;; Keywords: help ;; This file is part of GNU Emacs. ;; GNU Emacs 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; either version 1, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -14,44 +19,109 @@ ;; GNU General Public License for more details. ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; 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) - (forward-line 1) - (let ((beg (point))) - (forward-line 1) - (if (re-search-backward regexp beg t) - (setq list - (cons (list (buffer-substring - (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)) @@ -61,19 +131,26 @@ (beginning-of-line) (delete-region (point) end))) (goto-char (point-max)) + (or (bolp) + (newline)) (insert "\^_\f\nTag table:\n") - (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)) + (if (eq major-mode 'info-mode) + (move-marker Info-tag-table-marker (point))) + (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 () @@ -135,7 +212,7 @@ contains just the tag table and a directory of subfiles." (while subfiles (goto-char start) (insert (nth 1 (car subfiles)) - (format ": %d" (car (car subfiles))) + (format ": %d" (1- (car (car subfiles)))) "\n") (setq subfiles (cdr subfiles))) (goto-char start) @@ -143,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. @@ -156,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 - (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 - (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")) @@ -235,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)) @@ -253,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. @@ -294,19 +378,20 @@ Check that every node pointer points to an existing node." (if (= (following-char) ?\() nil (setq name - (buffer-substring + (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 () @@ -318,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)) "*") @@ -330,18 +415,20 @@ Check that every node pointer points to an existing node." (setq tem (cdr tem))) (goto-char (1+ start)) (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$") - (setq tem (downcase (buffer-substring + (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)) (setq tem (- (car (cdr (cdr tem))) (read (current-buffer)))) (if (> tem 0) tem (- tem))))) - (throw 'losing 'y))) - (forward-line 1)) + (throw 'losing 'y)) + (forward-line 1))) + (if (looking-at "\^_\n") + (forward-line 1)) (or (looking-at "End tag table\n") (throw 'losing 'z)) nil)))) @@ -353,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) @@ -367,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)))) @@ -392,7 +479,7 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" ((< (point-max) 30000) (message "%s too small to bother tagifying" file)) (t - (Info-tagify file)))) + (Info-tagify)))) (let ((loss-name " *problems in info file*")) (message "Checking validity of info file %s..." file) (if (get-buffer loss-name) @@ -404,7 +491,8 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" (message ">> PROBLEMS IN INFO FILE %s" file) (save-excursion (set-buffer loss-name) - (princ (buffer-substring (point-min) (point-max)))) + (princ (buffer-substring-no-properties + (point-min) (point-max)))) (message "----------------------------------------------------------------------") (setq error 1 lose t))) (if (and (buffer-modified-p) @@ -413,3 +501,8 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" (save-buffer)))) (error (message ">> Error: %s" (prin1-to-string err)))))) (kill-emacs error)))) + +(provide 'informat) + +;;; arch-tag: 581c440e-5be1-4f31-b005-2d5824bbf569 +;;; informat.el ends here