lisp/info-xref.el

   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 3, 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.
  99 The 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.
 111 Only top-level files are returned, subfiles are excluded.
 112
 113 Since info files don't have to have a .info suffix, all files in the
 114 relevant directories are considered, which might mean a lot of extraneous
 115 things 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.
 130 If removing the last \"-<NUM>\" from the filename gives a file that exists,
 131 then consider FILENAME a subfile.  This is an imperfect test, we probably
 132 should 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.
 189 This 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
 258 link information.  This will be a lot of lisp packages loaded, and can take
 259 quite 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