comparison lisp/emacs-lisp/shadow.el @ 19982:199256234202

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

19981:1d135b4edfcb

;; Thanks to Francesco Potorti` <[e-mail]> for suggestions,
;; rewritings & speedups.

;;; Code:

(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\)

	file)				; The current file.

  
    (while path

      (setq dir (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
	  ;; dir is nil or "." (these redundant directories are just a
	  ;; 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))))
	
	(setq true-names (append true-names (list dir)))
	(setq dir (or (car path) "."))
	(setq curr-files (if (file-accessible-directory-p dir)
                               (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

	  (setq file (car curr-files))

	    ;; 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))))

	      ;; 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)))

    ;; Return the list of shadowings.
    shadows))


;;;###autoload
(defun list-load-path-shadows ()
  "Display a list of Emacs Lisp files that shadow other files.

19982:199256234202

;; Thanks to Francesco Potorti` <[e-mail]> for suggestions,
;; rewritings & speedups.

;;; 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'.

We traverse PATH looking for shadows, and return a \(possibly empty\)

	file)				; The current file.

  
    (while 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
	  ;; dir is nil or "." (these redundant directories are just a
	  ;; 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))))

	(setq true-names (append true-names (list dir)))
	(setq dir (directory-file-name (or (car path) ".")))
	(setq curr-files (if (file-accessible-directory-p dir)
			     (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

	  (setq file (car curr-files))

	    ;; 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.
		;; 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))))

	  (setq curr-files (cdr curr-files))))
	(setq path (cdr path)))

    ;; 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 ()
  "Display a list of Emacs Lisp files that shadow other files.