(shadows-compare-text-p): Add.

(shadow-same-file-or-nonexistent): Add.
(find-emacs-lisp-shadows): Use directory-file-name.

1 files changed, 32 insertions, 8 deletions

diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index cca8b350731..1e5ef45e7f4 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -53,6 +53,10 @@
 
 ;;; Code:
 
+(defvar shadows-compare-text-p nil
+  "*If non-nil, then shadowing files are reported only if their text differs.
+This is slower, but filters out some innocuous shadowing.")
+
 (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'.
@@ -78,7 +82,7 @@ See the documentation for `list-load-path-shadows' for further information."
   
     (while path
 
-      (setq dir (file-truename (or (car path) ".")))
+      (setq dir (directory-file-name (file-truename (or (car path) "."))))
       (if (member dir true-names)
           ;; We have already considered this PATH redundant directory.
           ;; Show the redundancy if we are interactiver, unless the PATH
@@ -89,15 +93,15 @@ See the documentation for `list-load-path-shadows' for further information."
               (and (car path)
                    (not (string= (car path) "."))
                    (message "Ignoring redundant directory %s" (car path))))
-        
+
         (setq true-names (append true-names (list dir)))
-        (setq dir (or (car path) "."))
+        (setq dir (directory-file-name (or (car path) ".")))
         (setq curr-files (if (file-accessible-directory-p dir)
-                               (directory-files dir nil ".\\.elc?$" t)))
+                             (directory-files dir nil ".\\.elc?$" t)))
         (and curr-files
              (not noninteractive)
              (message "Checking %d files in %s..." (length curr-files) dir))
-        
+
         (setq files-seen-this-dir nil)
 
         (while curr-files
@@ -117,10 +121,17 @@ See the documentation for `list-load-path-shadows' for further information."
               
             (if (setq orig-dir (assoc file files))
                 ;; This file was seen before, we have a shadowing.
+                ;; 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"))))
                 (setq shadows
-                      (append shadows
-                              (list (concat (cdr orig-dir) "/" file)
-                                    (concat dir "/" file))))
+                      (append shadows (list base1 base2)))))
 
               ;; Not seen before, add it to the list of seen files.
               (setq files (cons (cons file dir) files))))
@@ -131,6 +142,19 @@ See the documentation for `list-load-path-shadows' for further information."
     ;; Return the list of shadowings.
     shadows))
 
+;; 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)))
+                      (zerop (call-process "cmp" nil nil nil "-s" f1 f2))))))))
 
 ;;;###autoload
 (defun list-load-path-shadows ()