;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Code:
(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]")
+ (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)
+ ;; 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
+ (cons (list (buffer-substring-no-properties
(match-beginning 1)
(match-end 1))
beg)
(delete-region (point) end)))
(goto-char (point-max))
(insert "\^_\f\nTag table:\n")
- (move-marker Info-tag-table-marker (point))
+ (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)
(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)
(search-forward "\nTag Table:\n")
(insert "(Indirect)\n")))
\f
+(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.
(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)))))
+ (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"))
(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))
(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.
(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 ()
(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)) "*")
(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))))
((< (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)
(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)
(error (message ">> Error: %s" (prin1-to-string err))))))
(kill-emacs error))))
+(provide 'informat)
+
;;; informat.el ends here