(diff-default-read-only): Change default.
[emacs.git] / lisp / info-xref.el
blob91c78e2a5c5e9bd536fd937c46edf10fd2713ed0
1 ;;; info-xref.el --- check external references in an Info document.
3 ;; Copyright 2003 Free Software Foundation, Inc
4 ;;
5 ;; Author: Kevin Ryde <user42@zip.com.au>
6 ;; Keywords: docs
7 ;;
8 ;; info-xref.el is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by the
10 ;; Free Software Foundation; either version 2, or (at your option) any later
11 ;; version.
13 ;; info-xref.el is distributed in the hope that it will be useful, but
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
16 ;; Public License for more details.
18 ;; You can get a copy of the GNU General Public License online at
19 ;; http://www.gnu.org/licenses/gpl.txt, or you should have one in the file
20 ;; COPYING which comes with GNU Emacs and other GNU programs. Failing that,
21 ;; write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
25 ;;; Commentary:
27 ;; This file implements some simple checking of external cross references in
28 ;; info files, by attempting to visit the nodes specified.
30 ;; "makeinfo" checks references internal to a document, but not external
31 ;; references, which makes it rather easy for mistakes to creep in or node
32 ;; name changes to go unnoticed. `Info-validate' doesn't check external
33 ;; references either.
35 ;; `M-x info-xref-check' checks one file. When invoked from an Info-mode or
36 ;; texinfo-mode buffer, the current info file is the default at the prompt.
38 ;; `M-x info-xref-check-all' looks at everything in the normal info path.
39 ;; This might be a lot of files but it's a good way to check the consistency
40 ;; of the whole system.
42 ;; Results are shown in a buffer. The format is a bit rough, but hopefully
43 ;; there won't be too many problems normally, and correcting them is a
44 ;; manual process anyway, a case of finding the right spot in the original
45 ;; .texi and finding what node it ought to point to.
47 ;; When a target info file doesn't exist there's clearly no way to validate
48 ;; node references within it. A message is given for missing target files
49 ;; (once per source document), it could be simply that the target hasn't
50 ;; been installed, or it could be a mistake in the reference.
52 ;; Indirect info files are understood, just pass the top-level foo.info to
53 ;; `info-xref-check' and it traverses all sub-files. Compressed info files
54 ;; are accepted too, as usual for `Info-mode'.
56 ;; `info-xref-check-all' is rather permissive in what it considers an info
57 ;; file. It has to be since info files don't necessarily have a ".info"
58 ;; suffix (eg. this is usual for the emacs manuals). One consequence of
59 ;; this is that if for instance there's a source code directory in
60 ;; `Info-directory-list' then a lot of extraneous files might be read, which
61 ;; will be time consuming but should be harmless.
64 ;;; Install:
66 ;; Put info-xref.el somewhere in your `load-path', and in your .emacs put
68 ;; (autoload 'info-xref-check "info-xref" nil t)
69 ;; (autoload 'info-xref-check-all "info-xref" nil t)
71 ;; then
73 ;; M-x info-xref-check
75 ;; and enter an info file name.
78 ;;; Emacsen:
80 ;; Designed for use with GNU Emacs 21.
83 ;;; History:
85 ;; Version 1 - the first version.
88 ;;; Code:
90 (require 'info)
92 (defconst info-xref-results-buffer "*info-xref results*"
93 "Name of the buffer for info-xref results.")
95 ;;;###autoload
96 (defun info-xref-check (filename)
97 "Check external references in FILENAME, an info document."
98 (interactive
99 (list
100 (let* ((default-filename
101 (cond ((eq major-mode 'Info-mode)
102 Info-current-file)
103 ((eq major-mode 'texinfo-mode)
104 ;; look for @setfilename like makeinfo.el does
105 (save-excursion
106 (goto-char (point-min))
107 (if (re-search-forward
108 "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*"
109 (line-beginning-position 100) t)
110 (expand-file-name (match-string 1)))))))
111 (prompt (if default-filename
112 (format "Info file (%s): " default-filename)
113 "Info file: ")))
114 (read-file-name prompt nil default-filename t))))
115 (info-xref-check-list (list filename)))
117 ;;;###autoload
118 (defun info-xref-check-all ()
119 "Check external references in all info documents in the usual path.
120 The usual path is `Info-directory-list' and `Info-additional-directory-list'."
121 (interactive)
122 (info-xref-check-list (info-xref-all-info-files)))
124 ;; An alternative to trying to get only top-level files here would be to
125 ;; simply return all files, and have info-xref-check-list not follow
126 ;; Indirect:. The current way seems a bit nicer though, because it gets the
127 ;; proper top-level filename into the error messages, and suppresses
128 ;; duplicate "not available" messages for all subfiles of a single document.
130 (defun info-xref-all-info-files ()
131 "Return a list of all available info files.
132 Only top-level files are returned, subfiles are excluded.
134 Since info files don't have to have a .info suffix, all files in the
135 relevant directories are considered, which might mean a lot of extraneous
136 things are returned if for instance a source code directory is in the path."
138 (info-initialize) ;; establish Info-directory-list
139 (apply 'nconc
140 (mapcar
141 (lambda (dir)
142 (let ((result nil))
143 (dolist (name (directory-files dir t))
144 (unless (or (file-directory-p name) (info-xref-subfile-p name))
145 (push name result)))
146 (nreverse result)))
147 (append Info-directory-list Info-additional-directory-list))))
149 (defun info-xref-subfile-p (filename)
150 "Return t if FILENAME is an info subfile.
151 If removing the last \"-<NUM>\" from the filename gives a file that exists,
152 then consider FILENAME a subfile. This is an imperfect test, we probably
153 should open up the purported top file and see what subfiles it says."
154 (and (string-match "\\`\\(\\([^-]*-\\)*[^-]*\\)-[0-9]+\\(.*\\)\\'" filename)
155 (file-exists-p (concat (match-string 1 filename)
156 (match-string 3 filename)))))
159 ;; Some dynamic variables are used to share information with sub-functions
160 ;; below.
162 ;; info-xref-filename - current top-level filename, eg. /usr/info/foo.info.gz
164 ;; info-xref-filename-header - a heading message for the current top-level
165 ;; filename, or "" when it's been printed.
167 ;; info-xref-good - count of good cross references.
169 ;; info-xref-bad - count of bad cross references.
171 ;; info-xref-xfile-alist - indexed by "(foo)" with value nil or t according
172 ;; to whether "(foo)" exists or not. This is used to suppress duplicate
173 ;; messages about foo not being available. (Duplicates within one
174 ;; top-level file that is.)
176 (defun info-xref-check-list (filename-list)
177 "Check external references in info documents in FILENAME-LIST."
178 (pop-to-buffer info-xref-results-buffer t)
179 (erase-buffer)
180 (let ((info-xref-good 0)
181 (info-xref-bad 0))
182 (dolist (info-xref-filename filename-list)
183 (let ((info-xref-filename-heading
184 (format "In file %s:\n" info-xref-filename))
185 (info-xref-xfile-alist nil))
186 (with-temp-message (format "Looking at %s" info-xref-filename)
187 (with-temp-buffer
188 (info-insert-file-contents info-xref-filename)
189 (goto-char (point-min))
190 (if (re-search-forward "\^_\nIndirect:\n" nil t)
191 (let ((dir (file-name-directory info-xref-filename)))
192 (while (looking-at "\\(.*\\): [0-9]+\n")
193 (let ((subfile (match-string 1)))
194 (with-temp-buffer
195 (info-insert-file-contents
196 (expand-file-name subfile dir))
197 (info-xref-check-buffer)))
198 (forward-line)))
199 (info-xref-check-buffer))))))
200 (insert (format "done, %d good, %d bad\n" info-xref-good info-xref-bad))))
202 (defun info-xref-check-buffer ()
203 "Check external references in the info file in the current buffer.
204 This should be the raw file contents, not `Info-mode'."
205 (goto-char (point-min))
206 (while (re-search-forward
207 "\\*[Nn]ote[ \n\t]+[^:]*:[ \n\t]+\\(\\(([^)]+)\\)[^.,]+\\)[.,]"
208 nil t)
209 (let* ((file (match-string 2))
210 (node ;; Canonicalize spaces: we could use "[\t\n ]+" but
211 ;; we try to avoid uselessly replacing " " with " ".
212 (replace-regexp-in-string "[\t\n][\t\n ]*\\| [\t\n ]+" " "
213 (match-string 1) t t)))
214 ;; see if the file exists, if we haven't tried it before
215 (unless (assoc file info-xref-xfile-alist)
216 (let ((found (info-xref-goto-node-p file)))
217 (push (cons file found) info-xref-xfile-alist)
218 (unless found
219 (info-xref-output (format "Not available to check: %s\n" file)))))
220 ;; if the file exists, try the node, if we haven't before
221 (when (cdr (assoc file info-xref-xfile-alist))
222 (unless (assoc node info-xref-xfile-alist)
223 (if (info-xref-goto-node-p node)
224 (setq info-xref-good (1+ info-xref-good))
225 (setq info-xref-bad (1+ info-xref-bad))
226 (info-xref-output (format "No such node: %s\n" node))))))))
228 (defun info-xref-output (str)
229 "Emit STR as an info-xref result message."
230 (with-current-buffer info-xref-results-buffer
231 (insert info-xref-filename-heading str)
232 (setq info-xref-filename-heading "")))
234 ;; When asking Info-goto-node to fork, *info* needs to be the current
235 ;; buffer, otherwise it seems to clone the current buffer but then do the
236 ;; goto-node in plain *info*.
238 ;; We only fork if *info* already exists, if it doesn't then we can create
239 ;; and destroy just that instead of a new name.
241 ;; If Info-goto-node can't find the file, then no new buffer is created. If
242 ;; it finds the file but not the node, then a buffer is created. Handle
243 ;; this difference by checking before killing.
245 (defun info-xref-goto-node-p (node)
246 "Return t if it's possible to go to the given NODE."
247 (let ((oldbuf (current-buffer)))
248 (save-excursion
249 (save-window-excursion
250 (prog1
251 (condition-case err
252 (progn
253 (Info-goto-node node
254 (when (get-buffer "*info*")
255 (set-buffer "*info*")
256 "xref - temporary"))
258 (error nil))
259 (unless (equal (current-buffer) oldbuf)
260 (kill-buffer (current-buffer))))))))
262 (provide 'info-xref)
264 ;;; arch-tag: 69d4d528-69ed-4cc2-8eb4-c666a0c1d5ac
265 ;;; info-xref.el ends here