![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to informat.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to informat.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 ! root 1: ;; Info support functions package for Emacs ! 2: ;; Copyright (C) 1986 Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 20: ! 21: (require 'info) ! 22: ! 23: (defun Info-tagify () ! 24: "Create or update Info-file tag table in current buffer." ! 25: (interactive) ! 26: ;; Save and restore point and restrictions. ! 27: ;; save-restrictions would not work ! 28: ;; because it records the old max relative to the end. ! 29: ;; We record it relative to the beginning. ! 30: (let ((omin (point-min)) ! 31: (omax (point-max)) ! 32: (nomax (= (point-max) (1+ (buffer-size)))) ! 33: (opoint (point))) ! 34: (unwind-protect ! 35: (progn ! 36: (widen) ! 37: (goto-char (point-min)) ! 38: (if (search-forward "\^_\nIndirect:\n" nil t) ! 39: (message "Cannot tagify split info file") ! 40: (let ((regexp "Node:[ \t]*\\([^,\n\t]\\)*[,\t\n]") ! 41: (case-fold-search t) ! 42: list) ! 43: (while (search-forward "\n\^_" nil t) ! 44: (forward-line 1) ! 45: (let ((beg (point))) ! 46: (forward-line 1) ! 47: (if (re-search-backward regexp beg t) ! 48: (setq list ! 49: (cons (list (buffer-substring ! 50: (match-beginning 1) ! 51: (match-end 1)) ! 52: beg) ! 53: list))))) ! 54: (goto-char (point-max)) ! 55: (forward-line -8) ! 56: (let ((buffer-read-only nil)) ! 57: (if (search-forward "\^_\nEnd tag table\n" nil t) ! 58: (let ((end (point))) ! 59: (search-backward "\nTag table:\n") ! 60: (beginning-of-line) ! 61: (delete-region (point) end))) ! 62: (goto-char (point-max)) ! 63: (insert "\^_\f\nTag table:\n") ! 64: (move-marker Info-tag-table-marker (point)) ! 65: (setq list (nreverse list)) ! 66: (while list ! 67: (insert "Node: " (car (car list)) ?\177) ! 68: (princ (car (cdr (car list))) (current-buffer)) ! 69: (insert ?\n) ! 70: (setq list (cdr list))) ! 71: (insert "\^_\nEnd tag table\n"))))) ! 72: (goto-char opoint) ! 73: (narrow-to-region omin (if nomax (1+ (buffer-size)) ! 74: (min omax (point-max))))))) ! 75: ! 76: (defun Info-split () ! 77: "Split an info file into an indirect file plus bounded-size subfiles. ! 78: Each subfile will be up to 50000 characters plus one node. ! 79: ! 80: To use this command, first visit a large Info file that has a tag table. ! 81: The buffer is modified into a (small) indirect info file ! 82: which should be saved in place of the original visited file. ! 83: ! 84: The subfiles are written in the same directory the original file is in, ! 85: with names generated by appending `-' and a number to the original file name. ! 86: ! 87: The indirect file still functions as an Info file, but it contains ! 88: just the tag table and a directory of subfiles." ! 89: (interactive) ! 90: (if (< (buffer-size) 70000) ! 91: (error "This is too small to be worth splitting")) ! 92: (goto-char (point-min)) ! 93: (search-forward "\^_") ! 94: (forward-char -1) ! 95: (let ((start (point)) ! 96: (chars-deleted 0) ! 97: subfiles ! 98: (subfile-number 1) ! 99: (case-fold-search t) ! 100: (filename (file-name-sans-versions buffer-file-name))) ! 101: (goto-char (point-max)) ! 102: (forward-line -8) ! 103: (setq buffer-read-only nil) ! 104: (or (search-forward "\^_\nEnd tag table\n" nil t) ! 105: (error "Tag table required; use M-x Info-tagify")) ! 106: (search-backward "\nTag table:\n") ! 107: (if (looking-at "\nTag table:\n\^_") ! 108: (error "Tag table is just a skeleton; use M-x Info-tagify")) ! 109: (beginning-of-line) ! 110: (forward-char 1) ! 111: (save-restriction ! 112: (narrow-to-region (point-min) (point)) ! 113: (goto-char (point-min)) ! 114: (while (< (1+ (point)) (point-max)) ! 115: (goto-char (min (+ (point) 50000) (point-max))) ! 116: (search-forward "\^_" nil 'move) ! 117: (setq subfiles ! 118: (cons (list (+ start chars-deleted) ! 119: (concat (file-name-nondirectory filename) ! 120: (format "-%d" subfile-number))) ! 121: subfiles)) ! 122: ;; Put a newline at end of split file, to make Unix happier. ! 123: (insert "\n") ! 124: (write-region (point-min) (point) ! 125: (concat filename (format "-%d" subfile-number))) ! 126: (delete-region (1- (point)) (point)) ! 127: ;; Back up over the final ^_. ! 128: (forward-char -1) ! 129: (setq chars-deleted (+ chars-deleted (- (point) start))) ! 130: (delete-region start (point)) ! 131: (setq subfile-number (1+ subfile-number)))) ! 132: (while subfiles ! 133: (goto-char start) ! 134: (insert (nth 1 (car subfiles)) ! 135: (format ": %d" (car (car subfiles))) ! 136: "\n") ! 137: (setq subfiles (cdr subfiles))) ! 138: (goto-char start) ! 139: (insert "\^_\nIndirect:\n") ! 140: (search-forward "\nTag Table:\n") ! 141: (insert "(Indirect)\n"))) ! 142: ! 143: (defun Info-validate () ! 144: "Check current buffer for validity as an Info file. ! 145: Check that every node pointer points to an existing node." ! 146: (interactive) ! 147: (save-excursion ! 148: (save-restriction ! 149: (widen) ! 150: (goto-char (point-min)) ! 151: (if (search-forward "\nTag table:\n(Indirect)\n" nil t) ! 152: (error "Don't yet know how to validate indirect info files: \"%s\"" ! 153: (buffer-name (current-buffer)))) ! 154: (goto-char (point-min)) ! 155: (let ((allnodes '(("*"))) ! 156: (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]") ! 157: (case-fold-search t) ! 158: (tags-losing nil) ! 159: (lossages ())) ! 160: (while (search-forward "\n\^_" nil t) ! 161: (forward-line 1) ! 162: (let ((beg (point))) ! 163: (forward-line 1) ! 164: (if (re-search-backward regexp beg t) ! 165: (let ((name (downcase ! 166: (buffer-substring ! 167: (match-beginning 1) ! 168: (progn ! 169: (goto-char (match-end 1)) ! 170: (skip-chars-backward " \t") ! 171: (point)))))) ! 172: (if (assoc name allnodes) ! 173: (setq lossages ! 174: (cons (list name "Duplicate node-name" nil) ! 175: lossages)) ! 176: (setq allnodes ! 177: (cons (list name ! 178: (progn ! 179: (end-of-line) ! 180: (and (re-search-backward ! 181: "prev[ious]*:" beg t) ! 182: (progn ! 183: (goto-char (match-end 0)) ! 184: (downcase ! 185: (Info-following-node-name))))) ! 186: beg) ! 187: allnodes))))))) ! 188: (goto-char (point-min)) ! 189: (while (search-forward "\n\^_" nil t) ! 190: (forward-line 1) ! 191: (let ((beg (point)) ! 192: thisnode next) ! 193: (forward-line 1) ! 194: (if (re-search-backward regexp beg t) ! 195: (save-restriction ! 196: (search-forward "\n\^_" nil 'move) ! 197: (narrow-to-region beg (point)) ! 198: (setq thisnode (downcase ! 199: (buffer-substring ! 200: (match-beginning 1) ! 201: (progn ! 202: (goto-char (match-end 1)) ! 203: (skip-chars-backward " \t") ! 204: (point))))) ! 205: (end-of-line) ! 206: (and (search-backward "next:" nil t) ! 207: (setq next (Info-validate-node-name "invalid Next")) ! 208: (assoc next allnodes) ! 209: (if (equal (car (cdr (assoc next allnodes))) ! 210: thisnode) ! 211: ;; allow multiple `next' pointers to one node ! 212: (let ((tem lossages)) ! 213: (while tem ! 214: (if (and (equal (car (cdr (car tem))) ! 215: "should have Previous") ! 216: (equal (car (car tem)) ! 217: next)) ! 218: (setq lossages (delq (car tem) lossages))) ! 219: (setq tem (cdr tem)))) ! 220: (setq lossages ! 221: (cons (list next ! 222: "should have Previous" ! 223: thisnode) ! 224: lossages)))) ! 225: (end-of-line) ! 226: (if (re-search-backward "prev[ious]*:" nil t) ! 227: (Info-validate-node-name "invalid Previous")) ! 228: (end-of-line) ! 229: (if (search-backward "up:" nil t) ! 230: (Info-validate-node-name "invalid Up")) ! 231: (if (re-search-forward "\n* Menu:" nil t) ! 232: (while (re-search-forward "\n\\* " nil t) ! 233: (Info-validate-node-name ! 234: (concat "invalid menu item " ! 235: (buffer-substring (point) ! 236: (save-excursion ! 237: (skip-chars-forward "^:") ! 238: (point)))) ! 239: (Info-extract-menu-node-name)))) ! 240: (goto-char (point-min)) ! 241: (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t) ! 242: (goto-char (+ (match-beginning 0) 5)) ! 243: (skip-chars-forward " \n") ! 244: (Info-validate-node-name ! 245: (concat "invalid reference " ! 246: (buffer-substring (point) ! 247: (save-excursion ! 248: (skip-chars-forward "^:") ! 249: (point)))) ! 250: (Info-extract-menu-node-name "Bad format cross-reference"))))))) ! 251: (setq tags-losing (not (Info-validate-tags-table))) ! 252: (if (or lossages tags-losing) ! 253: (with-output-to-temp-buffer " *problems in info file*" ! 254: (while lossages ! 255: (princ "In node \"") ! 256: (princ (car (car lossages))) ! 257: (princ "\", ") ! 258: (let ((tem (nth 1 (car lossages)))) ! 259: (cond ((string-match "\n" tem) ! 260: (princ (substring tem 0 (match-beginning 0))) ! 261: (princ "...")) ! 262: (t ! 263: (princ tem)))) ! 264: (if (nth 2 (car lossages)) ! 265: (progn ! 266: (princ ": ") ! 267: (let ((tem (nth 2 (car lossages)))) ! 268: (cond ((string-match "\n" tem) ! 269: (princ (substring tem 0 (match-beginning 0))) ! 270: (princ "...")) ! 271: (t ! 272: (princ tem)))))) ! 273: (terpri) ! 274: (setq lossages (cdr lossages))) ! 275: (if tags-losing (princ "\nTags table must be recomputed\n"))) ! 276: ;; Here if info file is valid. ! 277: ;; If we already made a list of problems, clear it out. ! 278: (save-excursion ! 279: (if (get-buffer " *problems in info file*") ! 280: (progn ! 281: (set-buffer " *problems in info file*") ! 282: (kill-buffer (current-buffer))))) ! 283: (message "File appears valid")))))) ! 284: ! 285: (defun Info-validate-node-name (kind &optional name) ! 286: (if name ! 287: nil ! 288: (goto-char (match-end 0)) ! 289: (skip-chars-forward " \t") ! 290: (if (= (following-char) ?\() ! 291: nil ! 292: (setq name ! 293: (buffer-substring ! 294: (point) ! 295: (progn ! 296: (skip-chars-forward "^,\t\n") ! 297: (skip-chars-backward " ") ! 298: (point)))))) ! 299: (if (null name) ! 300: nil ! 301: (setq name (downcase name)) ! 302: (or (and (> (length name) 0) (= (aref name 0) ?\()) ! 303: (assoc name allnodes) ! 304: (setq lossages ! 305: (cons (list thisnode kind name) lossages)))) ! 306: name) ! 307: ! 308: (defun Info-validate-tags-table () ! 309: (goto-char (point-min)) ! 310: (if (not (search-forward "\^_\nEnd tag table\n" nil t)) ! 311: t ! 312: (not (catch 'losing ! 313: (let* ((end (match-beginning 0)) ! 314: (start (progn (search-backward "\nTag table:\n") ! 315: (1- (match-end 0)))) ! 316: tem) ! 317: (setq tem allnodes) ! 318: (while tem ! 319: (goto-char start) ! 320: (or (equal (car (car tem)) "*") ! 321: (search-forward (concat "Node: " ! 322: (car (car tem)) ! 323: "\177") ! 324: end t) ! 325: (throw 'losing 'x)) ! 326: (setq tem (cdr tem))) ! 327: (goto-char (1+ start)) ! 328: (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$") ! 329: (setq tem (downcase (buffer-substring ! 330: (match-beginning 1) ! 331: (match-end 1)))) ! 332: (setq tem (assoc tem allnodes)) ! 333: (if (or (not tem) ! 334: (< 1000 (progn ! 335: (goto-char (match-beginning 2)) ! 336: (setq tem (- (car (cdr (cdr tem))) ! 337: (read (current-buffer)))) ! 338: (if (> tem 0) tem (- tem))))) ! 339: (throw 'losing 'y))) ! 340: (forward-line 1)) ! 341: (or (looking-at "End tag table\n") ! 342: (throw 'losing 'z)) ! 343: nil)))) ! 344: ! 345: (defun batch-info-validate () ! 346: "Runs Info-validate on the files remaining on the command line. ! 347: Must be used only with -batch, and kills emacs on completion. ! 348: Each file will be processed even if an error occurred previously. ! 349: For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" ! 350: (if (not noninteractive) ! 351: (error "batch-info-validate may only be used -batch.")) ! 352: (let ((version-control t) ! 353: (auto-save-default nil) ! 354: (find-file-run-dired nil) ! 355: (kept-old-versions 259259) ! 356: (kept-new-versions 259259)) ! 357: (let ((error 0) ! 358: file ! 359: (files ())) ! 360: (while command-line-args-left ! 361: (setq file (expand-file-name (car command-line-args-left))) ! 362: (cond ((not (file-exists-p file)) ! 363: (message ">> %s does not exist!" file) ! 364: (setq error 1 ! 365: command-line-args-left (cdr command-line-args-left))) ! 366: ((file-directory-p file) ! 367: (setq command-line-args-left (nconc (directory-files file) ! 368: (cdr command-line-args-left)))) ! 369: (t ! 370: (setq files (cons file files) ! 371: command-line-args-left (cdr command-line-args-left))))) ! 372: (while files ! 373: (setq file (car files) ! 374: files (cdr files)) ! 375: (let ((lose nil)) ! 376: (condition-case err ! 377: (progn ! 378: (if buffer-file-name (kill-buffer (current-buffer))) ! 379: (find-file file) ! 380: (buffer-flush-undo (current-buffer)) ! 381: (set-buffer-modified-p nil) ! 382: (fundamental-mode) ! 383: (let ((case-fold-search nil)) ! 384: (goto-char (point-max)) ! 385: (cond ((search-backward "\n\^_\^L\nTag table:\n" nil t) ! 386: (message "%s already tagified" file)) ! 387: ((< (point-max) 30000) ! 388: (message "%s too small to bother tagifying" file)) ! 389: (t ! 390: (message "Tagifying %s..." file) ! 391: (Info-tagify) ! 392: (message "Tagifying %s...done" file)))) ! 393: (let ((loss-name " *problems in info file*")) ! 394: (message "Checking validity of info file %s..." file) ! 395: (if (get-buffer loss-name) ! 396: (kill-buffer loss-name)) ! 397: (Info-validate) ! 398: (if (not (get-buffer loss-name)) ! 399: nil ;(message "Checking validity of info file %s... OK" file) ! 400: (message "----------------------------------------------------------------------") ! 401: (message ">> PROBLEMS IN INFO FILE %s" file) ! 402: (save-excursion ! 403: (set-buffer loss-name) ! 404: (princ (buffer-substring (point-min) (point-max)))) ! 405: (message "----------------------------------------------------------------------") ! 406: (setq error 1 lose t))) ! 407: (if (and (buffer-modified-p) ! 408: (not lose)) ! 409: (progn (message "Saving modified %s" file) ! 410: (save-buffer)))) ! 411: (error (message ">> Error: %s" (prin1-to-string err)))))) ! 412: (kill-emacs error))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.