comparison lisp/speedbar.el @ 56647:d21a8e697065

(speedbar-scan-subdirs): New option. (speedbar-file-lists): Don't ignore file-name case on Unix and use dolist. (speedbar-insert-files-at-point): Take an extra argument and use it to optionally find out if a subdir is empty. Also unreadable files don't get expand buttons. (speedbar-directory-plus): New image (bitmap already existed unused). (speedbar-expand-image-button-alist): Use it.

56646:b7446b6f097d

  :group 'speedbar
  :version "21.1"
  :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)))
  )

(defvar speedbar-file-regexp
  (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
  "Regular expression matching files we know how to expand.
Created from `speedbar-supported-extension-expression' with the

  (if speedbar-power-click
      (adelete 'speedbar-directory-contents-alist directory))
  ;; 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)))))
	  (aput 'speedbar-directory-contents-alist directory nl)
	  nl))
      ))

(defun speedbar-directory-buttons (directory index)
  "Insert a single button group at point for DIRECTORY.
Each directory path part is a different button.  If part of the path
matches the user directory ~, then it is replaced with a ~.

	  (speedbar-insert-image-button-maybe (- (point) 2) 3)))))


;;; Build button lists
;;
(defun speedbar-insert-files-at-point (files level)
  "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)))
	     (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)))))

(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-reset-scanners)
  (if (= index 0)
      ;; If the shown files variable has extra directories, then
      ;; it is our responsibility to redraw them all
      ;; Luckilly, the nature of inserting items into this list means

		     (select-frame lastf)
		     rf)))
	 (newcf (if newcfd newcfd))
	 (lastb (current-buffer))
	 (sucf-recursive (boundp 'sucf-recursive))
	 (case-fold-search t))
    (if (and newcf
	     ;; check here, that way we won't refresh to newcf until
	     ;; its been written, thus saving ourselves some time
	     (file-exists-p newcf)
	     (not (string= newcf speedbar-last-selected-file)))

	 (make-glyph
	  (make-image-specifier
	   (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
	  'buffer)
       (error nil))
     ,docstring))

)))

(defimage-speedbar speedbar-directory-plus
  ((:type xpm :file "sb-dir-plus.xpm" :ascent center))
  "Image used for closed directories with stuff in them.")

(defimage-speedbar speedbar-directory-minus
  ((:type xpm :file "sb-dir-minus.xpm" :ascent center))
  "Image used for open directories with stuff in them.")

(defimage-speedbar speedbar-page-plus
  ((:type xpm :file "sb-pg-plus.xpm" :ascent center))
  "Image used for closed files with stuff in them.")

(defimage-speedbar speedbar-page-minus

  "Image used for open tag groups.")

(defvar speedbar-expand-image-button-alist
  '(("<+>" . speedbar-directory-plus)
    ("<->" . speedbar-directory-minus)
    ("[+]" . speedbar-page-plus)
    ("[-]" . speedbar-page-minus)
    ("[?]" . speedbar-page)
    ("{+}" . speedbar-tag-plus)
    ("{-}" . speedbar-tag-minus)

56647:d21a8e697065

  :group 'speedbar
  :version "21.1"
  :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))))

(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 21.4)

(defvar speedbar-file-regexp
  (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
  "Regular expression matching files we know how to expand.
Created from `speedbar-supported-extension-expression' with the

  (if speedbar-power-click
      (adelete 'speedbar-directory-contents-alist directory))
  ;; find the directory, either in the cache, or build it.
  (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
      (let ((default-directory directory)
	    (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))))

(defun speedbar-directory-buttons (directory index)
  "Insert a single button group at point for DIRECTORY.
Each directory path part is a different button.  If part of the path
matches the user directory ~, then it is replaced with a ~.

	  (speedbar-insert-image-button-maybe (- (point) 2) 3)))))


;;; Build button lists
;;
(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
  (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 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 directory)
  (speedbar-reset-scanners)
  (if (= index 0)
      ;; If the shown files variable has extra directories, then
      ;; it is our responsibility to redraw them all
      ;; Luckilly, the nature of inserting items into this list means

		     (select-frame lastf)
		     rf)))
	 (newcf (if newcfd newcfd))
	 (lastb (current-buffer))
	 (sucf-recursive (boundp 'sucf-recursive))
	 (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
	     (file-exists-p newcf)
	     (not (string= newcf speedbar-last-selected-file)))

	 (make-glyph
	  (make-image-specifier
	   (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
	  'buffer)
       (error nil))
     ,docstring)))))

(defimage-speedbar speedbar-directory-plus
  ((:type xpm :file "sb-dir-plus.xpm" :ascent center))
  "Image used for closed directories with stuff in them.")

(defimage-speedbar speedbar-directory-minus
  ((: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.")

(defimage-speedbar speedbar-page-minus

  "Image used for open tag groups.")

(defvar speedbar-expand-image-button-alist
  '(("<+>" . speedbar-directory-plus)
    ("<->" . speedbar-directory-minus)
    ("< >" . speedbar-directory)
    ("[+]" . speedbar-page-plus)
    ("[-]" . speedbar-page-minus)
    ("[?]" . speedbar-page)
    ("{+}" . speedbar-tag-plus)
    ("{-}" . speedbar-tag-minus)