=== modified file 'lisp/emacs-lisp/shadow.el' --- old/lisp/emacs-lisp/shadow.el 2014-01-01 07:43:34 +0000 +++ new/lisp/emacs-lisp/shadow.el 2014-03-04 22:26:00 +0000 @@ -115,7 +115,8 @@ ;; FILE now contains the current file name, with no suffix. (unless (or (member file files-seen-this-dir) ;; Ignore these files. - (member file '("subdirs" "leim-list"))) + (member file '("subdirs" "leim-list")) + (string= file (file-name-sans-extension dir-locals-file))) ;; 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. @@ -169,20 +170,27 @@ . (1 font-lock-warning-face))) "Keywords to highlight in `load-path-shadows-mode'.") -(define-derived-mode load-path-shadows-mode fundamental-mode "LP-Shadows" +(define-derived-mode load-path-shadows-mode special-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)) +(let ((map (make-sparse-keymap))) + (define-key map [tab] 'forward-button) + (define-key map [backtab] 'backward-button) + (setq load-path-shadows-mode-map map)) + ;; 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"))) + (let* ((shadow-file (button-get button 'shadow-file)) + (file (if (equal (file-name-extension shadow-file) "el") + shadow-file + (concat shadow-file ".el")))) (or (file-exists-p file) (setq file (concat file ".gz"))) (if (file-readable-p file) @@ -190,6 +198,21 @@ (error "Cannot read file")))) 'help-echo "mouse-2, RET: find this file") +(defun load-path-shadows-make-buttons () + "Create buttons for `load-path-shadows-mode'." + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\\(^.*\\) hides \\(.*$\\)" + nil t) + (dotimes (i 2) + (let ((file (match-string (1+ i)))) + (when (file-exists-p file) + (make-button (match-beginning (1+ i)) + (match-end (1+ i)) + 'type 'load-path-shadows-find-file + 'shadow-file file)))))))) + ;;;###autoload (defun list-load-path-shadows (&optional stringp) @@ -231,6 +254,11 @@ XXX.elc in an early directory (that does not contain XXX.el) is considered to shadow a later file XXX.el, and vice-versa. +Files named .dir-locals.el are not reported by this command. +These files specify directory local variables. It is normal that +it exists multiple files with this name. But see the command +`list-dir-locals-shadows'. + Shadowings are located by calling the (non-interactive) companion function, `load-path-shadows-find'." (interactive) @@ -257,14 +285,7 @@ (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))))) + (load-path-shadows-make-buttons) (goto-char (point-max))))) ;; We are non-interactive, print shadows via message. (unless (zerop n) @@ -281,6 +302,93 @@ (forward-line 1)) (message "%s" msg))))))) + + + +;;;###autoload +(defun list-dir-locals-shadows (&optional stringp path) + "Display a list of .dir-locals.el files that shadow other such files. + +A .dir-locals.el file will shadow any other such file higher up +in the directory tree. Sometimes this is what you want, +sometimes it is not. + +If the optional argument STRINGP is non-nil, returns any shadows +as a string. Otherwise, if interactive shows any shadows in a +`*Dir-Locals-Shadows*' buffer; else print a message listing any +shadows. + +The optional argument PATH is the directory or list of +directories to examine. It defaults to the value of `load-path'. + +This command complements the command `list-load-path-shadows'." + (interactive) + (unless path + (setq path load-path)) + (let ((string (dir-locals-shadows-find path))) + (if stringp + string + (if (zerop (length string)) + (message "No dir-local shadows found.") + (if (called-interactively-p 'interactive) + (dir-locals-shadows-display string) + (message "Dir-locals shadows:\n%s" string)))))) + +(defun dir-locals-shadows-find (path) + "Return a string of .dir-locals.el files that shadows other such files. + +The argument PATH is the directory or list of directories to +examine. + +A .dir-locals.el file will shadow any other such file higher up +in the directory tree. Sometimes this is what you want, +sometimes it is not." + (when (stringp path) + (setq path (list path))) + (with-temp-buffer + (dolist (dir path) + (if (file-directory-p dir) + (dir-locals-shadows-find-1 dir (dir-locals-find-file (file-name-as-directory dir))) + (insert (format "Invalid dir %s\n" dir)))) + (buffer-string))) + +(defun dir-locals-shadows-find-1 (dir locals) + "Auxiliary function for `dir-locals-shadows-find'." + (dolist (file (directory-files dir nil nil 'no-sort)) + (let ((subdir (expand-file-name file dir))) + (when (and (file-directory-p subdir) + (not (or (string-equal file ".") + (string-equal file "..") + (file-symlink-p subdir)))) + (let ((subdir-locals (dir-locals-find-file (file-name-as-directory subdir)))) + (and locals + (not (equal locals subdir-locals)) + (insert (format "%s hides %s\n" + (dir-locals-class-name subdir-locals) + (dir-locals-class-name locals)))) + (dir-locals-shadows-find-1 subdir subdir-locals)))))) + +(defun dir-locals-class-name (class) + "Returns a describing string for directory-local class CLASS. + +CLASS is a values returned from `dir-locals-find-file'. It +can be a string or a list. See that function for details." + (if (stringp class) + class + (if (file-name-directory (symbol-name (cadr class))) + (concat (car class) dir-locals-file) + (format "%s (class %s)" (car class) (cadr class))))) + +(defun dir-locals-shadows-display (string) + "Display the dir-locals shadows STRING in a buffer." + (with-current-buffer (get-buffer-create "*Dir-Locals-Shadows*") + (load-path-shadows-mode) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert string) + (load-path-shadows-make-buttons) + (display-buffer (current-buffer))))) + (provide 'shadow) ;;; shadow.el ends here