summaryrefslogtreecommitdiff
path: root/gnu/usr.bin/texinfo/emacs/informat.el
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/usr.bin/texinfo/emacs/informat.el')
-rw-r--r--gnu/usr.bin/texinfo/emacs/informat.el425
1 files changed, 0 insertions, 425 deletions
diff --git a/gnu/usr.bin/texinfo/emacs/informat.el b/gnu/usr.bin/texinfo/emacs/informat.el
deleted file mode 100644
index 2d923a1570d..00000000000
--- a/gnu/usr.bin/texinfo/emacs/informat.el
+++ /dev/null
@@ -1,425 +0,0 @@
-;;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(require 'info)
-
-;;;###autoload
-(defun Info-tagify ()
- "Create or update Info-file tag table in current buffer."
- (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)))
- (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)
- ;; 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
- (match-beginning 1)
- (match-end 1))
- beg)
- 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 "\^_\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))
- (insert ?\n)
- (setq list (cdr 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))))
-
-;;;###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")))
-
-;;;###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 ((allnodes '(("*")))
- (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]")
- (case-fold-search t)
- (tags-losing nil)
- (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
- (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)))))))
- (goto-char (point-min))
- (while (search-forward "\n\^_" nil t)
- (forward-line 1)
- (let ((beg (point))
- 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)))))
- (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)
- ;; allow multiple `next' pointers to one node
- (let ((tem 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 tem (cdr tem))))
- (setq lossages
- (cons (list next
- "should have Previous"
- thisnode)
- 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 lossages tags-losing)
- (with-output-to-temp-buffer " *problems in info file*"
- (while lossages
- (princ "In node \"")
- (princ (car (car lossages)))
- (princ "\", ")
- (let ((tem (nth 1 (car lossages))))
- (cond ((string-match "\n" tem)
- (princ (substring tem 0 (match-beginning 0)))
- (princ "..."))
- (t
- (princ tem))))
- (if (nth 2 (car lossages))
- (progn
- (princ ": ")
- (let ((tem (nth 2 (car lossages))))
- (cond ((string-match "\n" tem)
- (princ (substring tem 0 (match-beginning 0)))
- (princ "..."))
- (t
- (princ tem))))))
- (terpri)
- (setq lossages (cdr 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
- (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 allnodes)
- (setq lossages
- (cons (list thisnode kind name) 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 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
- (match-beginning 1)
- (match-end 1))))
- (setq tem (assoc tem 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))
- (or (looking-at "End tag table\n")
- (throw 'losing 'z))
- nil))))
-
-;;;###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 (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))))
-
-;;; informat.el ends here