diff options
| -rw-r--r-- | lisp/informat.el | 126 |
1 files changed, 66 insertions, 60 deletions
diff --git a/lisp/informat.el b/lisp/informat.el index ead8bb5d37c..36f0c560675 100644 --- a/lisp/informat.el +++ b/lisp/informat.el @@ -153,6 +153,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 +170,77 @@ 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))))) + (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 +250,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 +268,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 +312,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 +334,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 +349,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)) |