mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
(Info-validate-allnodes): Variable renamed, defvar added.
(Info-validate-thisnode, Info-validate-lossages): Likewise. Change all references.
This commit is contained in:
parent
9d14ae763f
commit
c88cd504f0
1 changed files with 66 additions and 60 deletions
126
lisp/informat.el
126
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))
|
||||
|
|
|
|||
Loading…
Reference in a new issue