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