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

From: Johan Claesson <[email-masked]>
Date: Tue, 04 Mar 2014 23:29:24 +0100

Ok, that is added to the loading.texi patch. 

Also list-load-path-dir-locals-shadows was renamed to
list-dir-locals-shadows.  An argument PATH was added since it makes
sense to run this on other directories than load-path.  And the argument
STRINGP was added to align with list-load-path-shadows.

NEWS suggestion:

** `list-load-path-shadows' no longer reports .dir-locals.el files.  A
.dir-locals.el file may shadow another .dir-locals.el file but not in
the same sense as in `list-load-path-shadows'.  A new command
`list-dir-locals-shadows' is introduced.  It detect shadows of
.dir-locals.el files in a way that make sense for this type of files.

ChangeLog suggestion:

	* emacs-lisp/shadows.el (load-path-shadows-find): Do not report
	.dir-locals.el files. 
	(list-dir-locals-shadows): New command that reports shadows of
	.dir-locals.el in a way that make sense for that type of file. 
	(dir-locals-shadows-find, dir-locals-shadows-find-1)
	(dir-locals-class-name, dir-locals-shadows-display): Auxiliary
	functions for list-dir-locals-shadows.

Regards,

/Johan

=== 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

=== 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-04 22:12:52 +0000
@@ -411,12 +411,35 @@
 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.  But see the command @code{list-dir-locals-shadows}
+below.
+
 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
+optional argument @var{stringp} is non-@code{nil}, it instead returns
 the shadowed files as a string.
 @end deffn
 
+@deffn Command list-dir-locals-shadows &optional stringp path
+This command displays a list of @file{.dir-locals.el} files that shadow other
+such files.
+
+A @file{.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 @var{stringp} is non-@code{nil}, returns any
+shadows as a string.  Otherwise, if interactive shows any shadows in a
+buffer; else prints a message listing any shadows.
+
+The optional argument @var{path} is the directory or list of directories
+to examine.  It defaults to the value of @code{load-path}.
+@end deffn
+
+
 @node Loading Non-ASCII
 @section Loading Non-@acronym{ASCII} Characters

Xue Fuqiao <[email-masked]> writes:

> Johan Claesson <[email-masked]> writes:
>
>> Do you think there should be a @deffn entry for
>> list-load-path-dir-locals-shadows as well?
>
> I think so.