Merge from emacs--rel--22

[bpt/emacs.git] / lisp / speedbar.el

diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 4ecb0ec..cd24ae4 100644 (file)
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1,7 +1,7 @@
 ;;; speedbar --- quick access to files and tags in a frame
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: file, tags, tools
@@ -17,7 +17,7 @@ this version is not backward compatible to 0.14 or earlier.")
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -657,10 +657,11 @@ before speedbar has been loaded."
               speedbar-ignored-directory-regexp
               (speedbar-extension-list-to-regex val))))
 
-(defcustom speedbar-directory-unshown-regexp "^\\(CVS\\|RCS\\|SCCS\\|\\..*\\)\\'"
+(defcustom speedbar-directory-unshown-regexp "^\\(\\..*\\)\\'"
   "*Regular expression matching directories not to show in speedbar.
 They should include commonly existing directories which are not
-useful, such as version control."
+useful.  It is no longer necessary to include include version-control
+directories here; see \\[vc-directory-exclusion-list\\]."
   :group 'speedbar
   :type 'string)
 
@@ -994,7 +995,7 @@ supported at a time.
                     'speedbar-buffer
                     "Speedbar"
                     #'speedbar-frame-mode
-                    (if dframe-xemacsp
+                    (if (featurep 'xemacs)
                         (append speedbar-frame-plist
                                 ;; This is a hack to get speedbar to iconfiy
                                 ;; with the selected frame.
@@ -1020,7 +1021,7 @@ supported at a time.
 
 (defun speedbar-frame-reposition-smartly ()
   "Reposition the speedbar frame to be next to the attached frame."
-  (cond ((and dframe-xemacsp
+  (cond ((and (featurep 'xemacs)
              (or (member 'left speedbar-frame-plist)
                  (member 'top speedbar-frame-plist)))
         (dframe-reposition-frame
@@ -1029,7 +1030,7 @@ supported at a time.
          (cons (car (cdr (member 'left speedbar-frame-plist)))
                (car (cdr (member 'top speedbar-frame-plist)))))
         )
-       ((and (not dframe-xemacsp)
+       ((and (not (featurep 'xemacs))
              (or (assoc 'left speedbar-frame-parameters)
                  (assoc 'top speedbar-frame-parameters)))
         ;; if left/top were specified in the parameters, pass them
@@ -1164,7 +1165,7 @@ return true without a query."
 This gives visual indications of what is up.  It EXPECTS the speedbar
 frame and window to be the currently active frame and window."
   (if (and (frame-live-p (speedbar-current-frame))
-          (or (not dframe-xemacsp)
+          (or (not (featurep 'xemacs))
               (with-no-warnings
                 (specifier-instance has-modeline-p)))
           speedbar-buffer)
@@ -1252,7 +1253,7 @@ and the existence of packages."
       (if speedbar-previous-menu (easy-menu-remove speedbar-previous-menu))
       (setq speedbar-previous-menu md)
       ;; Now add the new menu
-      (if (not dframe-xemacsp)
+      (if (not (featurep 'xemacs))
          (easy-menu-define speedbar-menu-map (current-local-map)
                            "Speedbar menu" md)
        (easy-menu-add md (current-local-map))
@@ -1917,6 +1918,7 @@ the file-system."
        (while dir
          (if (not
               (or (string-match speedbar-file-unshown-regexp (car dir))
+                  (member (car dir) vc-directory-exclusion-list)
                   (string-match speedbar-directory-unshown-regexp (car dir))))
              (if (file-directory-p (car dir))
                  (setq dirs (cons (car dir) dirs))
@@ -2915,7 +2917,7 @@ to add more types of version control systems."
             (not (or (and (featurep 'ange-ftp)
                           (string-match
                            (car (symbol-value
-                                 (if dframe-xemacsp
+                                 (if (featurep 'xemacs)
                                      'ange-ftp-directory-format
                                    'ange-ftp-name-format)))
                            (expand-file-name default-directory)))
@@ -2972,18 +2974,8 @@ the file being checked."
   "Return t if we should bother checking DIRECTORY for version control files.
 This can be overloaded to add new types of version control systems."
   (or
-   ;; Local CVS available in Emacs 21
-   (and (fboundp 'vc-state)
-       (file-exists-p (concat directory "CVS/")))
-   ;; Local RCS
-   (file-exists-p (concat directory "RCS/"))
-   ;; Local SCCS
-   (file-exists-p (concat directory "SCCS/"))
-   ;; Remote SCCS project
-   (let ((proj-dir (getenv "PROJECTDIR")))
-     (if proj-dir
-        (file-exists-p (concat proj-dir "/SCCS"))
-       nil))
+   (catch t (dolist (vcd vc-directory-exclusion-list)
+             (if (file-exists-p (concat directory vcd)) (throw t t))) nil)
    ;; User extension
    (run-hook-with-args-until-success 'speedbar-vc-directory-enable-hook
                                      directory)
@@ -2991,29 +2983,11 @@ This can be overloaded to add new types of version control systems."
 
 (defun speedbar-this-file-in-vc (directory name)
   "Check to see if the file in DIRECTORY with NAME is in a version control system.
-You can add new VC systems by overriding this function.  You can
+Automatically recognizes all VCs supported by VC mode.  You can
 optimize this function by overriding it and only doing those checks
 that will occur on your system."
   (or
-   (if (fboundp 'vc-state)
-       ;; Emacs 21 handles VC state in a nice way.
-       (condition-case nil
-          (let ((state  (vc-state (concat directory name))))
-            (not (or (eq 'up-to-date state)
-                     (null state))))
-        ;; An error means not in a VC system
-        (error nil))
-     (or
-      ;; RCS file name
-      (file-exists-p (concat directory "RCS/" name ",v"))
-      (file-exists-p (concat directory "RCS/" name))
-      ;; Local SCCS file name
-      (file-exists-p (concat directory "SCCS/s." name))
-      ;; Remote SCCS file name
-      (let ((proj-dir (getenv "PROJECTDIR")))
-       (if proj-dir
-           (file-exists-p (concat proj-dir "/SCCS/s." name))
-         nil))))
+   (vc-backend (concat directory "/" name))
    ;; User extension
    (run-hook-with-args 'speedbar-vc-in-control-hook directory name)
    ))