bug#12357: 24.2; list-load-path-shadow should ignore .dir-locals.el

[Johan Claesson]

Great.  Attached is a loading.texi patch that just add to the
description of list-load-path-shadows that it will not report
.dir-locals.el files.  Do you think there should be a @deffn entry for 
list-load-path-dir-locals-shadows as well?

Also attached is a shadow.el patch with the following changes: 

1. Some more doc string text. 
2. list-load-path-dir-locals-shadows uses the same button making code as
list-load-path-shadows. 
3. Inherit the major mode from special-mode instead of fundamental-mode
to get quit on ?q etc. 
4. Also bind forward-button to tab in this mode.  And backward-button to
backtab. 
5. It will not bail out on an invalid directory in load-path any more (i
happened to have some invalid directories in load-path while testing
this :) ). 

Regards,

/Johan

=== modified file 'doc/lispref/loading.texi'
--- old/doc/lispref/loading.texi        2014-01-01 07:43:34 +0000
+++ new/doc/lispref/loading.texi        2014-03-02 21:39:14 +0000
@@ -411,12 +411,19 @@
 directory.  Such a situation might indicate a problem in the way Emacs
 was installed.
 
+Files named @file{.dir-locals.el} are not reported by this command.
+These files specify directory local variables, see @ref{Directory
+Local Variables}.  It is normal that it exists multiple files with
+this name.
+
 When called from Lisp, this function prints a message listing the
 shadowed files, instead of displaying them in a buffer.  If the
 optional argument @code{stringp} is non-@code{nil}, it instead returns
 the shadowed files as a string.
 @end deffn
 
+
+
 @node Loading Non-ASCII
 @section Loading Non-@acronym{ASCII} Characters
 

=== 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-02 22:06:37 +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,20 @@
                (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)
+          (make-button (match-beginning (1+ i))
+                       (match-end (1+ i))
+                       'type 'load-path-shadows-find-file
+                       'shadow-file
+                       (match-string (1+ i))))))))
+
 
 ;;;###autoload
 (defun list-load-path-shadows (&optional stringp)
@@ -231,6 +253,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-load-path-dir-locals-shadows'.
+
 Shadowings are located by calling the (non-interactive) companion
 function, `load-path-shadows-find'."
   (interactive)
@@ -257,14 +284,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 +301,64 @@
              (forward-line 1))
            (message "%s" msg)))))))
 
+
+
+
+
+(defun list-load-path-dir-locals-shadows ()
+  "Display a list of dir-local 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.  This command will show all such shadowing
+in the current `load-path'.
+
+This command complements the command `list-load-path-shadows'.
+"
+  (interactive)
+  (dir-locals-shadows load-path))
+
+(defun dir-locals-shadows (path)
+  "Display a list of dir-local files that shadow other files under PATH."
+  (when (stringp path)
+    (setq path (list path)))
+  (with-current-buffer (get-buffer-create "*Dir-Locals-Shadows*")
+    (let ((inhibit-read-only t))
+      (erase-buffer)
+      (dolist (dir path)
+        (if (file-directory-p dir)
+            (dir-locals-shadows-1 dir (dir-locals-find-file 
(file-name-as-directory dir)))
+          (insert (format "invalid dir %s\n" dir)))))
+    (load-path-shadows-mode)
+    (load-path-shadows-make-buttons)
+    (if (> (point-max) (point-min))
+        (display-buffer (current-buffer))
+      (kill-buffer (current-buffer))
+      (message "No dir-local shadows found."))))
+
+(defun dir-locals-class-name (class)
+  (if (stringp class)
+      class
+    (if (file-name-directory (symbol-name (cadr class)))
+        (concat (car class) dir-locals-file)
+      (format "%s%s (class %s)" (car class) dir-locals-file (cadr class)))))
+
+(defun dir-locals-shadows-1 (dir locals)
+  "Auxiliary function for `dir-locals-shadows'."
+  (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-1 subdir subdir-locals))))))
+
 (provide 'shadow)
 
 ;;; shadow.el ends here





Xue Fuqiao <xfq@gnu.org> writes:

> Johan Claesson <johanclaesson@bredband.net> writes:
>
>> A command to search for .dir-local.el shadows could look something like
>> below.
>
> Looks fine to me.  I made a patch (and tested it).  Any comments?
>
> (I haven't written the documentation/ChangeLog/NEWS yet.)
>
> === modified file 'lisp/emacs-lisp/shadow.el'
> --- lisp/emacs-lisp/shadow.el 2014-01-01 07:43:34 +0000
> +++ lisp/emacs-lisp/shadow.el 2014-02-26 08:38:54 +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.
> @@ -281,6 +282,49 @@
>             (forward-line 1))
>           (message "%s" msg)))))))
>  
> +
> +
> +(defun list-load-path-dir-locals-shadows ()
> +  "Display a list of dir-local files that shadow other files."
> +  (interactive)
> +  (dir-locals-shadows load-path))
> +
> +(defun dir-locals-shadows (path)
> +  "Display a list of dir-local files that shadow other files under PATH."
> +  (when (stringp path)
> +    (setq path (list path)))
> +  (with-current-buffer (get-buffer-create "*Dir-Locals-Shadows*")
> +    (erase-buffer)
> +    (dolist (dir path)
> +      (dir-locals-shadows-1 dir (dir-locals-find-file 
> (file-name-as-directory dir))))
> +    (if (> (point-max) (point-min))
> +        (display-buffer (current-buffer))
> +      (kill-buffer (current-buffer))
> +      (message "No dir-local shadows found."))))
> +
> +(defun dir-locals-class-name (class)
> +  (if (stringp class)
> +      class
> +    (if (file-name-directory (symbol-name (cadr class)))
> +        (concat (car class) dir-locals-file)
> +      (format "%s%s (class %s)" (car class) dir-locals-file (cadr class)))))
> +
> +(defun dir-locals-shadows-1 (dir locals)
> +  "Auxiliary function for `dir-locals-shadows'."
> +  (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 shadows %s\n"
> +                               (dir-locals-class-name subdir-locals)
> +                               (dir-locals-class-name locals))))
> +          (dir-locals-shadows-1 subdir subdir-locals))))))
> +
>  (provide 'shadow)
>  
>  ;;; shadow.el ends here