X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0cdbb11dee301e1537bcdab1f4ae53f2515db274..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/emacs-lisp/shadow.el?ds=sidebyside diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index cca8b35073..eeaaa7ffc0 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -1,4 +1,4 @@ -;;; shadow.el --- Locate Emacs Lisp file shadowings. +;;; shadow.el --- locate Emacs Lisp file shadowings ;; Copyright (C) 1995 Free Software Foundation, Inc. @@ -53,6 +53,17 @@ ;;; Code: +(defgroup lisp-shadow nil + "Locate Emacs Lisp file shadowings." + :prefix "shadows-" + :group 'lisp) + +(defcustom 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." + :type 'boolean + :group 'lisp-shadow) + (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'. @@ -63,7 +74,7 @@ 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. @@ -75,10 +86,10 @@ See the documentation for `list-load-path-shadows' for further information." files-seen-this-dir ; Files seen so far in this dir. file) ; The current file. - + (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 +100,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 @@ -114,13 +125,20 @@ See the documentation for `list-load-path-shadows' for further information." ;; 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)) - + (if (setq orig-dir (assoc file files)) ;; This file was seen before, we have a shadowing. - (setq shadows - (append shadows - (list (concat (cdr orig-dir) "/" file) - (concat dir "/" file)))) + ;; 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 base1 base2))))) ;; Not seen before, add it to the list of seen files. (setq files (cons (cons file dir) files)))) @@ -131,6 +149,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))) + (eq 0 (call-process "cmp" nil nil nil "-s" f1 f2)))))))) ;;;###autoload (defun list-load-path-shadows () @@ -171,7 +202,7 @@ 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'." - + (interactive) (let* ((path (copy-sequence load-path)) (tem path) @@ -183,10 +214,10 @@ buffer called `*Shadows*'. Shadowings are located by calling the (setq tem (cdr tem))) (if (> (length toplevs) 1) ;; Cut off our copy of load-path right before - ;; the second directory which has simple.el in it. + ;; the last directory which has simple.el in it. ;; This avoids loads of duplications between the source dir ;; and the dir where these files were copied by installation. - (let ((break (nth (- (length toplevs) 2) toplevs))) + (let ((break (car toplevs))) (setq tem path) (while tem (if (eq (nth 1 tem) break) @@ -218,12 +249,13 @@ buffer called `*Shadows*'. Shadowings are located by calling the (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))))) +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)))))) (provide 'shadow) +;;; arch-tag: 0480e8a7-62ed-4a12-a9f6-f44ded9b0830 ;;; shadow.el ends here