;;; shadow.el --- locate Emacs Lisp file shadowings
-;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
;; Author: Terry Jones <terry@santafe.edu>
;; Keywords: lisp
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;; The functions in this file detect (`find-emacs-lisp-shadows')
+;; The functions in this file detect (`load-path-shadows-find')
;; and display (`list-load-path-shadows') potential load-path
;; problems that arise when Emacs Lisp files "shadow" each other.
;;
;; The `list-load-path-shadows' function was run when you installed
;; this version of emacs. To run it by hand in emacs:
;;
-;; M-x load-library RET shadow RET
;; M-x list-load-path-shadows
;;
;; or run it non-interactively via:
;;
-;; emacs -batch -l shadow.el -f list-load-path-shadows
+;; emacs -batch -f list-load-path-shadows
;;
;; Thanks to Francesco Potorti` <pot@cnuce.cnr.it> for suggestions,
;; rewritings & speedups.
\f
(defgroup lisp-shadow nil
"Locate Emacs Lisp file shadowings."
- :prefix "shadows-"
+ :prefix "load-path-shadows-"
:group 'lisp)
-(defcustom shadows-compare-text-p nil
- "*If non-nil, then shadowing files are reported only if their text differs.
+(define-obsolete-variable-alias 'shadows-compare-text-p
+ 'load-path-shadows-compare-text "23.3")
+
+(defcustom load-path-shadows-compare-text nil
+ "If non-nil, then shadowing files are reported only if their text differs.
This is slower, but filters out some innocuous shadowing."
:type 'boolean
:group 'lisp-shadow)
-(defun find-emacs-lisp-shadows (&optional path)
+(defun load-path-shadows-find (&optional path)
"Return a list of Emacs Lisp files that create shadows.
This function does the work for `list-load-path-shadows'.
are stripped from the file names in the list.
See the documentation for `list-load-path-shadows' for further information."
-
- (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.
orig-dir ; Where the file was first seen.
files-seen-this-dir ; Files seen so far in this dir.
file) ; The current file.
-
-
- (while path
-
- (setq dir (directory-file-name (file-truename (or (car path) "."))))
+ (dolist (pp (or path load-path))
+ (setq dir (directory-file-name (file-truename (or pp "."))))
(if (member dir true-names)
;; We have already considered this PATH redundant directory.
;; Show the redundancy if we are interactive, unless the PATH
;; result of the current working directory, and are therefore
;; not always redundant).
(or noninteractive
- (and (car path)
- (not (string= (car path) "."))
- (message "Ignoring redundant directory %s" (car path))))
+ (and pp
+ (not (string= pp "."))
+ (message "Ignoring redundant directory %s" pp)))
(setq true-names (append true-names (list dir)))
- (setq dir (directory-file-name (or (car path) ".")))
+ (setq dir (directory-file-name (or pp ".")))
(setq curr-files (if (file-accessible-directory-p dir)
(directory-files dir nil ".\\.elc?\\(\\.gz\\)?$" t)))
(and curr-files
(setq files-seen-this-dir nil)
- (while curr-files
+ (dolist (file curr-files)
- (setq file (car curr-files))
(if (string-match "\\.gz$" file)
(setq file (substring file 0 -3)))
(setq file (substring
;; 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
+ (if (not (and load-path-shadows-compare-text
+ (load-path-shadows-same-file-or-nonexistent
(concat base1 ".el") (concat base2 ".el"))
;; This is a bit strict, but safe.
- (shadow-same-file-or-nonexistent
+ (load-path-shadows-same-file-or-nonexistent
(concat base1 ".elc") (concat base2 ".elc"))))
(setq shadows
(append shadows (list base1 base2)))))
;; 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)))
-
+ (setq files (cons (cons file dir) files)))))))
;; Return the list of shadowings.
shadows))
+(define-obsolete-function-alias 'find-emacs-lisp-shadows
+ 'load-path-shadows-find "23.3")
+
;; Return true if neither file exists, or if both exist and have identical
;; contents.
-(defun shadow-same-file-or-nonexistent (f1 f2)
+(defun load-path-shadows-same-file-or-nonexistent (f1 f2)
(let ((exists1 (file-exists-p f1))
(exists2 (file-exists-p f2)))
(or (and (not exists1) (not exists2))
(and (= (nth 7 (file-attributes f1))
(nth 7 (file-attributes f2)))
(eq 0 (call-process "cmp" nil nil nil "-s" f1 f2))))))))
+
+(defvar load-path-shadows-font-lock-keywords
+ `((,(format "hides \\(%s.*\\)"
+ (file-name-directory (locate-library "simple.el")))
+ . (1 font-lock-warning-face)))
+ "Keywords to highlight in `load-path-shadows-mode'.")
+
+(define-derived-mode load-path-shadows-mode fundamental-mode "LP-Shadows"
+ "Major mode for load-path shadows buffer."
+ (set (make-local-variable 'font-lock-defaults)
+ '((load-path-shadows-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 'load-path-shadows-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")
+
\f
;;;###autoload
-(defun list-load-path-shadows ()
+(defun list-load-path-shadows (&optional stringp)
"Display a list of Emacs Lisp files that shadow other files.
+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.
+
This function lists potential load path problems. Directories in
the `load-path' variable are searched, in order, for Emacs Lisp
files. When a previously encountered file name is found again, a
XXX.elc in an early directory \(that does not contain XXX.el\) is
considered to shadow a later file XXX.el, and vice-versa.
-When run interactively, the shadowings \(if any\) are displayed in a
-buffer called `*Shadows*'. Shadowings are located by calling the
-\(non-interactive\) companion function, `find-emacs-lisp-shadows'."
-
+Shadowings are located by calling the (non-interactive) companion
+function, `load-path-shadows-find'."
(interactive)
(let* ((path (copy-sequence load-path))
(tem path)
toplevs)
;; If we can find simple.el in two places,
- (while tem
- (if (or (file-exists-p (expand-file-name "simple.el" (car tem)))
- (file-exists-p (expand-file-name "simple.el.gz" (car tem))))
- (setq toplevs (cons (car tem) toplevs)))
- (setq tem (cdr tem)))
+ (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))))
(if (> (length toplevs) 1)
;; Cut off our copy of load-path right before
;; the last directory which has simple.el in it.
(setq tem nil)))
(setq tem (cdr tem)))))
- (let* ((shadows (find-emacs-lisp-shadows path))
+ (let* ((shadows (load-path-shadows-find 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"))))
- (if (interactive-p)
- (save-excursion
- ;; We are interactive.
- ;; Create the *Shadows* buffer and display shadowings there.
- (let ((output-buffer (get-buffer-create "*Shadows*")))
- (display-buffer output-buffer)
- (set-buffer output-buffer)
- (erase-buffer)
- (while shadows
- (insert (format "%s hides %s\n" (car shadows)
- (car (cdr shadows))))
- (setq shadows (cdr (cdr shadows))))
- (insert msg "\n")))
- ;; We are non-interactive, print shadows via message.
- (when shadows
- (message "This site has duplicate Lisp libraries with the same name.
+ (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 (called-interactively-p 'interactive)
+ ;; 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))
+ (load-path-shadows-mode) ; run after-change-major-mode-hook
+ (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 'load-path-shadows-find-file
+ 'shadow-file
+ (match-string (1+ i)))))
+ (goto-char (point-max)))))
+ ;; We are non-interactive, print shadows via message.
+ (unless (zerop n)
+ (message "This site has duplicate Lisp libraries with the same name.
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
version unless you know what you are doing.\n")
- (while shadows
- (message "%s hides %s" (car shadows) (car (cdr shadows)))
- (setq shadows (cdr (cdr shadows))))
- (message "%s" msg))))))
+ (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))))))))
(provide 'shadow)
-;;; arch-tag: 0480e8a7-62ed-4a12-a9f6-f44ded9b0830
;;; shadow.el ends here
HCoop / bpt / emacs.git / blobdiff