[bpt/emacs.git] / lisp / informat.el

;;; informat.el --- info support functions package for Emacs

;; Copyright (C) 1986 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 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, 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 (&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.
  (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
      (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\^_"
                "\\)"

                "\\("
                "\nFile:[ \t]*\\([^,\n\t]*\\)[,\t\n]+[ \t\n]*"
                "Node:[ \t]*"
                "\\("
                "[^,\n\t]*"      ; match-string 11 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 11))
                           (match-beginning 0))
                          tag-list))))

	      (goto-char (point-max))
	      (forward-line -8)
	      (let ((buffer-read-only nil))
		(if (search-forward "\^_\nEnd tag table\n" nil t)
		    (let ((end (point)))
		      (search-backward "\nTag table:\n")
		      (beginning-of-line)
		      (delete-region (point) end)))
		(goto-char (point-max))
		(insert "\n\^_\f\nTag table:\n")
		(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 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))))))
  (if input-buffer-name
      (message "Tagifying region in %s ..." input-buffer-name)
      (message
       "Tagifying %s ..."  (file-name-nondirectory (buffer-file-name)))))

\f
;;;###autoload
(defun Info-split ()
  "Split an info file into an indirect file plus bounded-size subfiles.
Each subfile will be up to 50,000 characters plus one node.

To use this command, first visit a large Info file that has a tag
table.  The buffer is modified into a (small) indirect info file which
should be saved in place of the original visited file.

The subfiles are written in the same directory the original file is
in, with names generated by appending `-' and a number to the original
file name.  The indirect file still functions as an Info file, but it
contains just the tag table and a directory of subfiles."

  (interactive)
  (if (< (buffer-size) 70000)
      (error "This is too small to be worth splitting"))
  (goto-char (point-min))
  (search-forward "\^_")
  (forward-char -1)
  (let ((start (point))
	(chars-deleted 0)
	subfiles
	(subfile-number 1)
	(case-fold-search t)
	(filename (file-name-sans-versions buffer-file-name)))
    (goto-char (point-max))
    (forward-line -8)
    (setq buffer-read-only nil)
    (or (search-forward "\^_\nEnd tag table\n" nil t)
	(error "Tag table required; use M-x Info-tagify"))
    (search-backward "\nTag table:\n")
    (if (looking-at "\nTag table:\n\^_")
	(error "Tag table is just a skeleton; use M-x Info-tagify"))
    (beginning-of-line)
    (forward-char 1)
    (save-restriction
      (narrow-to-region (point-min) (point))
      (goto-char (point-min))
      (while (< (1+ (point)) (point-max))
	(goto-char (min (+ (point) 50000) (point-max)))
	(search-forward "\^_" nil 'move)
	(setq subfiles
	      (cons (list (+ start chars-deleted)
			  (concat (file-name-nondirectory filename)
				  (format "-%d" subfile-number)))
		    subfiles))
	;; Put a newline at end of split file, to make Unix happier.
	(insert "\n")
	(write-region (point-min) (point)
		      (concat filename (format "-%d" subfile-number)))
	(delete-region (1- (point)) (point))
	;; Back up over the final ^_.
	(forward-char -1)
	(setq chars-deleted (+ chars-deleted (- (point) start)))
	(delete-region start (point))
	(setq subfile-number (1+ subfile-number))))
    (while subfiles
      (goto-char start)
      (insert (nth 1 (car subfiles))
	      (format ": %d" (1- (car (car subfiles))))
	      "\n")
      (setq subfiles (cdr subfiles)))
    (goto-char start)
    (insert "\^_\nIndirect:\n")
    (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.
Check that every node pointer points to an existing node."
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (search-forward "\nTag table:\n(Indirect)\n" nil t)
	  (error "Don't yet know how to validate indirect info files: \"%s\""
		 (buffer-name (current-buffer))))
      (goto-char (point-min))
      (let ((Info-validate-allnodes '(("*")))
	    (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]")
	    (case-fold-search t)
	    (tags-losing nil)
	    (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 Info-validate-allnodes)
		      (setq Info-validate-lossages
			    (cons (list name "Duplicate node-name" nil)
				  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))
		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 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 Info-validate-allnodes)
		       (if (equal (car (cdr (assoc next Info-validate-allnodes)))
				  Info-validate-thisnode)
			   ;; allow multiple `next' pointers to one node
			   (let ((tem Info-validate-lossages))
			     (while tem
			       (if (and (equal (car (cdr (car tem)))
					       "should have Previous")
					(equal (car (car tem))
					       next))
				   (setq Info-validate-lossages
					 (delq (car tem) Info-validate-lossages)))
			       (setq tem (cdr tem))))
			 (setq Info-validate-lossages
			       (cons (list next
					   "should have Previous"
					   Info-validate-thisnode)
				     Info-validate-lossages))))
		  (end-of-line)
		  (if (re-search-backward "prev[ious]*:" nil t)
		      (Info-validate-node-name "invalid Previous"))
		  (end-of-line)
		  (if (search-backward "up:" nil t)
		      (Info-validate-node-name "invalid Up"))
		  (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))))
		  (goto-char (point-min))
		  (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t)
		    (goto-char (+ (match-beginning 0) 5))
		    (skip-chars-forward " \n")
		    (Info-validate-node-name
		     (concat "invalid reference "
			     (buffer-substring (point)
					       (save-excursion
						 (skip-chars-forward "^:")
						 (point))))
		     (Info-extract-menu-node-name "Bad format cross-reference")))))))
	(setq tags-losing (not (Info-validate-tags-table)))
	(if (or Info-validate-lossages tags-losing)
	    (with-output-to-temp-buffer " *problems in info file*"
	      (while Info-validate-lossages
		(princ "In node \"")
		(princ (car (car Info-validate-lossages)))
		(princ "\", ")
		(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 Info-validate-lossages))
		    (progn
		      (princ ": ")
		      (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 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.
	  (save-excursion
	    (if (get-buffer " *problems in info file*")
		(progn
		  (set-buffer " *problems in info file*")
		  (kill-buffer (current-buffer)))))
	  (message "File appears valid"))))))

