shadow.el 10.1 KB
Newer Older
1
;;; shadow.el --- locate Emacs Lisp file shadowings
Karl Heuer's avatar
Karl Heuer committed
2

3 4
;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;;   2009  Free Software Foundation, Inc.
Karl Heuer's avatar
Karl Heuer committed
5 6 7 8 9 10 11

;; Author: Terry Jones <terry@santafe.edu>
;; Keywords: lisp
;; Created: 15 December 1995

;; This file is part of GNU Emacs.

12
;; GNU Emacs is free software: you can redistribute it and/or modify
Karl Heuer's avatar
Karl Heuer committed
13
;; it under the terms of the GNU General Public License as published by
14 15
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Karl Heuer's avatar
Karl Heuer committed
16 17 18 19 20 21 22

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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/>.
Karl Heuer's avatar
Karl Heuer committed
24 25

;;; Commentary:
Erik Naggum's avatar
Erik Naggum committed
26

Karl Heuer's avatar
Karl Heuer committed
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
;; The functions in this file detect (`find-emacs-lisp-shadows')
;; and display (`list-load-path-shadows') potential load-path
;; problems that arise when Emacs Lisp files "shadow" each other.
;;
;; For example, a file XXX.el early in one's load-path will shadow
;; a file with the same name in a later load-path directory.  When
;; this is unintentional, it may result in problems that could have
;; been easily avoided.  This occurs often (to me) when installing a
;; new version of emacs and something in the site-lisp directory
;; has been updated and added to the emacs distribution.  The old
;; version, now outdated, shadows the new one. This is obviously
;; undesirable.
;;
;; The `list-load-path-shadows' function was run when you installed
;; this version of emacs. To run it by hand in emacs:
;;
;;     M-x list-load-path-shadows
;;
;; or run it non-interactively via:
;;
47
;;     emacs -batch -f list-load-path-shadows
Karl Heuer's avatar
Karl Heuer committed
48 49 50 51 52 53
;;
;; Thanks to Francesco Potorti` <pot@cnuce.cnr.it> for suggestions,
;; rewritings & speedups.

;;; Code:

54
(defgroup lisp-shadow nil
Stephen Eglen's avatar
Stephen Eglen committed
55 56 57 58 59
  "Locate Emacs Lisp file shadowings."
  :prefix "shadows-"
  :group 'lisp)

(defcustom shadows-compare-text-p nil
60
  "If non-nil, then shadowing files are reported only if their text differs.
Stephen Eglen's avatar
Stephen Eglen committed
61 62
This is slower, but filters out some innocuous shadowing."
  :type 'boolean
63
  :group 'lisp-shadow)
Karl Heuer's avatar
Karl Heuer committed
64

Karl Heuer's avatar
Karl Heuer committed
65 66 67 68 69 70 71 72 73 74
(defun find-emacs-lisp-shadows (&optional path)
  "Return a list of Emacs Lisp files that create shadows.
This function does the work for `list-load-path-shadows'.

We traverse PATH looking for shadows, and return a \(possibly empty\)
even-length list of files.  A file in this list at position 2i shadows
the file in position 2i+1.  Emacs Lisp file suffixes \(.el and .elc\)
are stripped from the file names in the list.

See the documentation for `list-load-path-shadows' for further information."
75

Karl Heuer's avatar
Karl Heuer committed
76 77 78 79 80 81 82 83 84 85 86
  (or path (setq path load-path))

  (let (true-names			; List of dirs considered.
	shadows				; List of shadowings, to be returned.
	files				; File names ever seen, with dirs.
	dir				; The dir being currently scanned.
	curr-files			; This dir's Emacs Lisp files.
	orig-dir			; Where the file was first seen.
	files-seen-this-dir		; Files seen so far in this dir.
	file)				; The current file.

87

Karl Heuer's avatar
Karl Heuer committed
88 89
    (while path

Karl Heuer's avatar
Karl Heuer committed
90
      (setq dir (directory-file-name (file-truename (or (car path) "."))))
Karl Heuer's avatar
Karl Heuer committed
91 92
      (if (member dir true-names)
	  ;; We have already considered this PATH redundant directory.
93
	  ;; Show the redundancy if we are interactive, unless the PATH
Karl Heuer's avatar
Karl Heuer committed
94 95 96 97 98 99
	  ;; dir is nil or "." (these redundant directories are just a
	  ;; result of the current working directory, and are therefore
	  ;; not always redundant).
	  (or noninteractive
	      (and (car path)
		   (not (string= (car path) "."))
100
		   (message "Ignoring redundant directory %s" (car path))))
Karl Heuer's avatar
Karl Heuer committed
101

Karl Heuer's avatar
Karl Heuer committed
102
	(setq true-names (append true-names (list dir)))
Karl Heuer's avatar
Karl Heuer committed
103
	(setq dir (directory-file-name (or (car path) ".")))
Karl Heuer's avatar
Karl Heuer committed
104
	(setq curr-files (if (file-accessible-directory-p dir)
Andreas Schwab's avatar
Andreas Schwab committed
105
			     (directory-files dir nil ".\\.elc?\\(\\.gz\\)?$" t)))
Karl Heuer's avatar
Karl Heuer committed
106 107
	(and curr-files
	     (not noninteractive)
108
	     (message "Checking %d files in %s..." (length curr-files) dir))
Karl Heuer's avatar
Karl Heuer committed
109

Karl Heuer's avatar
Karl Heuer committed
110 111 112 113 114
	(setq files-seen-this-dir nil)

	(while curr-files

	  (setq file (car curr-files))
Andreas Schwab's avatar
Andreas Schwab committed
115 116
	  (if (string-match "\\.gz$" file)
	      (setq file (substring file 0 -3)))
Karl Heuer's avatar
Karl Heuer committed
117 118 119
	  (setq file (substring
		      file 0 (if (string= (substring file -1) "c") -4 -3)))

120 121 122 123
	  ;; FILE now contains the current file name, with no suffix.
	  (unless (or (member file files-seen-this-dir)
		      ;; Ignore these files.
		      (member file '("subdirs")))
Karl Heuer's avatar
Karl Heuer committed
124 125 126 127
	    ;; File has not been seen yet in this directory.
	    ;; This test prevents us declaring that XXX.el shadows
	    ;; XXX.elc (or vice-versa) when they are in the same directory.
	    (setq files-seen-this-dir (cons file files-seen-this-dir))
128

Karl Heuer's avatar
Karl Heuer committed
129 130
	    (if (setq orig-dir (assoc file files))
		;; This file was seen before, we have a shadowing.
Karl Heuer's avatar
Karl Heuer committed
131 132 133 134 135 136 137 138 139
		;; Report it unless the files are identical.
		(let ((base1 (concat (cdr orig-dir) "/" file))
		      (base2 (concat dir "/" file)))
		  (if (not (and shadows-compare-text-p
				(shadow-same-file-or-nonexistent
				 (concat base1 ".el") (concat base2 ".el"))
				;; This is a bit strict, but safe.
				(shadow-same-file-or-nonexistent
				 (concat base1 ".elc") (concat base2 ".elc"))))
Richard M. Stallman's avatar
Richard M. Stallman committed
140 141
		      (setq shadows
			    (append shadows (list base1 base2)))))
Karl Heuer's avatar
Karl Heuer committed
142 143 144 145 146 147 148 149 150 151

	      ;; Not seen before, add it to the list of seen files.
	      (setq files (cons (cons file dir) files))))

	  (setq curr-files (cdr curr-files))))
	(setq path (cdr path)))

    ;; Return the list of shadowings.
    shadows))

Karl Heuer's avatar
Karl Heuer committed
152 153 154 155 156 157 158 159 160 161 162 163
;; Return true if neither file exists, or if both exist and have identical
;; contents.
(defun shadow-same-file-or-nonexistent (f1 f2)
  (let ((exists1 (file-exists-p f1))
	(exists2 (file-exists-p f2)))
    (or (and (not exists1) (not exists2))
	(and exists1 exists2
	     (or (equal (file-truename f1) (file-truename f2))
		 ;; As a quick test, avoiding spawning a process, compare file
		 ;; sizes.
		 (and (= (nth 7 (file-attributes f1))
			 (nth 7 (file-attributes f2)))
164
		      (eq 0 (call-process "cmp" nil nil nil "-s" f1 f2))))))))
Karl Heuer's avatar
Karl Heuer committed
165 166

;;;###autoload
167
(defun list-load-path-shadows (&optional stringp)
168
  "Display a list of Emacs Lisp files that shadow other files.
Karl Heuer's avatar
Karl Heuer committed
169

170 171 172 173
If STRINGP is non-nil, returns any shadows as a string.
Otherwise, if interactive shows any shadows in a `*Shadows*' buffer;
else prints messages listing any shadows.

174 175
This function lists potential load path problems.  Directories in
the `load-path' variable are searched, in order, for Emacs Lisp
176 177
files.  When a previously encountered file name is found again, a
message is displayed indicating that the later file is \"hidden\" by
Karl Heuer's avatar
Karl Heuer committed
178 179 180 181 182 183 184 185 186 187
the earlier.

For example, suppose `load-path' is set to

\(\"/usr/gnu/emacs/site-lisp\" \"/usr/gnu/emacs/share/emacs/19.30/lisp\"\)

and that each of these directories contains a file called XXX.el.  Then
XXX.el in the site-lisp directory is referred to by all of:
\(require 'XXX\), \(autoload .... \"XXX\"\), \(load-library \"XXX\"\) etc.

188 189
The first XXX.el file prevents Emacs from seeing the second \(unless
the second is loaded explicitly via `load-file'\).
Karl Heuer's avatar
Karl Heuer committed
190 191 192

When not intended, such shadowings can be the source of subtle
problems.  For example, the above situation may have arisen because the
193 194 195 196
XXX package was not distributed with versions of Emacs prior to
19.30.  An Emacs maintainer downloaded XXX from elsewhere and installed
it.  Later, XXX was updated and included in the Emacs distribution.
Unless the Emacs maintainer checks for this, the new version of XXX
Karl Heuer's avatar
Karl Heuer committed
197
will be hidden behind the old \(which may no longer work with the new
198
Emacs version\).
Karl Heuer's avatar
Karl Heuer committed
199 200 201 202 203 204 205

This function performs these checks and flags all possible
shadowings.  Because a .el file may exist without a corresponding .elc
\(or vice-versa\), these suffixes are essentially ignored.  A file
XXX.elc in an early directory \(that does not contain XXX.el\) is
considered to shadow a later file XXX.el, and vice-versa.

206 207
Shadowings are located by calling the (non-interactive) companion
function, `find-emacs-lisp-shadows'."
Karl Heuer's avatar
Karl Heuer committed
208
  (interactive)
209 210 211 212 213
  (let* ((path (copy-sequence load-path))
	(tem path)
	toplevs)
    ;; If we can find simple.el in two places,
    (while tem
Andreas Schwab's avatar
Andreas Schwab committed
214 215
      (if (or (file-exists-p (expand-file-name "simple.el" (car tem)))
	      (file-exists-p (expand-file-name "simple.el.gz" (car tem))))
216 217 218 219
	  (setq toplevs (cons (car tem) toplevs)))
      (setq tem (cdr tem)))
    (if (> (length toplevs) 1)
	;; Cut off our copy of load-path right before
220
	;; the last directory which has simple.el in it.
221 222
	;; This avoids loads of duplications between the source dir
	;; and the dir where these files were copied by installation.
223
	(let ((break (car toplevs)))
224 225 226 227 228 229 230 231 232 233 234 235 236
	  (setq tem path)
	  (while tem
	    (if (eq (nth 1 tem) break)
		(progn
		  (setcdr tem nil)
		  (setq tem nil)))
	    (setq tem (cdr tem)))))

    (let* ((shadows (find-emacs-lisp-shadows path))
	   (n (/ (length shadows) 2))
	   (msg (format "%s Emacs Lisp load-path shadowing%s found"
			(if (zerop n) "No" (concat "\n" (number-to-string n)))
			(if (= n 1) " was" "s were"))))
237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
      (with-temp-buffer
	(while shadows
	  (insert (format "%s hides %s\n" (car shadows)
			  (car (cdr shadows))))
	  (setq shadows (cdr (cdr shadows))))
	(if stringp
	    (buffer-string)
	  (if (interactive-p)
	      (save-excursion
		;; We are interactive.
		;; Create the *Shadows* buffer and display shadowings there.
		(let ((string (buffer-string))
		      (output-buffer (get-buffer-create "*Shadows*")))
		  (display-buffer output-buffer)
		  (set-buffer output-buffer)
		  (erase-buffer)
		  (insert string)
		  (insert msg "\n")))
	    ;; We are non-interactive, print shadows via message.
	    (unless (zerop n)
	      (message "This site has duplicate Lisp libraries with the same name.
258 259
If a locally-installed Lisp library overrides a library in the Emacs release,
that can cause trouble, and you should probably remove the locally-installed
260
version unless you know what you are doing.\n")
261 262 263 264 265 266 267 268
	      (goto-char (point-min))
	      ;; Mimic the previous behavior of using lots of messages.
	      ;; I think one single message would look better...
	      (while (not (eobp))
		(message "%s" (buffer-substring (line-beginning-position)
						(line-end-position)))
		(forward-line 1))
	      (message "%s" msg))))))))
Karl Heuer's avatar
Karl Heuer committed
269 270 271

(provide 'shadow)

272
;; arch-tag: 0480e8a7-62ed-4a12-a9f6-f44ded9b0830
Karl Heuer's avatar
Karl Heuer committed
273
;;; shadow.el ends here