]> code.delx.au - gnu-emacs/blobdiff - lisp/speedbar.el
*** empty log message ***
[gnu-emacs] / lisp / speedbar.el
index 9af94658f0b8bca60c26b2880547613ec7d67a62..12d25ed7ee0f1a3b649fff731bf183405e636342 100644 (file)
@@ -1,6 +1,7 @@
 ;;; speedbar.el --- quick access to files and tags in a frame
 
-;;; Copyright (C) 1996, 97, 98, 99, 2000, 01 Free Software Foundation
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 0.11a
@@ -20,8 +21,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 ;;
@@ -92,7 +93,7 @@
 ;; into sub-lists.  A long flat list can be used instead if needed.
 ;; Other filters can be easily added.
 ;;
-;;    AUC-TEX users: The imenu tags for AUC-TEX mode doesn't work very
+;;    AUCTEX users: The imenu tags for AUCTEX mode doesn't work very
 ;; well.  Use the imenu keywords from tex-mode.el for better results.
 ;;
 ;; This file requires the library package assoc (association lists)
 ;; - More functions to create buttons and options
 ;; - Timeout directories we haven't visited in a while.
 
+;;; Code:
+
 (require 'assoc)
 (require 'easymenu)
 
   :prefix "speedbar-"
   :group 'speedbar)
 
-;;; Code:
 (defvar speedbar-initial-expansion-mode-alist
   '(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
      speedbar-buffer-buttons)
@@ -354,7 +356,9 @@ Any parameter supported by a frame may be added.  The parameter `height'
 will be initialized to the height of the frame speedbar is
 attached to and added to this list before the new frame is initialized."
   :group 'speedbar
-  :type '(repeat (sexp :tag "Parameter:")))
+  :type '(repeat (cons :format "%v"
+                      (symbol :tag "Parameter")
+                      (sexp :tag "Value"))))
 
 ;; These values by Hrvoje Niksic <hniksic@srce.hr>
 (defcustom speedbar-frame-plist
@@ -371,7 +375,7 @@ is attached to."
                        (symbol :tag "Property")
                        (sexp :tag "Value"))))
 
-(defcustom speedbar-use-imenu-flag (stringp (locate-library "imenu"))
+(defcustom speedbar-use-imenu-flag (fboundp 'imenu)
   "*Non-nil means use imenu for file parsing.  nil to use etags.
 XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
 use etags instead.  Etags support is not as robust as imenu support."
@@ -665,6 +669,9 @@ useful, such as version control."
   "*Regexp matching files we don't want displayed in a speedbar buffer.
 It is generated from the variable `completion-ignored-extensions'")
 
+;; Compiler silencing trick.  The real defvar comes later in this file.
+(defvar speedbar-file-regexp)
+
 ;; this is dangerous to customize, because the defaults will probably
 ;; change in the future.
 (defcustom speedbar-supported-extension-expressions
@@ -689,8 +696,7 @@ file."
   :type '(repeat (regexp :tag "Extension Regexp"))
   :set (lambda (sym val)
         (setq speedbar-supported-extension-expressions val
-              speedbar-file-regexp (speedbar-extension-list-to-regex val)))
-  )
+              speedbar-file-regexp (speedbar-extension-list-to-regex val))))
 
 (defvar speedbar-file-regexp
   (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
@@ -698,6 +704,15 @@ file."
 Created from `speedbar-supported-extension-expression' with the
 function `speedbar-extension-list-to-regex'")
 
+(defcustom speedbar-scan-subdirs nil
+  "*Non-nil means speedbar will check if subdirs are empty.
+That way you don't have to click on them to find out.  But this
+incurs extra I/O, hence it slows down directory display
+proportionally to the number of subdirs."
+  :group 'speedbar
+  :type 'boolean
+  :version 22.1)
+
 (defun speedbar-add-supported-extension (extension)
   "Add EXTENSION as a new supported extension for speedbar tagging.
 This should start with a `.' if it is not a complete file name, and
@@ -746,11 +761,9 @@ PATH-EXPRESSION to `speedbar-ignored-path-expressions'."
                                  (display-graphic-p)
                                window-system))
   "*Non-nil means to automatically update the display.
-When this is nil then speedbar will not follow the attached frame's path.
-When speedbar is active, use:
-
-\\<speedbar-key-map> `\\[speedbar-toggle-updates]'
-
+When this is nil then speedbar will not follow the attached
+frame's path.  Type \
+\\<speedbar-key-map>\\[speedbar-toggle-updates] in the speedbar \
 to toggle this value.")
 
 (defvar speedbar-syntax-table nil
@@ -932,7 +945,7 @@ This basically creates a sparse keymap, and makes it's parent be
                     (looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))]
     )
   "Additional menu items while in file-mode.")
+
 (defvar speedbar-easymenu-definition-trailer
   (append
    (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
@@ -981,7 +994,7 @@ directories.")
 (if (fboundp 'frame-parameter)
 
     (defalias 'speedbar-frame-parameter 'frame-parameter)
-  
+
   (defun speedbar-frame-parameter (frame parameter)
     "Return FRAME's PARAMETER value."
     (cdr (assoc parameter (frame-parameters frame)))))
@@ -1287,12 +1300,13 @@ in the selected file.
     (toggle-read-only 1)
     (speedbar-set-mode-line-format)
     (if speedbar-xemacsp
-       (set (make-local-variable 'mouse-motion-handler)
-            'speedbar-track-mouse-xemacs)
+       (with-no-warnings
+        (set (make-local-variable 'mouse-motion-handler)
+             'speedbar-track-mouse-xemacs))
       (if speedbar-track-mouse-flag
          (set (make-local-variable 'track-mouse) t))   ;this could be messy.
       (setq auto-show-mode nil))       ;no auto-show for Emacs
-    (run-hooks 'speedbar-mode-hook))
+    (run-mode-hooks 'speedbar-mode-hook))
   (speedbar-update-contents)
   speedbar-buffer)
 
@@ -1328,7 +1342,7 @@ Optional EVENT is currently not used."
     (if (equal (car pos) speedbar-frame)
        (save-excursion
          (save-window-excursion
-           (apply 'set-mouse-position pos)
+           (apply 'set-mouse-position (list (car pos) (cadr pos) (cddr pos)))
            (speedbar-item-info))))))
 
 (defun speedbar-set-mode-line-format ()
@@ -1337,7 +1351,8 @@ 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-frame)
           (or (not speedbar-xemacsp)
-              (specifier-instance has-modeline-p)))
+              (with-no-warnings
+               (specifier-instance has-modeline-p))))
       (save-excursion
        (set-buffer speedbar-buffer)
        (let* ((w (or (speedbar-frame-width) 20))
@@ -1538,9 +1553,7 @@ Must be bound to event E."
     ;; This gets the cursor where the user can see it.
     (if (not (bolp)) (forward-char -1))
     (sit-for 0)
-    (if (< emacs-major-version 20)
-       (mouse-major-mode-menu e)
-      (mouse-major-mode-menu e nil))))
+    (mouse-major-mode-menu e nil)))
 
 (defun speedbar-hack-buffer-menu (e)
   "Control mouse 1 is buffer menu.
@@ -2185,21 +2198,17 @@ the file-system."
   ;; find the directory, either in the cache, or build it.
   (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
       (let ((default-directory directory)
-           (dir (directory-files directory nil))
-           (dirs nil)
-           (files nil))
-       (while dir
-         (if (not
-              (or (string-match speedbar-file-unshown-regexp (car dir))
-                  (string-match speedbar-directory-unshown-regexp (car dir))))
-             (if (file-directory-p (car dir))
-                 (setq dirs (cons (car dir) dirs))
-               (setq files (cons (car dir) files))))
-         (setq dir (cdr dir)))
-       (let ((nl (cons (nreverse dirs) (list (nreverse files)))))
+           (case-fold-search read-file-name-completion-ignore-case)
+           dirs files)
+       (dolist (file (directory-files directory nil))
+         (or (string-match speedbar-file-unshown-regexp file)
+             (string-match speedbar-directory-unshown-regexp file)
+             (if (file-directory-p file)
+                 (setq dirs (cons file dirs))
+               (setq files (cons file files)))))
+       (let ((nl `(,(nreverse dirs) ,(nreverse files))))
          (aput 'speedbar-directory-contents-alist directory nl)
-         nl))
-      ))
+         nl))))
 
 (defun speedbar-directory-buttons (directory index)
   "Insert a single button group at point for DIRECTORY.
@@ -2325,7 +2334,7 @@ position to insert a new item, and that the new item will end with a CR."
                            (if tag-button-function 'speedbar-highlight-face nil)
                            tag-button-function tag-button-data))
     ))
