Merge changes from emacs-23 branch

[gnu-emacs] / lisp / emacs-lisp / shadow.el

diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index 61daa21fcfa16d3ecbff7f2fd7afa58cdd4349c3..d5bba20b1cd0fa48d7f7e53d7848988ab5ac61fa 100644 (file)
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -1,7 +1,6 @@
 ;;; shadow.el --- locate Emacs Lisp file shadowings
 
-;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;;   2009, 2010, 2011  Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2011  Free Software Foundation, Inc.
 
 ;; Author: Terry Jones <terry@santafe.edu>
 ;; Keywords: lisp
@@ -157,6 +156,34 @@ See the documentation for `list-load-path-shadows' for further information."
                 (and (= (nth 7 (file-attributes f1))
                         (nth 7 (file-attributes f2)))
                      (eq 0 (call-process "cmp" nil nil nil "-s" f1 f2))))))))
+
+(defvar load-path-shadows-font-lock-keywords
+  `((,(format "hides \\(%s.*\\)"
+             (file-name-directory (locate-library "simple.el")))
+     . (1 font-lock-warning-face)))
+  "Keywords to highlight in `load-path-shadows-mode'.")
+
+(define-derived-mode load-path-shadows-mode fundamental-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))
+
+;; 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")))
+             (or (file-exists-p file)
+                 (setq file (concat file ".gz")))
+             (if (file-readable-p file)
+                 (pop-to-buffer (find-file-noselect file))
+               (error "Cannot read file"))))
+  'help-echo "mouse-2, RET: find this file")
+
 \f
 ;;;###autoload
 (defun list-load-path-shadows (&optional stringp)
@@ -240,14 +267,21 @@ function, `load-path-shadows-find'."
              ;; Create the *Shadows* buffer and display shadowings there.
              (let ((string (buffer-string)))
                (with-current-buffer (get-buffer-create "*Shadows*")
-                  (fundamental-mode)    ;run after-change-major-mode-hook.
                  (display-buffer (current-buffer))
-                 (setq buffer-undo-list t
-                       buffer-read-only nil)
-                 (erase-buffer)
-                 (insert string)
-                 (insert msg "\n")
-                 (setq buffer-read-only t)))
+                 (load-path-shadows-mode) ; run after-change-major-mode-hook
+                 (let ((inhibit-read-only t))
+                   (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)))))
+                   (goto-char (point-max)))))
            ;; We are non-interactive, print shadows via message.
            (unless (zerop n)
              (message "This site has duplicate Lisp libraries with the same name.
@@ -265,5 +299,4 @@ version unless you know what you are doing.\n")
 
 (provide 'shadow)
 
-;; arch-tag: 0480e8a7-62ed-4a12-a9f6-f44ded9b0830
 ;;; shadow.el ends here