1;;; info-xref.el --- check external references in an Info document
2
3;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
5;; Author: Kevin Ryde <user42@zip.com.au>
6;; Keywords: docs
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING.  If not, write to the
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; This file implements some simple checking of external cross references in
28;; info files, by attempting to visit the nodes specified.
29;;
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.
34;;
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.
37;;
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.
41;;
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.
46;;
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.
51;;
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'.
55;;
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.
62;;
63;; `M-x info-xref-check-all-custom' is a related command, it goes through
64;; all info document references in customizable variables, checking them
65;; like info file cross references.
66
67;;; Code:
68
69(require 'info)
70
71(defconst info-xref-results-buffer "*info-xref results*"
72  "Name of the buffer for info-xref results.")
73
74;;;###autoload
75(defun info-xref-check (filename)
76  "Check external references in FILENAME, an info document."
77  (interactive
78   (list
79    (let* ((default-filename
80             (cond ((eq major-mode 'Info-mode)
81                    Info-current-file)
82                   ((eq major-mode 'texinfo-mode)
83                    ;; look for @setfilename like makeinfo.el does
84                    (save-excursion
85                      (goto-char (point-min))
86                      (if (re-search-forward
87                           "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*"
88                           (line-beginning-position 100) t)
89                          (expand-file-name (match-string 1)))))))
90           (prompt (if default-filename
91                       (format "Info file (%s): " default-filename)
92                     "Info file: ")))
93      (read-file-name prompt nil default-filename t))))
94  (info-xref-check-list (list filename)))
95
96;;;###autoload
97(defun info-xref-check-all ()
98  "Check external references in all info documents in the usual path.
99The usual path is `Info-directory-list' and `Info-additional-directory-list'."
100  (interactive)
101  (info-xref-check-list (info-xref-all-info-files)))
102
103;; An alternative to trying to get only top-level files here would be to
104;; simply return all files, and have info-xref-check-list not follow
105;; Indirect:.  The current way seems a bit nicer though, because it gets the
106;; proper top-level filename into the error messages, and suppresses
107;; duplicate "not available" messages for all subfiles of a single document.
108
109(defun info-xref-all-info-files ()
110  "Return a list of all available info files.
111Only top-level files are returned, subfiles are excluded.
112
113Since info files don't have to have a .info suffix, all files in the
114relevant directories are considered, which might mean a lot of extraneous
115things are returned if for instance a source code directory is in the path."
116
117  (info-initialize) ;; establish Info-directory-list
118  (apply 'nconc
119         (mapcar
120          (lambda (dir)
121            (let ((result nil))
122              (dolist (name (directory-files dir t))
123                (unless (or (file-directory-p name) (info-xref-subfile-p name))
124		  (push name result)))
125              (nreverse result)))
126          (append Info-directory-list Info-additional-directory-list))))
127
128(defun info-xref-subfile-p (filename)
129  "Return t if FILENAME is an info subfile.
130If removing the last \"-<NUM>\" from the filename gives a file that exists,
131then consider FILENAME a subfile.  This is an imperfect test, we probably
132should open up the purported top file and see what subfiles it says."
133  (and (string-match "\\`\\(\\([^-]*-\\)*[^-]*\\)-[0-9]+\\(.*\\)\\'" filename)
134       (file-exists-p (concat (match-string 1 filename)
135                              (match-string 3 filename)))))
136
137
138;; Some dynamic variables are used to share information with sub-functions
139;; below.
140;;
141;; info-xref-filename-header - a heading message for the current top-level
142;;     filename, or "" when it's been printed.
143;;
144(defvar info-xref-xfile-alist)
145;;
146;; info-xref-good - count of good cross references.
147;;
148(defvar info-xref-good)
149;;
150;; info-xref-bad - count of bad cross references.
151;;
152(defvar info-xref-bad)
153;;
154;; info-xref-xfile-alist - indexed by "(foo)" with value nil or t according
155;;     to whether "(foo)" exists or not.  This is used to suppress duplicate
156;;     messages about foo not being available.  (Duplicates within one
157;;     top-level file that is.)
158;;
159(defvar info-xref-filename-heading)
160
161(defun info-xref-check-list (filename-list)
162  "Check external references in info documents in FILENAME-LIST."
163  (pop-to-buffer info-xref-results-buffer t)
164  (erase-buffer)
165  (let ((info-xref-good 0)
166        (info-xref-bad  0))
167    (dolist (info-xref-filename filename-list)
168      (let ((info-xref-filename-heading
169             (format "In file %s:\n" info-xref-filename))
170            (info-xref-xfile-alist nil))
171        (with-temp-message (format "Looking at %s" info-xref-filename)
172          (with-temp-buffer
173            (info-insert-file-contents info-xref-filename)
174            (goto-char (point-min))
175            (if (re-search-forward "\^_\nIndirect:\n" nil t)
176                (let ((dir (file-name-directory info-xref-filename)))
177                  (while (looking-at "\\(.*\\): [0-9]+\n")
178                    (let ((subfile (match-string 1)))
179                      (with-temp-buffer
180                        (info-insert-file-contents
181                         (expand-file-name subfile dir))
182                        (info-xref-check-buffer)))
183                    (forward-line)))
184              (info-xref-check-buffer))))))
185    (insert (format "done, %d good, %d bad\n" info-xref-good info-xref-bad))))
186
187(defun info-xref-check-buffer ()
188  "Check external references in the info file in the current buffer.
189This should be the raw file contents, not `Info-mode'."
190  (goto-char (point-min))
191  (while (re-search-forward
192          "\\*[Nn]ote[ \n\t]+[^:]*:[ \n\t]+\\(\\(([^)]*)\\)[^.,]+\\)[.,]"
193          nil t)
194    (let* ((file (match-string 2))
195           (node ;; Canonicalize spaces: we could use "[\t\n ]+" but
196	    ;; we try to avoid uselessly replacing " " with " ".
197	    (replace-regexp-in-string "[\t\n][\t\n ]*\\| [\t\n ]+" " "
198				      (match-string 1) t t)))
199      (if (string-equal "()" file)
200          (info-xref-output "Empty filename part: %s\n" node)
201        ;; see if the file exists, if we haven't tried it before
202        (unless (assoc file info-xref-xfile-alist)
203          (let ((found (info-xref-goto-node-p file)))
204            (push (cons file found) info-xref-xfile-alist)
205            (unless found
206              (info-xref-output "Not available to check: %s\n" file))))
207        ;; if the file exists, try the node
208        (when (cdr (assoc file info-xref-xfile-alist))
209          (if (info-xref-goto-node-p node)
210              (setq info-xref-good (1+ info-xref-good))
211            (setq info-xref-bad (1+ info-xref-bad))
212            (info-xref-output "No such node: %s\n" node)))))))
213
214(defun info-xref-output (str &rest args)
215  "Emit a `format'-ed message STR+ARGS to the info-xref output buffer."
216  (with-current-buffer info-xref-results-buffer
217    (insert info-xref-filename-heading
218            (apply 'format str args))
219    (setq info-xref-filename-heading "")
220    ;; all this info-xref can be pretty slow, display now so the user can
221    ;; see some progress
222    (sit-for 0)))
223
224;; When asking Info-goto-node to fork, *info* needs to be the current
225;; buffer, otherwise it seems to clone the current buffer but then do the
226;; goto-node in plain *info*.
227;;
228;; We only fork if *info* already exists, if it doesn't then we can create
229;; and destroy just that instead of a new name.
230;;
231;; If Info-goto-node can't find the file, then no new buffer is created.  If
232;; it finds the file but not the node, then a buffer is created.  Handle
233;; this difference by checking before killing.
234;;
235(defun info-xref-goto-node-p (node)
236  "Return t if it's possible to go to the given NODE."
237  (let ((oldbuf (current-buffer)))
238    (save-excursion
239      (save-window-excursion
240        (prog1
241            (condition-case err
242                (progn
243                  (Info-goto-node node
244                                  (when (get-buffer "*info*")
245                                    (set-buffer "*info*")
246                                    "xref - temporary"))
247                  t)
248              (error nil))
249          (unless (equal (current-buffer) oldbuf)
250            (kill-buffer (current-buffer))))))))
251
252;;;###autoload
253(defun info-xref-check-all-custom ()
254  "Check info references in all customize groups and variables.
255`custom-manual' and `info-link' entries in the `custom-links' list are checked.
256
257`custom-load' autoloads for all symbols are loaded in order to get all the
258link information.  This will be a lot of lisp packages loaded, and can take
259quite a while."
260
261  (interactive)
262  (pop-to-buffer info-xref-results-buffer t)
263  (erase-buffer)
264  (let ((info-xref-filename-heading ""))
265
266    ;; `custom-load-symbol' is not used, since it quietly ignores errors,
267    ;; but we want to show them (since they may mean incomplete checking).
268    ;;
269    ;; Just one pass through mapatoms is made.  There shouldn't be any new
270    ;; custom-loads setup by packages loaded.
271    ;;
272    (info-xref-output "Loading custom-load autoloads ...\n")
273    (require 'cus-start)
274    (require 'cus-load)
275    (let ((viper-mode nil)) ;; tell viper.el not to ask about viperizing
276      (mapatoms
277       (lambda (symbol)
278         (dolist (load (get symbol 'custom-loads))
279           (cond ((symbolp load)
280                  (condition-case cause (require load)
281                    (error
282                     (info-xref-output "Symbol `%s': cannot require '%s: %s\n"
283                                       symbol load cause))))
284                 ;; skip if previously loaded
285                 ((assoc load load-history))
286                 ((assoc (locate-library load) load-history))
287                 (t
288                  (condition-case cause (load load)
289                    (error
290                     (info-xref-output "Symbol `%s': cannot load \"%s\": %s\n"
291                                       symbol load cause)))))))))
292
293    ;; Don't bother to check whether the info file exists as opposed to just
294    ;; a missing node.  If you have the lisp then you should have the
295    ;; documentation, so missing node name will be the usual fault.
296    ;;
297    (info-xref-output "\nChecking custom-links references ...\n")
298    (let ((good 0)
299          (bad  0))
300      (mapatoms
301       (lambda (symbol)
302         (dolist (link (get symbol 'custom-links))
303           (when (memq (car link) '(custom-manual info-link))
304	     ;; skip :tag part of (custom-manual :tag "Foo" "(foo)Node")
305	     (if (eq :tag (cadr link))
306		 (setq link (cddr link)))
307	     (if (info-xref-goto-node-p (cadr link))
308                 (setq good (1+ good))
309               (setq bad (1+ bad))
310               ;; symbol-file gives nil for preloaded variables, would need
311               ;; to copy what describe-variable does to show the right place
312               (info-xref-output "Symbol `%s' (in %s): cannot goto node: %s\n"
313                                 symbol (symbol-file symbol) (cadr link)))))))
314      (info-xref-output "%d good, %d bad\n" good bad))))
315
316(provide 'info-xref)
317
318;;; arch-tag: 69d4d528-69ed-4cc2-8eb4-c666a0c1d5ac
319;;; info-xref.el ends here
320