lisp/info-xref.el

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