lisp/info-xref.el

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