diff options
Diffstat (limited to 'contrib/texinfo/emacs/informat.el')
| -rw-r--r-- | contrib/texinfo/emacs/informat.el | 429 |
1 files changed, 0 insertions, 429 deletions
diff --git a/contrib/texinfo/emacs/informat.el b/contrib/texinfo/emacs/informat.el deleted file mode 100644 index 0b195b9e620f..000000000000 --- a/contrib/texinfo/emacs/informat.el +++ /dev/null @@ -1,429 +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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, 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-no-properties - (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-no-properties - (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-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) - ;; 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-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 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-no-properties - (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))) - (if (looking-at "\^_\n") - (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-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)))) - -;;; informat.el ends here |