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