(defun Info-validate-node-name (kind &optional name)
  (if name
      nil
    (goto-char (match-end 0))
    (skip-chars-forward " \t")
    (if (= (following-char) ?\()
	nil
      (setq name
	    (buffer-substring-no-properties
	     (point)
	     (progn
	       (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 Info-validate-allnodes)
	(setq Info-validate-lossages
	      (cons (list Info-validate-thisnode kind name)
		    Info-validate-lossages))))
  name)

(defun Info-validate-tags-table ()
  (goto-char (point-min))
  (if (not (search-forward "\^_\nEnd tag table\n" nil t))
      t
    (not (catch 'losing
	   (let* ((end (match-beginning 0))
		  (start (progn (search-backward "\nTag table:\n")
				(1- (match-end 0))))
		  tem)
	     (setq tem Info-validate-allnodes)
	     (while tem
	       (goto-char start)
	       (or (equal (car (car tem)) "*")
		   (search-forward (concat "Node: "
					   (car (car tem))
					   "\177")
				   end t)
		   (throw 'losing 'x))
	       (setq tem (cdr tem)))
	     (goto-char (1+ start))
	     (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$")
	       (setq tem (downcase (buffer-substring-no-properties
				     (match-beginning 1)
				     (match-end 1))))
	       (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)))
	   (if (looking-at "\^_\n")
	       (forward-line 1))
	   (or (looking-at "End tag table\n")
	       (throw 'losing 'z))
	   nil))))
\f
;;;###autoload
(defun batch-info-validate ()
  "Runs `Info-validate' on the files remaining on the command line.
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."))
  (let ((version-control t)
	(auto-save-default nil)
	(find-file-run-dired nil)
	(kept-old-versions 259259)
	(kept-new-versions 259259))
    (let ((error 0)
	  file
	  (files ()))
      (while command-line-args-left
	(setq file (expand-file-name (car command-line-args-left)))
	(cond ((not (file-exists-p file))
	       (message ">> %s does not exist!" file)
	       (setq error 1
		     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))))
	      (t
	       (setq files (cons file files)
		     command-line-args-left (cdr command-line-args-left)))))
      (while files
	(setq file (car files)
	      files (cdr files))
	(let ((lose nil))
	  (condition-case err
	      (progn
		(if buffer-file-name (kill-buffer (current-buffer)))
		(find-file file)
		(buffer-disable-undo (current-buffer))
		(set-buffer-modified-p nil)
		(fundamental-mode)
		(let ((case-fold-search nil))
		  (goto-char (point-max))
		  (cond ((search-backward "\n\^_\^L\nTag table:\n" nil t)
			 (message "%s already tagified" file))
			((< (point-max) 30000)
			 (message "%s too small to bother tagifying" file))
			(t
			 (Info-tagify))))
		(let ((loss-name " *problems in info file*"))
		  (message "Checking validity of info file %s..." file)
		  (if (get-buffer loss-name)
		      (kill-buffer loss-name))
		  (Info-validate)
		  (if (not (get-buffer loss-name))
		      nil ;(message "Checking validity of info file %s... OK" file)
		    (message "----------------------------------------------------------------------")
		    (message ">> PROBLEMS IN INFO FILE %s" file)
		    (save-excursion
		      (set-buffer loss-name)
		      (princ (buffer-substring-no-properties
			      (point-min) (point-max))))
		    (message "----------------------------------------------------------------------")
		    (setq error 1 lose t)))
		(if (and (buffer-modified-p)
			 (not lose))
		    (progn (message "Saving modified %s" file)
			   (save-buffer))))
	    (error (message ">> Error: %s" (prin1-to-string err))))))
      (kill-emacs error))))

(provide 'informat)

;;; informat.el ends here
Commit	Line	Data
1a06eabd ER	1	;;; informat.el --- info support functions package for Emacs
1a06eabd ER	2
3a801d0c ER	3	;; Copyright (C) 1986 Free Software Foundation, Inc.
3a801d0c ER	4
e5167999	5	;; Maintainer: FSF
fd7fa35a	6	;; Keywords: help
e5167999	7
745bc783 JB	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
e5167999	12	;; the Free Software Foundation; either version 2, or (at your option)
745bc783 JB	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
b578f267 EN	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
	22	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	23	;; Boston, MA 02111-1307, USA.
745bc783	24
54f1a1dd RS	25	;;; Commentary:
	26
	27	;; Nowadays, the Texinfo formatting commands always tagify a buffer
	28	;; (as does `makeinfo') since @anchor commands need tag tables.
	29
e5167999 ER	30	;;; Code:
e5167999 ER	31
745bc783 JB	32	(require 'info)
	33
	34	;;;###autoload
54f1a1dd RS	35	(defun Info-tagify (&optional input-buffer-name)
54f1a1dd RS	36	"Create or update Info file tag table in current buffer or in a region."
745bc783 JB	37	(interactive)
	38	;; Save and restore point and restrictions.
	39	;; save-restrictions would not work
	40	;; because it records the old max relative to the end.
	41	;; We record it relative to the beginning.
54f1a1dd RS	42	(if input-buffer-name
	43	(message "Tagifying region in %s ..." input-buffer-name)
	44	(message
	45	"Tagifying %s ..." (file-name-nondirectory (buffer-file-name))))
745bc783 JB	46	(let ((omin (point-min))
	47	(omax (point-max))
	48	(nomax (= (point-max) (1+ (buffer-size))))
	49	(opoint (point)))
	50	(unwind-protect
c69bfc14	51	(progn
c69bfc14 RS	52	(goto-char (point-min))
c69bfc14 RS	53	(if (search-forward "\^_\nIndirect:\n" nil t)
54f1a1dd RS	54	(message
54f1a1dd RS	55	"Cannot tagify split info file. Run this before splitting.")
c69bfc14 RS	56	(let (tag-list
	57	refillp
	58	(case-fold-search t)
	59	(regexp
	60	(concat
	61	"\\("
	62
	63
	64	"\\("
	65	"@anchor" ; match-string 2 matches @anchor
	66	"\\)"
	67	"\\(-no\\\|-yes\\)" ; match-string 3 matches -no or -yes
	68	"\\("
	69	"-refill"
	70	"\\)"
	71
	72	"\\("
	73	"{"
	74	"\\)"
	75	"\\("
	76	"[^}]+" ; match-string 6 matches arg to anchor
	77	"\\)"
	78	"\\("
	79	"}"
	80	"\\)"
	81
	82	"\\\|"
	83
	84	"\\("
	85	"\n\^_"
	86	"\\)"
	87
	88	"\\("
	89	"\nFile:[ \t]\\([^,\n\t]\\)[,\t\n]+[ \t\n]*"
	90	"Node:[ \t]*"
	91	"\\("
	92	"[^,\n\t]*" ; match-string 11 matches arg to node name
	93	"\\)"
	94	"[,\t\n]"
	95	"\\)"
	96
	97	"\\)"
	98	)))
	99	(while (re-search-forward regexp nil t)
	100	(if (string-equal "@anchor" (match-string 2))
	101	(progn
	102	;; kludge lest lose match-data
	103	(if (string-equal "-yes" (match-string 3))
	104	(setq refillp t))
	105	(setq tag-list
	106	(cons (list
	107	(concat "Ref: " (match-string 6))
	108	(match-beginning 0))
	109	tag-list))
	110	(if (eq refillp t)
	111	;; set start and end so texinfo-format-refill works
	112	(let ((texinfo-command-start (match-beginning 0))
	113	(texinfo-command-end (match-end 0)))
	114	(texinfo-format-refill))
	115	(delete-region (match-beginning 0) (match-end 0))))
	116	;; else this is a Node
	117	(setq tag-list
	118	(cons (list
	119	(concat "Node: " (match-string 11))
120	(match-beginning 0))
121	tag-list))))
122
745bc783 JB	123	(goto-char (point-max))
	124	(forward-line -8)
	125	(let ((buffer-read-only nil))
	126	(if (search-forward "\^_\nEnd tag table\n" nil t)
	127	(let ((end (point)))
	128	(search-backward "\nTag table:\n")
	129	(beginning-of-line)
	130	(delete-region (point) end)))
	131	(goto-char (point-max))
54f1a1dd	132	(insert "\n\^_\f\nTag table:\n")
9304909e RS	133	(if (eq major-mode 'info-mode)
9304909e RS	134	(move-marker Info-tag-table-marker (point)))
c69bfc14 RS	135	(setq tag-list (nreverse tag-list))
	136	(while tag-list
	137	(insert (car (car tag-list)) ?\177)
54f1a1dd	138	(princ (car (cdr (car tag-list))) (current-buffer))
745bc783	139	(insert ?\n)
c69bfc14	140	(setq tag-list (cdr tag-list)))
745bc783 JB	141	(insert "\^_\nEnd tag table\n")))))
	142	(goto-char opoint)
	143	(narrow-to-region omin (if nomax (1+ (buffer-size))
	144	(min omax (point-max))))))
54f1a1dd RS	145	(if input-buffer-name
	146	(message "Tagifying region in %s ..." input-buffer-name)
	147	(message
	148	"Tagifying %s ..." (file-name-nondirectory (buffer-file-name)))))
	149
745bc783 JB	150	\f
	151	;;;###autoload
	152	(defun Info-split ()
	153	"Split an info file into an indirect file plus bounded-size subfiles.
	154	Each subfile will be up to 50,000 characters plus one node.
	155
	156	To use this command, first visit a large Info file that has a tag
	157	table. The buffer is modified into a (small) indirect info file which
	158	should be saved in place of the original visited file.
	159
	160	The subfiles are written in the same directory the original file is
	161	in, with names generated by appending `-' and a number to the original
	162	file name. The indirect file still functions as an Info file, but it
	163	contains just the tag table and a directory of subfiles."
	164
	165	(interactive)
	166	(if (< (buffer-size) 70000)
	167	(error "This is too small to be worth splitting"))
	168	(goto-char (point-min))
	169	(search-forward "\^_")
	170	(forward-char -1)
	171	(let ((start (point))
54f1a1dd	172	(chars-deleted 0)
745bc783 JB	173	subfiles
	174	(subfile-number 1)
	175	(case-fold-search t)
	176	(filename (file-name-sans-versions buffer-file-name)))
	177	(goto-char (point-max))
	178	(forward-line -8)
	179	(setq buffer-read-only nil)
	180	(or (search-forward "\^_\nEnd tag table\n" nil t)
	181	(error "Tag table required; use M-x Info-tagify"))
	182	(search-backward "\nTag table:\n")
	183	(if (looking-at "\nTag table:\n\^_")
	184	(error "Tag table is just a skeleton; use M-x Info-tagify"))
	185	(beginning-of-line)
	186	(forward-char 1)
	187	(save-restriction
	188	(narrow-to-region (point-min) (point))
	189	(goto-char (point-min))
	190	(while (< (1+ (point)) (point-max))
	191	(goto-char (min (+ (point) 50000) (point-max)))
	192	(search-forward "\^_" nil 'move)
	193	(setq subfiles
54f1a1dd	194	(cons (list (+ start chars-deleted)
745bc783 JB	195	(concat (file-name-nondirectory filename)
	196	(format "-%d" subfile-number)))
	197	subfiles))
	198	;; Put a newline at end of split file, to make Unix happier.
	199	(insert "\n")
	200	(write-region (point-min) (point)
	201	(concat filename (format "-%d" subfile-number)))
	202	(delete-region (1- (point)) (point))
	203	;; Back up over the final ^_.
	204	(forward-char -1)
54f1a1dd	205	(setq chars-deleted (+ chars-deleted (- (point) start)))
745bc783 JB	206	(delete-region start (point))
	207	(setq subfile-number (1+ subfile-number))))
	208	(while subfiles
	209	(goto-char start)
	210	(insert (nth 1 (car subfiles))
a1a4d0bc	211	(format ": %d" (1- (car (car subfiles))))
745bc783 JB	212	"\n")
	213	(setq subfiles (cdr subfiles)))
	214	(goto-char start)
	215	(insert "\^_\nIndirect:\n")
	216	(search-forward "\nTag Table:\n")
	217	(insert "(Indirect)\n")))
	218	\f
c88cd504 RS	219	(defvar Info-validate-allnodes)
	220	(defvar Info-validate-thisnode)
	221	(defvar Info-validate-lossages)
	222
745bc783 JB	223	;;;###autoload
	224	(defun Info-validate ()
	225	"Check current buffer for validity as an Info file.
	226	Check that every node pointer points to an existing node."
	227	(interactive)
	228	(save-excursion
	229	(save-restriction
	230	(widen)
	231	(goto-char (point-min))
	232	(if (search-forward "\nTag table:\n(Indirect)\n" nil t)
	233	(error "Don't yet know how to validate indirect info files: \"%s\""
	234	(buffer-name (current-buffer))))
	235	(goto-char (point-min))
c88cd504	236	(let ((Info-validate-allnodes '(("*")))
745bc783 JB	237	(regexp "Node:[ \t]\\([^,\n\t]\\)[,\t\n]")
	238	(case-fold-search t)
	239	(tags-losing nil)
c88cd504	240	(Info-validate-lossages ()))
745bc783 JB	241	(while (search-forward "\n\^_" nil t)
	242	(forward-line 1)
	243	(let ((beg (point)))
	244	(forward-line 1)
	245	(if (re-search-backward regexp beg t)
	246	(let ((name (downcase
c88cd504 RS	247	(buffer-substring-no-properties
	248	(match-beginning 1)
	249	(progn
	250	(goto-char (match-end 1))
	251	(skip-chars-backward " \t")
	252	(point))))))
	253	(if (assoc name Info-validate-allnodes)
	254	(setq Info-validate-lossages
745bc783	255	(cons (list name "Duplicate node-name" nil)
c88cd504 RS	256	Info-validate-lossages))
	257	(setq Info-validate-allnodes
	258	(cons (list name
	259	(progn
	260	(end-of-line)
	261	(and (re-search-backward
	262	"prev[ious]*:" beg t)
	263	(progn
	264	(goto-char (match-end 0))
	265	(downcase
	266	(Info-following-node-name)))))
	267	beg)
	268	Info-validate-allnodes)))))))
745bc783 JB	269	(goto-char (point-min))
	270	(while (search-forward "\n\^_" nil t)
	271	(forward-line 1)
	272	(let ((beg (point))
c88cd504	273	Info-validate-thisnode next)
745bc783 JB	274	(forward-line 1)
	275	(if (re-search-backward regexp beg t)
	276	(save-restriction
	277	(search-forward "\n\^_" nil 'move)
	278	(narrow-to-region beg (point))
c88cd504 RS	279	(setq Info-validate-thisnode (downcase
	280	(buffer-substring-no-properties
	281	(match-beginning 1)
	282	(progn
	283	(goto-char (match-end 1))
	284	(skip-chars-backward " \t")
	285	(point)))))
745bc783 JB	286	(end-of-line)
	287	(and (search-backward "next:" nil t)
	288	(setq next (Info-validate-node-name "invalid Next"))
c88cd504 RS	289	(assoc next Info-validate-allnodes)
	290	(if (equal (car (cdr (assoc next Info-validate-allnodes)))
	291	Info-validate-thisnode)
745bc783	292	;; allow multiple `next' pointers to one node
c88cd504	293	(let ((tem Info-validate-lossages))
745bc783 JB	294	(while tem
	295	(if (and (equal (car (cdr (car tem)))
	296	"should have Previous")
	297	(equal (car (car tem))
	298	next))
c88cd504 RS	299	(setq Info-validate-lossages
c88cd504 RS	300	(delq (car tem) Info-validate-lossages)))
745bc783	301	(setq tem (cdr tem))))
c88cd504	302	(setq Info-validate-lossages
745bc783 JB	303	(cons (list next
745bc783 JB	304	"should have Previous"
c88cd504 RS	305	Info-validate-thisnode)
c88cd504 RS	306	Info-validate-lossages))))
745bc783 JB	307	(end-of-line)
	308	(if (re-search-backward "prev[ious]*:" nil t)
	309	(Info-validate-node-name "invalid Previous"))
	310	(end-of-line)
	311	(if (search-backward "up:" nil t)
	312	(Info-validate-node-name "invalid Up"))
	313	(if (re-search-forward "\n* Menu:" nil t)
	314	(while (re-search-forward "\n\\* " nil t)
	315	(Info-validate-node-name
c88cd504 RS	316	(concat "invalid menu item "
	317	(buffer-substring (point)
	318	(save-excursion
	319	(skip-chars-forward "^:")
	320	(point))))
	321	(Info-extract-menu-node-name))))
745bc783 JB	322	(goto-char (point-min))
	323	(while (re-search-forward "\\note[ \n][^:\t]*:" nil t)
	324	(goto-char (+ (match-beginning 0) 5))
	325	(skip-chars-forward " \n")
	326	(Info-validate-node-name
	327	(concat "invalid reference "
	328	(buffer-substring (point)
	329	(save-excursion
	330	(skip-chars-forward "^:")
	331	(point))))
	332	(Info-extract-menu-node-name "Bad format cross-reference")))))))
	333	(setq tags-losing (not (Info-validate-tags-table)))
c88cd504	334	(if (or Info-validate-lossages tags-losing)
745bc783	335	(with-output-to-temp-buffer " problems in info file"
c88cd504	336	(while Info-validate-lossages
745bc783	337	(princ "In node \"")
c88cd504	338	(princ (car (car Info-validate-lossages)))
745bc783	339	(princ "\", ")
c88cd504	340	(let ((tem (nth 1 (car Info-validate-lossages))))
745bc783 JB	341	(cond ((string-match "\n" tem)
	342	(princ (substring tem 0 (match-beginning 0)))
	343	(princ "..."))
	344	(t
	345	(princ tem))))
c88cd504	346	(if (nth 2 (car Info-validate-lossages))
745bc783 JB	347	(progn
745bc783 JB	348	(princ ": ")
c88cd504	349	(let ((tem (nth 2 (car Info-validate-lossages))))
745bc783 JB	350	(cond ((string-match "\n" tem)
	351	(princ (substring tem 0 (match-beginning 0)))
	352	(princ "..."))
	353	(t
	354	(princ tem))))))
	355	(terpri)
c88cd504	356	(setq Info-validate-lossages (cdr Info-validate-lossages)))
745bc783 JB	357	(if tags-losing (princ "\nTags table must be recomputed\n")))
	358	;; Here if info file is valid.
	359	;; If we already made a list of problems, clear it out.
	360	(save-excursion
	361	(if (get-buffer " problems in info file")
	362	(progn
	363	(set-buffer " problems in info file")
	364	(kill-buffer (current-buffer)))))
	365	(message "File appears valid"))))))
	366
	367	(defun Info-validate-node-name (kind &optional name)
	368	(if name
	369	nil
	370	(goto-char (match-end 0))
	371	(skip-chars-forward " \t")
	372	(if (= (following-char) ?\()
	373	nil
	374	(setq name
e64d0760	375	(buffer-substring-no-properties
745bc783 JB	376	(point)
745bc783 JB	377	(progn
c88cd504 RS	378	(skip-chars-forward "^,\t\n")
	379	(skip-chars-backward " ")
	380	(point))))))
745bc783 JB	381	(if (null name)
	382	nil
	383	(setq name (downcase name))
	384	(or (and (> (length name) 0) (= (aref name 0) ?\())
c88cd504 RS	385	(assoc name Info-validate-allnodes)
	386	(setq Info-validate-lossages
	387	(cons (list Info-validate-thisnode kind name)
	388	Info-validate-lossages))))
745bc783 JB	389	name)
	390
	391	(defun Info-validate-tags-table ()
	392	(goto-char (point-min))
	393	(if (not (search-forward "\^_\nEnd tag table\n" nil t))
	394	t
	395	(not (catch 'losing
	396	(let* ((end (match-beginning 0))
	397	(start (progn (search-backward "\nTag table:\n")
	398	(1- (match-end 0))))
	399	tem)
c88cd504	400	(setq tem Info-validate-allnodes)
745bc783 JB	401	(while tem
	402	(goto-char start)
	403	(or (equal (car (car tem)) "*")
	404	(search-forward (concat "Node: "
	405	(car (car tem))
	406	"\177")
	407	end t)
	408	(throw 'losing 'x))
	409	(setq tem (cdr tem)))
	410	(goto-char (1+ start))
	411	(while (looking-at ".Node: \\(.\\)\177\\([0-9]+\\)$")
e64d0760	412	(setq tem (downcase (buffer-substring-no-properties
745bc783 JB	413	(match-beginning 1)
745bc783 JB	414	(match-end 1))))
c88cd504	415	(setq tem (assoc tem Info-validate-allnodes))
745bc783 JB	416	(if (or (not tem)
	417	(< 1000 (progn
	418	(goto-char (match-beginning 2))
	419	(setq tem (- (car (cdr (cdr tem)))
	420	(read (current-buffer))))
	421	(if (> tem 0) tem (- tem)))))
e64d0760 RS	422	(throw 'losing 'y))
	423	(forward-line 1)))
	424	(if (looking-at "\^_\n")
	425	(forward-line 1))
745bc783 JB	426	(or (looking-at "End tag table\n")
	427	(throw 'losing 'z))
	428	nil))))
	429	\f
	430	;;;###autoload
	431	(defun batch-info-validate ()
	432	"Runs `Info-validate' on the files remaining on the command line.
	433	Must be used only with -batch, and kills Emacs on completion.
	434	Each file will be processed even if an error occurred previously.
	435	For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\""
	436	(if (not noninteractive)
	437	(error "batch-info-validate may only be used -batch."))
	438	(let ((version-control t)
	439	(auto-save-default nil)
	440	(find-file-run-dired nil)
	441	(kept-old-versions 259259)
	442	(kept-new-versions 259259))
	443	(let ((error 0)
	444	file
	445	(files ()))
	446	(while command-line-args-left
	447	(setq file (expand-file-name (car command-line-args-left)))
	448	(cond ((not (file-exists-p file))
	449	(message ">> %s does not exist!" file)
	450	(setq error 1
	451	command-line-args-left (cdr command-line-args-left)))
	452	((file-directory-p file)
	453	(setq command-line-args-left (nconc (directory-files file)
	454	(cdr command-line-args-left))))
	455	(t
	456	(setq files (cons file files)
	457	command-line-args-left (cdr command-line-args-left)))))
	458	(while files
	459	(setq file (car files)
	460	files (cdr files))
	461	(let ((lose nil))
	462	(condition-case err
	463	(progn
	464	(if buffer-file-name (kill-buffer (current-buffer)))
	465	(find-file file)
	466	(buffer-disable-undo (current-buffer))
	467	(set-buffer-modified-p nil)
	468	(fundamental-mode)
	469	(let ((case-fold-search nil))
	470	(goto-char (point-max))
	471	(cond ((search-backward "\n\^_\^L\nTag table:\n" nil t)
	472	(message "%s already tagified" file))
	473	((< (point-max) 30000)
	474	(message "%s too small to bother tagifying" file))
	475	(t
e8a57935	476	(Info-tagify))))
745bc783 JB	477	(let ((loss-name " problems in info file"))
	478	(message "Checking validity of info file %s..." file)
	479	(if (get-buffer loss-name)
	480	(kill-buffer loss-name))
	481	(Info-validate)
	482	(if (not (get-buffer loss-name))
	483	nil ;(message "Checking validity of info file %s... OK" file)
	484	(message "----------------------------------------------------------------------")
	485	(message ">> PROBLEMS IN INFO FILE %s" file)
	486	(save-excursion
	487	(set-buffer loss-name)
e64d0760 RS	488	(princ (buffer-substring-no-properties
e64d0760 RS	489	(point-min) (point-max))))
745bc783 JB	490	(message "----------------------------------------------------------------------")
	491	(setq error 1 lose t)))
	492	(if (and (buffer-modified-p)
	493	(not lose))
	494	(progn (message "Saving modified %s" file)
	495	(save-buffer))))
	496	(error (message ">> Error: %s" (prin1-to-string err))))))
	497	(kill-emacs error))))
1a06eabd	498
896546cd RS	499	(provide 'informat)
896546cd RS	500
1a06eabd	501	;;; informat.el ends here