-  
+
 (defun speedbar-change-expand-button-char (char)
   "Change the expansion button character to CHAR for the current line."
   (save-excursion
@@ -2343,34 +2352,40 @@ position to insert a new item, and that the new item will end with a CR."
 \f
 ;;; Build button lists
 ;;
-(defun speedbar-insert-files-at-point (files level)
+(defun speedbar-insert-files-at-point (files level directory)
   "Insert list of FILES starting at point, and indenting all files to LEVEL.
 Tag expandable items with a +, otherwise a ?.  Don't highlight ? as we
 don't know how to manage them.  The input parameter FILES is a cons
 cell of the form ( 'DIRLIST .  'FILELIST )."
   ;; Start inserting all the directories
-  (let ((dirs (car files)))
-    (while dirs
-      (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
-                             (car dirs) 'speedbar-dir-follow nil
-                             'speedbar-directory-face level)
-      (setq dirs (cdr dirs))))
-  (let ((lst (car (cdr files)))
-       (case-fold-search t))
-    (while lst
-      (let* ((known (string-match speedbar-file-regexp (car lst)))
+  (dolist (dir (car files))
+    (if (if speedbar-scan-subdirs
+           (condition-case nil
+               (let ((l (speedbar-file-lists (concat directory dir))))
+                 (or (car l) (cadr l)))
+             (file-error))
+         (file-readable-p (concat directory dir)))
+       (speedbar-make-tag-line 'angle ?+ 'speedbar-dired dir
+                               dir 'speedbar-dir-follow nil
+                               'speedbar-directory-face level)
+      (speedbar-make-tag-line 'angle ?  nil dir
+                             dir 'speedbar-dir-follow nil
+                             'speedbar-directory-face level)))
+  (let ((case-fold-search read-file-name-completion-ignore-case))
+    (dolist (file (cadr files))
+      (let* ((known (and (file-readable-p (concat directory file))
+                        (string-match speedbar-file-regexp file)))
             (expchar (if known ?+ ??))
             (fn (if known 'speedbar-tag-file nil)))
        (if (or speedbar-show-unknown-files (/= expchar ??))
-           (speedbar-make-tag-line 'bracket expchar fn (car lst)
-                                   (car lst) 'speedbar-find-file nil
-                                   'speedbar-file-face level)))
-      (setq lst (cdr lst)))))
+           (speedbar-make-tag-line 'bracket expchar fn file
+                                   file 'speedbar-find-file nil
+                                   'speedbar-file-face level))))))
 
 (defun speedbar-default-directory-list (directory index)
   "Insert files for DIRECTORY with level INDEX at point."
   (speedbar-insert-files-at-point
-   (speedbar-file-lists directory) index)
+   (speedbar-file-lists directory) index directory)
   (speedbar-reset-scanners)
   (if (= index 0)
       ;; If the shown files variable has extra directories, then
@@ -2639,7 +2654,7 @@ name will have the function FIND-FUN and not token."
   (speedbar-insert-generic-list indent lst
                                'speedbar-tag-expand
                                'speedbar-tag-find))
-                               
+
 (defun speedbar-insert-etags-list (indent lst)
   "At level INDENT, insert the etags generated LST."
   (speedbar-insert-generic-list indent lst
@@ -2918,7 +2933,7 @@ updated."
         (newcf (if newcfd newcfd))
         (lastb (current-buffer))
         (sucf-recursive (boundp 'sucf-recursive))
-        (case-fold-search t))
+        (case-fold-search read-file-name-completion-ignore-case))
     (if (and newcf
             ;; check here, that way we won't refresh to newcf until
             ;; its been written, thus saving ourselves some time
@@ -3343,7 +3358,7 @@ directory with these items.  This function is replaceable in
 `speedbar-mode-functions-list' as `speedbar-line-path'."
   (let ((rf (speedbar-fetch-replacement-function 'speedbar-line-path)))
     (if rf (funcall rf depth) default-directory)))
-      
+
 (defun speedbar-files-line-path (&optional depth)
   "Retrieve the pathname associated with the current line.
 This may require traversing backwards from DEPTH and combining the default
@@ -3410,7 +3425,9 @@ directory with these items."
        (if (re-search-forward "[]>?}] [^ ]"
                               (save-excursion (end-of-line) (point))
                               t)
-           (speedbar-do-function-pointer)
+           (progn
+             (forward-char -1)
+             (speedbar-do-function-pointer))
          nil))
       (speedbar-do-function-pointer)))
 
@@ -3427,12 +3444,12 @@ With universal argument ARG, flush cached data."
          (forward-char -2)
          (speedbar-do-function-pointer))
       (error (speedbar-position-cursor-on-line)))))
-  
+
 (defun speedbar-flush-expand-line ()
   "Expand the line under the cursor and flush any cached information."
   (interactive)
   (speedbar-expand-line 1))
-  
+
 (defun speedbar-contract-line ()
   "Contract the line under the cursor."
   (interactive)
@@ -3732,7 +3749,7 @@ functions to do caching and flushing if appropriate."
 
     nil
 
-(eval-when-compile (if (locate-library "imenu") (require 'imenu)))
+(eval-when-compile (condition-case nil (require 'imenu) (error nil)))
 
 (defun speedbar-fetch-dynamic-imenu (file)
   "Load FILE into a buffer, and generate tags using Imenu.
@@ -4194,7 +4211,7 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
     (defalias 'defimage-speedbar 'defimage)
 
   (if (not (fboundp 'make-glyph))
-      
+
 (defmacro defimage-speedbar (variable imagespec docstring)
   "Don't bother loading up an image...
 Argument VARIABLE is the variable to define.
@@ -4233,9 +4250,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
           (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
          'buffer)
        (error nil))
-     ,docstring))
-
-)))
+     ,docstring)))))
 
 (defimage-speedbar speedbar-directory-plus
   ((:type xpm :file "sb-dir-plus.xpm" :ascent center))
@@ -4245,6 +4260,10 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
   ((:type xpm :file "sb-dir-minus.xpm" :ascent center))
   "Image used for open directories with stuff in them.")
 
+(defimage-speedbar speedbar-directory
+  ((:type xpm :file "sb-dir.xpm" :ascent center))
+  "Image used for empty or unreadable directories.")
+
 (defimage-speedbar speedbar-page-plus
   ((:type xpm :file "sb-pg-plus.xpm" :ascent center))
   "Image used for closed files with stuff in them.")
@@ -4288,6 +4307,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
 (defvar speedbar-expand-image-button-alist
   '(("<+>" . speedbar-directory-plus)
     ("<->" . speedbar-directory-minus)
+    ("< >" . speedbar-directory)
     ("[+]" . speedbar-page-plus)
     ("[-]" . speedbar-page-minus)
     ("[?]" . speedbar-page)
@@ -4339,4 +4359,5 @@ If we have an image associated with it, use that image."
 ;; run load-time hooks
 (run-hooks 'speedbar-load-hook)
 
+;; arch-tag: 4477e6d1-f78c-48b9-a503-387d3c9767d5
 ;;; speedbar.el ends here