| 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 |