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

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

Karl Heuer's avatar
Karl Heuer committed
104 105
	(setq files-seen-this-dir nil)

106
	(dolist (file curr-files)
Karl Heuer's avatar
Karl Heuer committed
107

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

113 114 115 116
	  ;; 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
117 118 119 120
	    ;; 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))
121

Karl Heuer's avatar
Karl Heuer committed
122 123
	    (if (setq orig-dir (assoc file files))
		;; This file was seen before, we have a shadowing.
Karl Heuer's avatar
Karl Heuer committed
124 125 126 127 128 129 130 131 132
		;; 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
133 134
		      (setq shadows
			    (append shadows (list base1 base2)))))
Karl Heuer's avatar
Karl Heuer committed
135 136

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

Karl Heuer's avatar
Karl Heuer committed
141 142 143 144 145 146 147 148 149 150 151 152
;; 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)))
153
		      (eq 0 (call-process "cmp" nil nil nil "-s" f1 f2))))))))
154 155 156 157 158

(defvar shadow-font-lock-keywords
  `((,(format "hides \\(%s.*\\)"
	      (file-name-directory (locate-library "simple.el")))
     . (1 font-lock-warning-face)))
Glenn Morris's avatar
Glenn Morris committed
159
  "Keywords to highlight in `load-path-shadows-mode'.")
160

Glenn Morris's avatar
Glenn Morris committed
161
(define-derived-mode load-path-shadows-mode fundamental-mode "LP-Shadows"
162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181
  "Major mode for load-path shadows buffer."
  (set (make-local-variable 'font-lock-defaults)
       '((shadow-font-lock-keywords)))
  (setq buffer-undo-list t
	buffer-read-only t))

;; TODO use text-properties instead, a la dired.
(require 'button)
(define-button-type 'shadow-find-file
  'follow-link t
;;  'face 'default
  'action (lambda (button)
	    (let ((file (concat (button-get button 'shadow-file) ".el")))
	      (or (file-exists-p file)
		  (setq file (concat file ".gz")))
	      (if (file-readable-p file)
		  (pop-to-buffer (find-file-noselect file))
		(error "Cannot read file"))))
  'help-echo "mouse-2, RET: find this file")

Karl Heuer's avatar
Karl Heuer committed
182 183

;;;###autoload
184
(defun list-load-path-shadows (&optional stringp)
185
  "Display a list of Emacs Lisp files that shadow other files.
Karl Heuer's avatar
Karl Heuer committed
186

187 188 189 190
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.

191 192
This function lists potential load path problems.  Directories in
the `load-path' variable are searched, in order, for Emacs Lisp
193 194
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
195 196 197 198 199 200 201 202 203 204
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.

205 206
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
207 208 209

When not intended, such shadowings can be the source of subtle
problems.  For example, the above situation may have arisen because the
210 211 212 213
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
214
will be hidden behind the old \(which may no longer work with the new
215
Emacs version\).
Karl Heuer's avatar
Karl Heuer committed
216 217 218 219 220 221 222

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.

223 224
Shadowings are located by calling the (non-interactive) companion
function, `find-emacs-lisp-shadows'."
Karl Heuer's avatar
Karl Heuer committed
225
  (interactive)
226 227 228 229
  (let* ((path (copy-sequence load-path))
	(tem path)
	toplevs)
    ;; If we can find simple.el in two places,
230 231 232 233
    (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))))
234 235
    (if (> (length toplevs) 1)
	;; Cut off our copy of load-path right before
236
	;; the last directory which has simple.el in it.
237 238
	;; This avoids loads of duplications between the source dir
	;; and the dir where these files were copied by installation.
239
	(let ((break (car toplevs)))
240 241 242 243 244 245 246 247 248 249 250 251 252
	  (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"))))
253 254 255 256 257 258 259
      (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)
260
	  (if (called-interactively-p 'interactive)
261 262 263 264 265
	      ;; We are interactive.
	      ;; Create the *Shadows* buffer and display shadowings there.
	      (let ((string (buffer-string)))
		(with-current-buffer (get-buffer-create "*Shadows*")
		  (display-buffer (current-buffer))
Glenn Morris's avatar
Glenn Morris committed
266
		  (load-path-shadows-mode) ; run after-change-major-mode-hook
267 268 269 270 271 272 273 274 275 276 277 278
		  (let ((inhibit-read-only t))
		    (erase-buffer)
		    (insert string)
		    (insert msg "\n")
		    (while (re-search-backward "\\(^.*\\) hides \\(.*$\\)"
					       nil t)
		      (dotimes (i 2)
			(make-button (match-beginning (1+ i))
				     (match-end (1+ i))
				     'type 'shadow-find-file 'shadow-file
				     (match-string (1+ i)))))
		    (goto-char (point-max)))))
279 280 281
	    ;; We are non-interactive, print shadows via message.
	    (unless (zerop n)
	      (message "This site has duplicate Lisp libraries with the same name.
282 283
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
284
version unless you know what you are doing.\n")
285 286 287 288 289 290 291 292
	      (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
293 294 295 296

(provide 'shadow)

;;; shadow.el ends here