;;; informat.el --- info support functions package for Emacs
-;; Maintainer: FSF
-;; Last-Modified: 09 May 1991
+;; Copyright (C) 1986, 2002, 2003, 2004, 2005,
+;; 2006 Free Software Foundation, Inc.
-;; Copyright (C) 1986 Free Software Foundation, Inc.
+;; Maintainer: FSF
+;; Keywords: help
;; This file is part of GNU Emacs.
;; 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., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, 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 ()
- "Create or update Info-file tag table in current buffer."
+(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.
- (message "Tagifying %s ..." (file-name-nondirectory (buffer-file-name)))
+ (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
- (widen)
- (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]")
- (case-fold-search t)
- list)
- (while (search-forward "\n\^_" nil t)
- (forward-line 1)
- (let ((beg (point)))
- (forward-line 1)
- (if (re-search-backward regexp beg t)
- (setq list
- (cons (list (buffer-substring
- (match-beginning 1)
- (match-end 1))
- beg)
- list)))))
+ (progn
+ (widen)
+ (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\^_\\(\^L\\)?"
+ "\\)"
+
+ "\\("
+ "\n\\(File:[ \t]*\\([^,\n\t]*\\)[,\t\n]+[ \t\n]*\\)?"
+ "Node:[ \t]*"
+ "\\("
+ "[^,\n\t]*" ; match-string 13 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-no-properties 13))
+ (1+ (match-beginning 10)))
+ tag-list))))
+
(goto-char (point-max))
(forward-line -8)
(let ((buffer-read-only nil))
(beginning-of-line)
(delete-region (point) end)))
(goto-char (point-max))
+ (or (bolp)
+ (newline))
(insert "\^_\f\nTag table:\n")
- (move-marker Info-tag-table-marker (point))
- (setq list (nreverse list))
- (while list
- (insert "Node: " (car (car list)) ?\177)
- (princ (car (cdr (car list))) (current-buffer))
+ (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 list (cdr list)))
+ (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))))))
- (message "Tagifying %s ... done" (file-name-nondirectory (buffer-file-name))))
+ (if input-buffer-name
+ (message "Tagifying region in %s done" input-buffer-name)
+ (message
+ "Tagifying %s done" (file-name-nondirectory (buffer-file-name)))))
+
\f
;;;###autoload
(defun Info-split ()
(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)))))
+ (let ((md (match-data)))
+ (search-forward "\n\^_" nil 'move)
+ (narrow-to-region beg (point))
+ (set-match-data md))
+ (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))))
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."))
+ (error "batch-info-validate may only be used -batch"))
(let ((version-control t)
(auto-save-default nil)
(find-file-run-dired nil)
(cond ((not (file-exists-p file))
(message ">> %s does not exist!" file)
(setq error 1
- command-line-args-left (cdr command-line-args-left)))
+ 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))))
((< (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)
+
+;;; arch-tag: 581c440e-5be1-4f31-b005-2d5824bbf569
;;; informat.el ends here