]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/shadow.el
Fixes: debbugs:6594
[gnu-emacs] / lisp / emacs-lisp / shadow.el
index 62feb15939d63b711f3b8b1f2211a46c46c871fb..61daa21fcfa16d3ecbff7f2fd7afa58cdd4349c3 100644 (file)
@@ -1,7 +1,7 @@
 ;;; shadow.el --- locate Emacs Lisp file shadowings
 
 ;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;;   2009  Free Software Foundation, Inc.
+;;   2009, 2010, 2011  Free Software Foundation, Inc.
 
 ;; Author: Terry Jones <terry@santafe.edu>
 ;; Keywords: lisp
@@ -24,7 +24,7 @@
 
 ;;; 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.
 ;;
 \f
 (defgroup lisp-shadow nil
   "Locate Emacs Lisp file shadowings."
-  :prefix "shadows-"
+  :prefix "load-path-shadows-"
   :group 'lisp)
 
-(defcustom shadows-compare-text-p nil
+(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'.
 
@@ -72,9 +75,6 @@ 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."
-
-  (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.
@@ -83,11 +83,8 @@ See the documentation for `list-load-path-shadows' for further information."
        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
@@ -95,12 +92,12 @@ See the documentation for `list-load-path-shadows' for further information."
          ;; 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
@@ -109,9 +106,8 @@ See the documentation for `list-load-path-shadows' for further information."
 
        (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
@@ -120,7 +116,7 @@ See the documentation for `list-load-path-shadows' for further information."
          ;; FILE now contains the current file name, with no suffix.
          (unless (or (member file files-seen-this-dir)
                      ;; Ignore these files.
-                     (member file '("subdirs")))
+                     (member file '("subdirs" "leim-list")))
            ;; 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.
@@ -131,27 +127,26 @@ See the documentation for `list-load-path-shadows' for further information."
                ;; 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))
@@ -204,17 +199,16 @@ XXX.elc in an early directory \(that does not contain XXX.el\) is
 considered to shadow a later file XXX.el, and vice-versa.
 
 Shadowings are located by calling the (non-interactive) companion
-function, `find-emacs-lisp-shadows'."
+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.
@@ -229,7 +223,7 @@ function, `find-emacs-lisp-shadows'."
                  (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)))
@@ -241,17 +235,19 @@ function, `find-emacs-lisp-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)
+         (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*")
+                  (fundamental-mode)    ;run after-change-major-mode-hook.
+                 (display-buffer (current-buffer))
+                 (setq buffer-undo-list t
+                       buffer-read-only nil)
                  (erase-buffer)
                  (insert string)
-                 (insert msg "\n")))
+                 (insert msg "\n")
+                 (setq buffer-read-only t)))
            ;; We are non-interactive, print shadows via message.
            (unless (zerop n)
              (message "This site has duplicate Lisp libraries with the same name.