Commit c88cd504 authored by Richard M. Stallman's avatar Richard M. Stallman

(Info-validate-allnodes): Variable renamed, defvar added.

(Info-validate-thisnode, Info-validate-lossages): Likewise.
Change all references.
parent 9d14ae76
......@@ -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))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment