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

3
;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2009, 2010  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
  "Locate Emacs Lisp file shadowings."
Glenn Morris's avatar
Glenn Morris committed
56
  :prefix "load-path-shadows-"
Stephen Eglen's avatar
Stephen Eglen committed
57 58
  :group 'lisp)

Glenn Morris's avatar
Glenn Morris committed
59 60 61 62
(define-obsolete-variable-alias 'shadows-compare-text-p
  'load-path-shadows-compare-text "23.3")

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

Karl Heuer's avatar
Karl Heuer committed
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
(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."
  (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.
86 87
    (dolist (pp (or path load-path))
      (setq dir (directory-file-name (file-truename (or pp "."))))
Karl Heuer's avatar
Karl Heuer committed
88 89
      (if (member dir true-names)
	  ;; We have already considered this PATH redundant directory.
90
	  ;; Show the redundancy if we are interactive, unless the PATH
Karl Heuer's avatar
Karl Heuer committed
91 92 93 94
	  ;; dir is nil or "." (these redundant directories are just a
	  ;; result of the current working directory, and are therefore
	  ;; not always redundant).
	  (or noninteractive
95 96 97
	      (and pp
		   (not (string= pp "."))
		   (message "Ignoring redundant directory %s" pp)))
Karl Heuer's avatar
Karl Heuer committed
98

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

Karl Heuer's avatar
Karl Heuer committed
107 108
	(setq files-seen-this-dir nil)

109
	(dolist (file curr-files)
Karl Heuer's avatar
Karl Heuer committed
110

Andreas Schwab's avatar
Andreas Schwab committed
111 112
	  (if (string-match "\\.gz$" file)
	      (setq file (substring file 0 -3)))
Karl Heuer's avatar
Karl Heuer committed
113 114 115
	  (setq file (substring
		      file 0 (if (string= (substring file -1) "c") -4 -3)))

116 117 118 119
	  ;; 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
120 121 122 123
	    ;; 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))
124

Karl Heuer's avatar
Karl Heuer committed
125 126
	    (if (setq orig-dir (assoc file files))
		;; This file was seen before, we have a shadowing.
Karl Heuer's avatar
Karl Heuer committed
127 128 129
		;; Report it unless the files are identical.
		(let ((base1 (concat (cdr orig-dir) "/" file))
		      (base2 (concat dir "/" file)))
Glenn Morris's avatar
Glenn Morris committed
130 131
		  (if (not (and load-path-shadows-compare-text
				(load-path-shadows-same-file-or-nonexistent
Karl Heuer's avatar
Karl Heuer committed
132 133
				 (concat base1 ".el") (concat base2 ".el"))
				;; This is a bit strict, but safe.
Glenn Morris's avatar
Glenn Morris committed
134
				(load-path-shadows-same-file-or-nonexistent
Karl Heuer's avatar
Karl Heuer committed
135
				 (concat base1 ".elc") (concat base2 ".elc"))))
Richard M. Stallman's avatar
Richard M. Stallman committed
136 137
		      (setq shadows
			    (append shadows (list base1 base2)))))
Karl Heuer's avatar
Karl Heuer committed
138 139

	      ;; Not seen before, add it to the list of seen files.
140
	      (setq files (cons (cons file dir) files)))))))
Karl Heuer's avatar
Karl Heuer committed
141 142 143
    ;; Return the list of shadowings.
    shadows))

Karl Heuer's avatar
Karl Heuer committed
144 145
;; Return true if neither file exists, or if both exist and have identical
;; contents.
Glenn Morris's avatar
Glenn Morris committed
146
(defun load-path-shadows-same-file-or-nonexistent (f1 f2)
Karl Heuer's avatar
Karl Heuer committed
147 148 149 150 151 152 153 154 155
  (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)))
156
		      (eq 0 (call-process "cmp" nil nil nil "-s" f1 f2))))))))
Karl Heuer's avatar
Karl Heuer committed
157 158

;;;###autoload
159
(defun list-load-path-shadows (&optional stringp)
160
  "Display a list of Emacs Lisp files that shadow other files.
Karl Heuer's avatar
Karl Heuer committed
161

162 163 164 165
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.

166 167
This function lists potential load path problems.  Directories in
the `load-path' variable are searched, in order, for Emacs Lisp
168 169
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
170 171 172 173 174 175 176 177 178 179
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.

180 181
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
182 183 184

When not intended, such shadowings can be the source of subtle
problems.  For example, the above situation may have arisen because the
185 186 187 188
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
189
will be hidden behind the old \(which may no longer work with the new
190
Emacs version\).
Karl Heuer's avatar
Karl Heuer committed
191 192 193 194 195 196 197

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.

198 199
Shadowings are located by calling the (non-interactive) companion
function, `find-emacs-lisp-shadows'."
Karl Heuer's avatar
Karl Heuer committed
200
  (interactive)
201 202 203 204
  (let* ((path (copy-sequence load-path))
	(tem path)
	toplevs)
    ;; If we can find simple.el in two places,
205 206 207 208
    (dolist (tt tem)
      (if (or (file-exists-p (expand-file-name "simple.el" tt))
	      (file-exists-p (expand-file-name "simple.el.gz" tt)))
	  (setq toplevs (cons tt toplevs))))
209 210
    (if (> (length toplevs) 1)
	;; Cut off our copy of load-path right before
211
	;; the last directory which has simple.el in it.
212 213
	;; This avoids loads of duplications between the source dir
	;; and the dir where these files were copied by installation.
214
	(let ((break (car toplevs)))
215 216 217 218 219 220 221 222 223 224 225 226 227
	  (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"))))
228 229 230 231 232 233 234
      (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)
235
	  (if (called-interactively-p 'interactive)
236 237 238 239
	      ;; We are interactive.
	      ;; Create the *Shadows* buffer and display shadowings there.
	      (let ((string (buffer-string)))
		(with-current-buffer (get-buffer-create "*Shadows*")
240
                  (fundamental-mode)    ;run after-change-major-mode-hook.
241 242 243
		  (display-buffer (current-buffer))
		  (setq buffer-undo-list t
			buffer-read-only nil)
244 245
		  (erase-buffer)
		  (insert string)
246 247
		  (insert msg "\n")
		  (setq buffer-read-only t)))
248 249 250
	    ;; We are non-interactive, print shadows via message.
	    (unless (zerop n)
	      (message "This site has duplicate Lisp libraries with the same name.
251 252
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
253
version unless you know what you are doing.\n")
254 255 256 257 258 259 260 261
	      (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
262 263 264

(provide 'shadow)

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