Mercurial > emacs
comparison lisp/info-xref.el @ 112281:697cfa263439
info-xref.el Version 3.
* lisp/info-xref.el (info-xref-check, info-xref-check-all): Move
commentary details into docstrings for better visibility.
Use compilation-mode for the results buffer.
(info-xref-output, info-xref-output-error, info-xref-with-output)
(info-xref-filename, info-xref-in-progress):
New internals for this.
(info-xref-check-list, info-xref-check-buffer)
(info-xref-check-all-custom): Use those.
(info-xref-output-buffer): Rename from info-xref-results-buffer.
(info-xref-output-heading): Rename from info-xref-filename-heading.
(info-xref-good, info-xref-bad, info-xref-xfile-alist)
(info-xref-filename-heading): Move to output managing section.
(info-xref-docstrings): New command checking "Info node `(foo)Bar'"
(info-xref-lock-file-p, info-xref-with-file): New helpers for it.
(info-xref-subfile-p): Move to generic section with those two.
(info-xref-check-node): New function split from
info-xref-check-buffer, shared by info-xref-docstrings.
(info-xref-goto-node-p): Move to a checking section with that func.
(info-xref-unavail): New counter.
(info-xref-check-node): Use it.
(info-xref-with-output): Show count of unavailables at end of output.
(info-xref-all-info-files): Exclude ".*" dotfiles. Ignore broken
symlinks. Exclude .texi files. Exclude Emacs backup files.
(info-xref-check-all-custom): Fix quietening viper-mode and
gnus-registry-install -- use setq not let so as not to unbind after load.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sat, 15 Jan 2011 17:59:33 -0800 |
parents | ef719132ddfa |
children | bcf4b132f3d5 |
comparison
equal
deleted
inserted
replaced
112280:a0a140d8d84d | 112281:697cfa263439 |
---|---|
3 ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 | 3 ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 |
4 ;; Free Software Foundation, Inc. | 4 ;; Free Software Foundation, Inc. |
5 | 5 |
6 ;; Author: Kevin Ryde <user42@zip.com.au> | 6 ;; Author: Kevin Ryde <user42@zip.com.au> |
7 ;; Keywords: docs | 7 ;; Keywords: docs |
8 ;; Version: 3 | |
8 | 9 |
9 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
10 | 11 |
11 ;; GNU Emacs is free software: you can redistribute it and/or modify | 12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
12 ;; it under the terms of the GNU General Public License as published by | 13 ;; it under the terms of the GNU General Public License as published by |
21 ;; You should have received a copy of the GNU General Public License | 22 ;; You should have received a copy of the GNU General Public License |
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | 23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
23 | 24 |
24 ;;; Commentary: | 25 ;;; Commentary: |
25 | 26 |
26 ;; This file implements some simple checking of external cross references in | 27 ;; This is some simple checking of external cross references in info files, |
27 ;; info files, by attempting to visit the nodes specified. | 28 ;; docstrings and custom-links by attempting to visit the nodes specified. |
28 ;; | 29 ;; |
29 ;; "makeinfo" checks references internal to a document, but not external | 30 ;; `M-x info-xref-check' checks a single info file. See the docstring for |
30 ;; references, which makes it rather easy for mistakes to creep in or node | 31 ;; details. |
31 ;; name changes to go unnoticed. `Info-validate' doesn't check external | 32 ;; |
32 ;; references either. | 33 ;; `M-x info-xref-check-all' checks all info files in Info-directory-list. |
33 ;; | 34 ;; This is a good way to check the consistency of the whole system. |
34 ;; `M-x info-xref-check' checks one file. When invoked from an Info-mode or | 35 ;; |
35 ;; texinfo-mode buffer, the current info file is the default at the prompt. | 36 ;; `M-x info-xref-check-all-custom' loads up all defcustom variables and |
36 ;; | 37 ;; checks any info references in them. |
37 ;; `M-x info-xref-check-all' looks at everything in the normal info path. | 38 ;; |
38 ;; This might be a lot of files but it's a good way to check the consistency | 39 ;; `M-x info-xref-docstrings' checks docstring "Info node ..." hyperlinks in |
39 ;; of the whole system. | 40 ;; source files (and other files). |
40 ;; | 41 |
41 ;; Results are shown in a buffer. The format is a bit rough, but hopefully | 42 ;;; History: |
42 ;; there won't be too many problems normally, and correcting them is a | 43 |
43 ;; manual process anyway, a case of finding the right spot in the original | 44 ;; Version 3 - new M-x info-xref-docstrings, use compilation-mode |
44 ;; .texi and finding what node it ought to point to. | |
45 ;; | |
46 ;; When a target info file doesn't exist there's clearly no way to validate | |
47 ;; node references within it. A message is given for missing target files | |
48 ;; (once per source document), it could be simply that the target hasn't | |
49 ;; been installed, or it could be a mistake in the reference. | |
50 ;; | |
51 ;; Indirect info files are understood, just pass the top-level foo.info to | |
52 ;; `info-xref-check' and it traverses all sub-files. Compressed info files | |
53 ;; are accepted too, as usual for `Info-mode'. | |
54 ;; | |
55 ;; `info-xref-check-all' is rather permissive in what it considers an info | |
56 ;; file. It has to be since info files don't necessarily have a ".info" | |
57 ;; suffix (eg. this is usual for the emacs manuals). One consequence of | |
58 ;; this is that if for instance there's a source code directory in | |
59 ;; `Info-directory-list' then a lot of extraneous files might be read, which | |
60 ;; will be time consuming but should be harmless. | |
61 ;; | |
62 ;; `M-x info-xref-check-all-custom' is a related command, it goes through | |
63 ;; all info document references in customizable variables, checking them | |
64 ;; like info file cross references. | |
65 | 45 |
66 ;;; Code: | 46 ;;; Code: |
67 | 47 |
68 (require 'info) | 48 (require 'info) |
69 | 49 (eval-when-compile |
70 (defconst info-xref-results-buffer "*info-xref results*" | 50 (require 'cl)) ;; for `incf' |
51 | |
52 ;;----------------------------------------------------------------------------- | |
53 ;; vaguely generic | |
54 | |
55 (defun info-xref-lock-file-p (filename) | |
56 "Return non-nil if FILENAME is an Emacs lock file. | |
57 A lock file is \".#foo.txt\" etc per `lock-buffer'." | |
58 (string-match "\\(\\`\\|\\/\\)\\.#" filename)) | |
59 | |
60 (defun info-xref-subfile-p (filename) | |
61 "Return t if FILENAME is an info subfile. | |
62 If removing the last \"-<NUM>\" from the filename gives a file | |
63 which exists, then consider FILENAME a subfile. This is an | |
64 imperfect test, probably ought to open up the purported top file | |
65 and see what subfiles it says." | |
66 (and (string-match "\\`\\(\\([^-]*-\\)*[^-]*\\)-[0-9]+\\(.*\\)\\'" filename) | |
67 (file-exists-p (concat (match-string 1 filename) | |
68 (match-string 3 filename))))) | |
69 | |
70 (defmacro info-xref-with-file (filename &rest body) | |
71 ;; checkdoc-params: (filename body) | |
72 "Evaluate BODY in a buffer containing the contents of FILENAME. | |
73 If FILENAME is already in a buffer then that's used, otherwise a | |
74 temporary buffer. | |
75 | |
76 The current implementation uses `insert-file-contents' rather | |
77 than `find-file-noselect' so as not to be held up by queries | |
78 about local variables or possible weirdness in a major mode. | |
79 `lm-with-file' does a similar thing, but it sets | |
80 `emacs-lisp-mode' which is not wanted here." | |
81 | |
82 (declare (debug t) (indent 1)) | |
83 `(let* ((info-xref-with-file--filename ,filename) | |
84 (info-xref-with-file--body (lambda () ,@body)) | |
85 (info-xref-with-file--existing | |
86 (find-buffer-visiting info-xref-with-file--filename))) | |
87 (if info-xref-with-file--existing | |
88 (with-current-buffer info-xref-with-file--existing | |
89 (save-excursion | |
90 (funcall info-xref-with-file--body))) | |
91 (with-temp-buffer | |
92 (insert-file-contents ,filename) | |
93 (funcall info-xref-with-file--body))))) | |
94 | |
95 | |
96 ;;----------------------------------------------------------------------------- | |
97 ;; output buffer | |
98 | |
99 (defconst info-xref-output-buffer "*info-xref results*" | |
71 "Name of the buffer for info-xref results.") | 100 "Name of the buffer for info-xref results.") |
101 | |
102 (defvar info-xref-good 0 | |
103 "Count of good cross references, during info-xref processing.") | |
104 (defvar info-xref-bad 0 | |
105 "Count of bad cross references, during info-xref processing.") | |
106 (defvar info-xref-unavail 0 | |
107 "Count of unavailable cross references, during info-xref processing.") | |
108 | |
109 (defvar info-xref-output-heading "" | |
110 "A heading string, during info-xref processing. | |
111 This is shown if there's an error, but not if successful.") | |
112 | |
113 (defvar info-xref-filename nil | |
114 "The current buffer's filename, during info-xref processing. | |
115 When looking at file contents in a temp buffer there's no | |
116 `buffer-file-name', hence this variable.") | |
117 | |
118 (defvar info-xref-xfile-alist nil | |
119 "Info files found or not found, during info-xref processing. | |
120 Key is \"(foo)\" etc and value nil or t according to whether info | |
121 manual \"(foo)\" exists or not. This is used to suppress | |
122 duplicate messages about foo not being available. (Duplicates | |
123 within one top-level file that is.)") | |
124 | |
125 (defvar info-xref-in-progress nil) | |
126 (defmacro info-xref-with-output (&rest body) | |
127 "Run BODY with an info-xref output buffer. | |
128 This is meant to nest, so you can wrap it around a set of | |
129 different info-xref checks and have them write to the one output | |
130 buffer created by the outermost `info-xref-with-output', with an | |
131 overall good/bad count summary inserted at the very end." | |
132 | |
133 (declare (debug t)) | |
134 `(save-excursion | |
135 (unless info-xref-in-progress | |
136 (display-buffer (get-buffer-create info-xref-output-buffer)) | |
137 (set-buffer info-xref-output-buffer) | |
138 (setq buffer-read-only nil) | |
139 (fundamental-mode) | |
140 (erase-buffer) | |
141 (insert ";; info-xref output -*- mode: compilation -*-\n\n") | |
142 (compilation-mode) | |
143 (setq info-xref-good 0 | |
144 info-xref-bad 0 | |
145 info-xref-unavail 0 | |
146 info-xref-xfile-alist nil)) | |
147 | |
148 (let ((info-xref-in-progress t) | |
149 (info-xref-output-heading "")) | |
150 ,@body) | |
151 | |
152 (unless info-xref-in-progress | |
153 (info-xref-output "done, %d good, %d bad, %d unavailable" | |
154 info-xref-good info-xref-bad info-xref-unavail)))) | |
155 | |
156 (defun info-xref-output (fmt &rest args) | |
157 "Emit a `format'-ed message FMT+ARGS to the `info-xref-output-buffer'." | |
158 (with-current-buffer info-xref-output-buffer | |
159 (save-excursion | |
160 (goto-char (point-max)) | |
161 (let ((inhibit-read-only t)) | |
162 (insert info-xref-output-heading | |
163 (apply 'format fmt args) | |
164 "\n"))) | |
165 (setq info-xref-output-heading "") | |
166 ;; all this info-xref can be pretty slow, display now so the user sees | |
167 ;; some progress | |
168 (sit-for 0))) | |
169 (put 'info-xref-output 'byte-compile-format-like t) | |
170 | |
171 (defun info-xref-output-error (fmt &rest args) | |
172 "Emit a `format'-ed error FMT+ARGS to the `info-xref-output-buffer'. | |
173 The error is attributed to `info-xref-filename' and the current | |
174 buffer's line and column of point." | |
175 (apply 'info-xref-output | |
176 (concat "%s:%s:%s: " fmt) | |
177 info-xref-filename | |
178 (1+ (count-lines (point-min) (line-beginning-position))) | |
179 (1+ (current-column)) | |
180 args)) | |
181 (put 'info-xref-output-error 'byte-compile-format-like t) | |
182 | |
183 | |
184 ;;----------------------------------------------------------------------------- | |
185 ;; node checking | |
186 | |
187 ;; When asking Info-goto-node to fork, *info* needs to be the current | |
188 ;; buffer, otherwise it seems to clone the current buffer but then do the | |
189 ;; goto-node in plain *info*. | |
190 ;; | |
191 ;; We only fork if *info* already exists, if it doesn't then can create and | |
192 ;; destroy just that instead of a new name. | |
193 ;; | |
194 ;; If Info-goto-node can't find the file, then no new buffer is created. If | |
195 ;; it finds the file but not the node, then a buffer is created. Handle | |
196 ;; this difference by checking before killing. | |
197 ;; | |
198 (defun info-xref-goto-node-p (node) | |
199 "Return t if it's possible to go to the given NODE." | |
200 (let ((oldbuf (current-buffer))) | |
201 (save-excursion | |
202 (save-window-excursion | |
203 (prog1 | |
204 (condition-case err | |
205 (progn | |
206 (Info-goto-node node | |
207 (when (get-buffer "*info*") | |
208 (set-buffer "*info*") | |
209 "xref - temporary")) | |
210 t) | |
211 (error nil)) | |
212 (unless (equal (current-buffer) oldbuf) | |
213 (kill-buffer))))))) | |
214 | |
215 (defun info-xref-check-node (node) | |
216 | |
217 ;; Collapse spaces as per info.el and `help-make-xrefs'. | |
218 ;; Note defcustom :info-link nodes don't get this whitespace collapsing, | |
219 ;; they should be the exact node name ready to visit. | |
220 ;; `info-xref-check-all-custom' uses `info-xref-goto-node-p' and so | |
221 ;; doesn't come through here. | |
222 ;; | |
223 ;; Could use "[\t\n ]+" but try to avoid uselessly replacing " " with " ". | |
224 (setq node (replace-regexp-in-string "[\t\n][\t\n ]*\\| [\t\n ]+" " " | |
225 node t t)) | |
226 | |
227 (if (not (string-match "\\`([^)]*)" node)) | |
228 (info-xref-output-error "no `(file)' part at start of node: %s\n" node) | |
229 (let ((file (match-string 0 node))) | |
230 | |
231 (if (string-equal "()" file) | |
232 (info-xref-output-error "empty filename part: %s" node) | |
233 | |
234 ;; see if the file exists, if haven't looked before | |
235 (unless (assoc file info-xref-xfile-alist) | |
236 (let ((found (info-xref-goto-node-p file))) | |
237 (push (cons file found) info-xref-xfile-alist) | |
238 (unless found | |
239 (info-xref-output-error "not available to check: %s\n (this reported once per file)" file)))) | |
240 | |
241 ;; if the file exists, try the node | |
242 (cond ((not (cdr (assoc file info-xref-xfile-alist))) | |
243 (incf info-xref-unavail)) | |
244 ((info-xref-goto-node-p node) | |
245 (incf info-xref-good)) | |
246 (t | |
247 (incf info-xref-bad) | |
248 (info-xref-output-error "no such node: %s" node))))))) | |
249 | |
250 | |
251 ;;----------------------------------------------------------------------------- | |
72 | 252 |
73 ;;;###autoload | 253 ;;;###autoload |
74 (defun info-xref-check (filename) | 254 (defun info-xref-check (filename) |
75 "Check external references in FILENAME, an info document." | 255 "Check external references in FILENAME, an info document. |
256 Interactively from an `Info-mode' or `texinfo-mode' buffer the | |
257 current info file is the default. | |
258 | |
259 Results are shown in a `compilation-mode' buffer. The format is | |
260 a bit rough, but there shouldn't be many problems normally. The | |
261 file:line:column: is the info document, but of course normally | |
262 any correction should be made in the original .texi file. | |
263 Finding the right place in the .texi is a manual process. | |
264 | |
265 When a target info file doesn't exist there's obviously no way to | |
266 validate node references within it. A message is given for | |
267 missing target files once per source document. It could be | |
268 simply that you don't have the target installed, or it could be a | |
269 mistake in the reference. | |
270 | |
271 Indirect info files are understood, just pass the top-level | |
272 foo.info to `info-xref-check' and it traverses all sub-files. | |
273 Compressed info files are accepted too as usual for `Info-mode'. | |
274 | |
275 \"makeinfo\" checks references internal to an info document, but | |
276 not external references, which makes it rather easy for mistakes | |
277 to creep in or node name changes to go unnoticed. | |
278 `Info-validate' doesn't check external references either." | |
279 | |
76 (interactive | 280 (interactive |
77 (list | 281 (list |
78 (let* ((default-filename | 282 (let* ((default-filename |
79 (cond ((eq major-mode 'Info-mode) | 283 (cond ((eq major-mode 'Info-mode) |
80 Info-current-file) | 284 Info-current-file) |
88 (expand-file-name (match-string 1))))))) | 292 (expand-file-name (match-string 1))))))) |
89 (prompt (if default-filename | 293 (prompt (if default-filename |
90 (format "Info file (%s): " default-filename) | 294 (format "Info file (%s): " default-filename) |
91 "Info file: "))) | 295 "Info file: "))) |
92 (read-file-name prompt nil default-filename t)))) | 296 (read-file-name prompt nil default-filename t)))) |
297 | |
93 (info-xref-check-list (list filename))) | 298 (info-xref-check-list (list filename))) |
94 | 299 |
95 ;;;###autoload | 300 ;;;###autoload |
96 (defun info-xref-check-all () | 301 (defun info-xref-check-all () |
97 "Check external references in all info documents in the usual path. | 302 "Check external references in all info documents in the info path. |
98 The usual path is `Info-directory-list' and `Info-additional-directory-list'." | 303 `Info-directory-list' and `Info-additional-directory-list' are |
304 the info paths. See `info-xref-check' for how each file is | |
305 checked. | |
306 | |
307 The search for \"all\" info files is rather permissive, since | |
308 info files don't necessarily have a \".info\" extension and in | |
309 particular the Emacs manuals normally don't. If you have a | |
310 source code directory in `Info-directory-list' then a lot of | |
311 extraneous files might be read. This will be time consuming but | |
312 should be harmless." | |
313 | |
99 (interactive) | 314 (interactive) |
100 (info-xref-check-list (info-xref-all-info-files))) | 315 (info-xref-check-list (info-xref-all-info-files))) |
101 | 316 |
102 ;; An alternative to trying to get only top-level files here would be to | 317 ;; An alternative for geting only top-level files here would be to simply |
103 ;; simply return all files, and have info-xref-check-list not follow | 318 ;; return all files and have info-xref-check-list not follow "Indirect:". |
104 ;; Indirect:. The current way seems a bit nicer though, because it gets the | 319 ;; The current way seems better because it (potentially) gets the proper |
105 ;; proper top-level filename into the error messages, and suppresses | 320 ;; top-level filename into the error messages, and suppresses duplicate "not |
106 ;; duplicate "not available" messages for all subfiles of a single document. | 321 ;; available" messages for all subfiles of a single document. |
107 | 322 |
108 (defun info-xref-all-info-files () | 323 (defun info-xref-all-info-files () |
109 "Return a list of all available info files. | 324 "Return a list of all available info files. |
110 Only top-level files are returned, subfiles are excluded. | 325 Only top level files are returned, subfiles are excluded. |
111 | 326 |
112 Since info files don't have to have a .info suffix, all files in the | 327 Since info files don't have to have a .info suffix, all files in |
113 relevant directories are considered, which might mean a lot of extraneous | 328 the relevant directories are considered, which might mean a lot |
114 things are returned if for instance a source code directory is in the path." | 329 of extraneous things if for instance a source code directory is |
330 in the path." | |
115 | 331 |
116 (info-initialize) ;; establish Info-directory-list | 332 (info-initialize) ;; establish Info-directory-list |
117 (apply 'nconc | 333 (apply 'nconc |
118 (mapcar | 334 (mapcar |
119 (lambda (dir) | 335 (lambda (dir) |
120 (let ((result nil)) | 336 (let ((result nil)) |
121 (dolist (name (directory-files dir t)) | 337 (dolist (name (directory-files |
122 (unless (or (file-directory-p name) (info-xref-subfile-p name)) | 338 dir |
339 t ;; absolute filenames | |
340 "\\`[^.]")) ;; not dotfiles, nor .# lockfiles | |
341 (when (and (file-exists-p name) ;; ignore broken symlinks | |
342 (not (string-match "\\.te?xi\\'" name)) ;; not .texi | |
343 (not (backup-file-name-p name)) | |
344 (not (file-directory-p name)) | |
345 (not (info-xref-subfile-p name))) | |
123 (push name result))) | 346 (push name result))) |
124 (nreverse result))) | 347 (nreverse result))) |
125 (append Info-directory-list Info-additional-directory-list)))) | 348 (append Info-directory-list Info-additional-directory-list)))) |
126 | 349 |
127 (defun info-xref-subfile-p (filename) | |
128 "Return t if FILENAME is an info subfile. | |
129 If removing the last \"-<NUM>\" from the filename gives a file that exists, | |
130 then consider FILENAME a subfile. This is an imperfect test, we probably | |
131 should open up the purported top file and see what subfiles it says." | |
132 (and (string-match "\\`\\(\\([^-]*-\\)*[^-]*\\)-[0-9]+\\(.*\\)\\'" filename) | |
133 (file-exists-p (concat (match-string 1 filename) | |
134 (match-string 3 filename))))) | |
135 | |
136 | |
137 ;; Some dynamic variables are used to share information with sub-functions | |
138 ;; below. | |
139 ;; | |
140 ;; info-xref-filename-header - a heading message for the current top-level | |
141 ;; filename, or "" when it's been printed. | |
142 ;; | |
143 (defvar info-xref-xfile-alist) | |
144 ;; | |
145 ;; info-xref-good - count of good cross references. | |
146 ;; | |
147 (defvar info-xref-good) | |
148 ;; | |
149 ;; info-xref-bad - count of bad cross references. | |
150 ;; | |
151 (defvar info-xref-bad) | |
152 ;; | |
153 ;; info-xref-xfile-alist - indexed by "(foo)" with value nil or t according | |
154 ;; to whether "(foo)" exists or not. This is used to suppress duplicate | |
155 ;; messages about foo not being available. (Duplicates within one | |
156 ;; top-level file that is.) | |
157 ;; | |
158 (defvar info-xref-filename-heading) | |
159 | |
160 (defun info-xref-check-list (filename-list) | 350 (defun info-xref-check-list (filename-list) |
161 "Check external references in info documents in FILENAME-LIST." | 351 "Check external references in info documents in FILENAME-LIST." |
162 (pop-to-buffer info-xref-results-buffer t) | 352 (info-xref-with-output |
163 (erase-buffer) | |
164 (let ((info-xref-good 0) | |
165 (info-xref-bad 0)) | |
166 (dolist (info-xref-filename filename-list) | 353 (dolist (info-xref-filename filename-list) |
167 (let ((info-xref-filename-heading | 354 (setq info-xref-xfile-alist nil) |
168 (format "In file %s:\n" info-xref-filename)) | 355 (let ((info-xref-output-heading |
169 (info-xref-xfile-alist nil)) | 356 (format "Info file %s\n" info-xref-filename))) |
170 (with-temp-message (format "Looking at %s" info-xref-filename) | 357 (with-temp-message (format "Looking at %s" info-xref-filename) |
171 (with-temp-buffer | 358 (with-temp-buffer |
172 (info-insert-file-contents info-xref-filename) | 359 (info-insert-file-contents info-xref-filename) |
173 (goto-char (point-min)) | 360 (goto-char (point-min)) |
174 (if (re-search-forward "\^_\nIndirect:\n" nil t) | 361 (if (search-forward "\^_\nIndirect:\n" nil t) |
175 (let ((dir (file-name-directory info-xref-filename))) | 362 (let ((dir (file-name-directory info-xref-filename))) |
176 (while (looking-at "\\(.*\\): [0-9]+\n") | 363 (while (looking-at "\\(.*\\): [0-9]+\n") |
177 (let ((subfile (match-string 1))) | 364 (let ((info-xref-filename |
365 (expand-file-name (match-string 1) dir))) | |
178 (with-temp-buffer | 366 (with-temp-buffer |
179 (info-insert-file-contents | 367 (info-insert-file-contents info-xref-filename) |
180 (expand-file-name subfile dir)) | |
181 (info-xref-check-buffer))) | 368 (info-xref-check-buffer))) |
182 (forward-line))) | 369 (forward-line))) |
183 (info-xref-check-buffer)))))) | 370 (info-xref-check-buffer)))))))) |
184 (insert (format "done, %d good, %d bad\n" info-xref-good info-xref-bad)))) | |
185 | 371 |
186 (defun info-xref-check-buffer () | 372 (defun info-xref-check-buffer () |
187 "Check external references in the info file in the current buffer. | 373 "Check external references in the info file in the current buffer. |
188 This should be the raw file contents, not `Info-mode'." | 374 This should be the raw file contents, not `Info-mode'." |
189 (goto-char (point-min)) | 375 (goto-char (point-min)) |
190 (while (re-search-forward | 376 (while (re-search-forward |
191 "\\*[Nn]ote[ \n\t]+[^:]*:[ \n\t]+\\(\\(([^)]*)\\)[^.,]+\\)[.,]" | 377 "\\*[Nn]ote[ \n\t]+[^:]*:[ \n\t]+\\(\\(([^)]*)\\)[^.,]+\\)[.,]" |
192 nil t) | 378 nil t) |
193 (let* ((file (match-string 2)) | |
194 (node ;; Canonicalize spaces: we could use "[\t\n ]+" but | |
195 ;; we try to avoid uselessly replacing " " with " ". | |
196 (replace-regexp-in-string "[\t\n][\t\n ]*\\| [\t\n ]+" " " | |
197 (match-string 1) t t))) | |
198 (if (string-equal "()" file) | |
199 (info-xref-output "Empty filename part: %s\n" node) | |
200 ;; see if the file exists, if we haven't tried it before | |
201 (unless (assoc file info-xref-xfile-alist) | |
202 (let ((found (info-xref-goto-node-p file))) | |
203 (push (cons file found) info-xref-xfile-alist) | |
204 (unless found | |
205 (info-xref-output "Not available to check: %s\n" file)))) | |
206 ;; if the file exists, try the node | |
207 (when (cdr (assoc file info-xref-xfile-alist)) | |
208 (if (info-xref-goto-node-p node) | |
209 (setq info-xref-good (1+ info-xref-good)) | |
210 (setq info-xref-bad (1+ info-xref-bad)) | |
211 (info-xref-output "No such node: %s\n" node))))))) | |
212 | |
213 (defun info-xref-output (str &rest args) | |
214 "Emit a `format'-ed message STR+ARGS to the info-xref output buffer." | |
215 (with-current-buffer info-xref-results-buffer | |
216 (insert info-xref-filename-heading | |
217 (apply 'format str args)) | |
218 (setq info-xref-filename-heading "") | |
219 ;; all this info-xref can be pretty slow, display now so the user can | |
220 ;; see some progress | |
221 (sit-for 0))) | |
222 | |
223 ;; When asking Info-goto-node to fork, *info* needs to be the current | |
224 ;; buffer, otherwise it seems to clone the current buffer but then do the | |
225 ;; goto-node in plain *info*. | |
226 ;; | |
227 ;; We only fork if *info* already exists, if it doesn't then we can create | |
228 ;; and destroy just that instead of a new name. | |
229 ;; | |
230 ;; If Info-goto-node can't find the file, then no new buffer is created. If | |
231 ;; it finds the file but not the node, then a buffer is created. Handle | |
232 ;; this difference by checking before killing. | |
233 ;; | |
234 (defun info-xref-goto-node-p (node) | |
235 "Return t if it's possible to go to the given NODE." | |
236 (let ((oldbuf (current-buffer))) | |
237 (save-excursion | 379 (save-excursion |
238 (save-window-excursion | 380 (goto-char (match-beginning 1)) ;; start of nodename as error position |
239 (prog1 | 381 (info-xref-check-node (match-string 1))))) |
240 (condition-case err | 382 |
241 (progn | 383 (defvar viper-mode) ;; quieten the byte compiler |
242 (Info-goto-node node | 384 (defvar gnus-registry-install) |
243 (when (get-buffer "*info*") | |
244 (set-buffer "*info*") | |
245 "xref - temporary")) | |
246 t) | |
247 (error nil)) | |
248 (unless (equal (current-buffer) oldbuf) | |
249 (kill-buffer (current-buffer)))))))) | |
250 | 385 |
251 ;;;###autoload | 386 ;;;###autoload |
252 (defun info-xref-check-all-custom () | 387 (defun info-xref-check-all-custom () |
253 "Check info references in all customize groups and variables. | 388 "Check info references in all customize groups and variables. |
254 `custom-manual' and `info-link' entries in the `custom-links' list are checked. | 389 Info references can be in `custom-manual' or `info-link' entries |
255 | 390 of the `custom-links' for a variable. |
256 `custom-load' autoloads for all symbols are loaded in order to get all the | 391 |
257 link information. This will be a lot of lisp packages loaded, and can take | 392 Any `custom-load' autoloads in variables are loaded in order to |
258 quite a while." | 393 get full link information. This will be a lot of Lisp packages |
394 and can take a long time." | |
259 | 395 |
260 (interactive) | 396 (interactive) |
261 (pop-to-buffer info-xref-results-buffer t) | 397 (info-xref-with-output |
262 (erase-buffer) | 398 |
263 (let ((info-xref-filename-heading "")) | 399 ;; `custom-load-symbol' is not used, since it quietly ignores errors, but |
264 | 400 ;; we want to show them since they mean incomplete checking. |
265 ;; `custom-load-symbol' is not used, since it quietly ignores errors, | 401 ;; |
266 ;; but we want to show them (since they may mean incomplete checking). | 402 ;; Just one pass through mapatoms is made. There shouldn't be any new |
267 ;; | 403 ;; custom-loads setup by packages loaded. |
268 ;; Just one pass through mapatoms is made. There shouldn't be any new | 404 ;; |
269 ;; custom-loads setup by packages loaded. | 405 (info-xref-output "Loading custom-load autoloads ...") |
270 ;; | 406 (require 'cus-start) |
271 (info-xref-output "Loading custom-load autoloads ...\n") | 407 (require 'cus-load) |
272 (require 'cus-start) | 408 |
273 (require 'cus-load) | 409 ;; These are `setq' rather than `let' since a let would unbind the |
274 (let ((viper-mode nil)) ;; tell viper.el not to ask about viperizing | 410 ;; variables after viper.el/gnus-registry.el have loaded, defeating the |
275 (mapatoms | 411 ;; defvars in those files. Of course it'd be better if those files |
276 (lambda (symbol) | 412 ;; didn't make interactive queries on loading at all, to allow for |
277 (dolist (load (get symbol 'custom-loads)) | 413 ;; programmatic loading like here. |
278 (cond ((symbolp load) | 414 (unless (boundp 'viper-mode) |
279 (condition-case cause (require load) | 415 (setq viper-mode nil)) ;; avoid viper.el ask about viperizing |
280 (error | 416 (unless (boundp 'gnus-registry-install) |
281 (info-xref-output "Symbol `%s': cannot require '%s: %s\n" | 417 (setq gnus-registry-install nil)) ;; avoid gnus-registery.el querying |
282 symbol load cause)))) | 418 |
283 ;; skip if previously loaded | 419 (mapatoms |
284 ((assoc load load-history)) | 420 (lambda (symbol) |
285 ((assoc (locate-library load) load-history)) | 421 (dolist (load (get symbol 'custom-loads)) |
286 (t | 422 (cond ((symbolp load) |
287 (condition-case cause (load load) | 423 (condition-case cause (require load) |
288 (error | 424 (error |
289 (info-xref-output "Symbol `%s': cannot load \"%s\": %s\n" | 425 (info-xref-output "Symbol `%s': cannot require '%s: %s" |
290 symbol load cause))))))))) | 426 symbol load cause)))) |
291 | 427 ;; skip if previously loaded |
292 ;; Don't bother to check whether the info file exists as opposed to just | 428 ((assoc load load-history)) |
293 ;; a missing node. If you have the lisp then you should have the | 429 ((assoc (locate-library load) load-history)) |
294 ;; documentation, so missing node name will be the usual fault. | 430 (t |
295 ;; | 431 (condition-case err |
296 (info-xref-output "\nChecking custom-links references ...\n") | 432 (load load) |
297 (let ((good 0) | 433 (error |
298 (bad 0)) | 434 (info-xref-output "Symbol `%s': cannot load \"%s\": %s" |
299 (mapatoms | 435 symbol load |
300 (lambda (symbol) | 436 (error-message-string err))))))))) |
301 (dolist (link (get symbol 'custom-links)) | 437 |
302 (when (memq (car link) '(custom-manual info-link)) | 438 ;; Don't bother to check whether the info file exists as opposed to just |
303 ;; skip :tag part of (custom-manual :tag "Foo" "(foo)Node") | 439 ;; a missing node. If you have the code then you should have the |
304 (if (eq :tag (cadr link)) | 440 ;; documentation, so a wrong node name will be the usual fault. |
305 (setq link (cddr link))) | 441 ;; |
306 (if (info-xref-goto-node-p (cadr link)) | 442 (info-xref-output "\nChecking custom-links references ...") |
307 (setq good (1+ good)) | 443 (mapatoms |
308 (setq bad (1+ bad)) | 444 (lambda (symbol) |
309 ;; symbol-file gives nil for preloaded variables, would need | 445 (dolist (link (get symbol 'custom-links)) |
310 ;; to copy what describe-variable does to show the right place | 446 (when (memq (car link) '(custom-manual info-link)) |
311 (info-xref-output "Symbol `%s' (in %s): cannot goto node: %s\n" | 447 ;; skip :tag part of (custom-manual :tag "Foo" "(foo)Node") |
312 symbol (symbol-file symbol) (cadr link))))))) | 448 (if (eq :tag (cadr link)) |
313 (info-xref-output "%d good, %d bad\n" good bad)))) | 449 (setq link (cddr link))) |
450 (if (info-xref-goto-node-p (cadr link)) | |
451 (incf info-xref-good) | |
452 (incf info-xref-bad) | |
453 ;; symbol-file gives nil for preloaded variables, would need | |
454 ;; to copy what describe-variable does to show the right place | |
455 (info-xref-output "Symbol `%s' (file %s): cannot goto node: %s" | |
456 symbol | |
457 (symbol-file symbol 'defvar) | |
458 (cadr link))))))))) | |
459 | |
460 ;;;###autoload | |
461 (defun info-xref-docstrings (filename-list) | |
462 ;; checkdoc-params: (filename-list) | |
463 "Check docstring info node references in source files. | |
464 The given files are searched for docstring hyperlinks like | |
465 | |
466 Info node `(elisp)Documentation Tips' | |
467 | |
468 and those links checked by attempting to visit the target nodes | |
469 as per `info-xref-check' does. | |
470 | |
471 Interactively filenames are read as a wildcard pattern like | |
472 \"foo*.el\", with the current file as a default. Usually this | |
473 will be lisp sources, but anything with such hyperlinks can be | |
474 checked, including the Emacs .c sources (or the etc/DOC file of | |
475 all builtins). | |
476 | |
477 Because info node hyperlinks are found by a simple regexp search | |
478 in the files, the Lisp code checked doesn't have to be loaded, | |
479 and links can be in the file commentary or elsewhere too. Even | |
480 .elc files can usually be checked successfully if you don't have | |
481 the sources handy." | |
482 | |
483 (interactive | |
484 (let* ((default (and buffer-file-name | |
485 (file-relative-name buffer-file-name))) | |
486 (prompt (if default | |
487 (format "Filename with wildcards (%s): " | |
488 default) | |
489 "Filename with wildcards: ")) | |
490 (pattern (read-file-name prompt nil default)) | |
491 (filename-list (file-expand-wildcards pattern | |
492 t))) ;; absolute filenames | |
493 (eval-and-compile | |
494 (require 'cl)) ;; for `remove-if' | |
495 (setq filename-list (remove-if 'info-xref-lock-file-p filename-list)) | |
496 (unless filename-list | |
497 (error "No files: %S" pattern)) | |
498 (list filename-list))) | |
499 | |
500 (eval-and-compile | |
501 (require 'help-mode)) ;; for `help-xref-info-regexp' | |
502 | |
503 (info-xref-with-output | |
504 (dolist (info-xref-filename filename-list) | |
505 (setq info-xref-xfile-alist nil) ;; "not found"s once per file | |
506 | |
507 (info-xref-with-file info-xref-filename | |
508 (goto-char (point-min)) | |
509 (while (re-search-forward help-xref-info-regexp nil t) | |
510 (let ((node (match-string 2))) | |
511 (save-excursion | |
512 (goto-char (match-beginning 2)) ;; start of node as error position | |
513 | |
514 ;; skip nodes with "%" as probably `format' strings such as in | |
515 ;; info-look.el | |
516 (unless (string-match "%" node) | |
517 | |
518 ;; "(emacs)" is the default manual for docstring hyperlinks, | |
519 ;; per `help-make-xrefs' | |
520 (unless (string-match "\\`(" node) | |
521 (setq node (concat "(emacs)" node))) | |
522 | |
523 (info-xref-check-node node))))))))) | |
524 | |
314 | 525 |
315 (provide 'info-xref) | 526 (provide 'info-xref) |
316 | 527 |
317 ;;; info-xref.el ends here | 528 ;;; info-xref.el ends here |