lisp/info-xref.el

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