This is a working concept draft that presently only supports all files/directories being displayed in the directory tree. To add support for hiding files/directories, the increment calculations would need to be adjusted so that the hash-tables get modified accordingly. It is possible to obviate the need for hash-tables by examining text-properties on various lines of the buffer, however, this answer contemplates using the former method. This answer reassigns the keyboard shortcuts for M and U -- anyone who is interested in tinkering with this draft can restore the original bindings and choose new bindings for speedbar-mark-all and speedbar-unmark-all.
Inasmuch as this author uses a custom version of speedbar that eliminates dframe library usage, this is probably about as far as this author will be taking this particular working concept draft. Anyone who is interested in taking this draft to the next level of functionality is encouraged to do so by creating an alternative answer so everyone else can benefit from those improvements.
PART 1 OF 2 -- about 30,000 characters:
(require 'speedbar)
(require 'dired-aux)
(setq speedbar-directory-unshown-regexp "^$") ;; show everything
(setq speedbar-show-unknown-files t)
(setq speedbar-initial-expansion-mode-alist '(
("buffers"
speedbar-buffer-easymenu-definition
speedbar-buffers-key-map
speedbar-buffer-buttons)
("quick buffers"
speedbar-buffer-easymenu-definition
speedbar-buffers-key-map
speedbar-buffer-buttons-temp)
("files"
;; removed `speedbar-directory-buttons' from the files alist; and,
;; incorporated certain portions into `speedbar-default-directory-list'.
speedbar-easymenu-definition-special
speedbar-file-key-map
speedbar-default-directory-list)))
(define-key speedbar-file-key-map "c" 'dired-do-copy)
(define-key speedbar-file-key-map "C" 'speedbar-item-copy)
(define-key speedbar-file-key-map "d" 'speedbar-delete-file)
(define-key speedbar-file-key-map "D" 'speedbar-item-delete)
(define-key speedbar-file-key-map "m" 'speedbar-mark)
(define-key speedbar-file-key-map "M" 'speedbar-mark-all)
;; (define-key speedbar-file-key-map "M" 'speedbar-create-directory)
(define-key speedbar-file-key-map "p" 'speedbar-path)
(define-key speedbar-file-key-map "r" 'dired-do-rename)
(define-key speedbar-file-key-map "R" 'speedbar-item-rename)
(define-key speedbar-file-key-map "u" 'speedbar-unmark)
(define-key speedbar-file-key-map "U" 'speedbar-unmark-all)
;; (define-key speedbar-file-key-map "U" 'speedbar-up-directory)
(define-key speedbar-file-key-map [up] 'speedbar-previous-line)
(define-key speedbar-file-key-map [down] 'speedbar-next-line)
(define-key speedbar-file-key-map [C-up] 'speedbar-up-directory)
(defvar speedbar-line-to-node-table nil
"Hash table used to find absolute filename based on line number.")
(defvar speedbar-node-to-line-table nil
"Hash table used to find line number based on absolute filename.")
(defvar speedbar-node-regexp
"^\\([0-9]+:\\s-*[[<{][+-\?][]>}]\s\\)\\(.*\\)$"
"A regexp where the second group is the filename or directory.")
(defun speedbar-node-of-line (line)
"Find absolute filename based on line number."
(gethash line speedbar-line-to-node-table))
(defun speedbar-line-of-node (node)
"Find line number based on absolute filename."
(gethash node speedbar-node-to-line-table))
(defface speedbar-marked-face
'((t (:background "purple" :foreground "green")))
"Face for `speedbar-marked-face'."
:group 'speedbar)
(defun speedbar-cursor-align ()
(unless (= (point-at-bol) (point-min))
(goto-char (point-at-bol))
(re-search-forward
"^\\([0-9]+\\):\\s-*[[<{][+-\?][]>}]\s\\|^[0-9:\s>]+"
(point-at-eol) t)))
(defun speedbar-next-line ()
(interactive "^")
(let ((inhibit-point-motion-hooks t))
(next-line 1)
(speedbar-cursor-align)))
(defun speedbar-previous-line ()
(interactive "^")
(let ((inhibit-point-motion-hooks t))
(unless (= (line-number-at-pos) 1)
(previous-line 1)
(speedbar-cursor-align))))
(defun speedbar-path ()
(interactive)
(let ((path (speedbar-node-of-line (line-number-at-pos))))
(when path
(kill-new path)
(message "%s" path))))
(defun speedbar-mark (&optional absolute-filename)
(interactive)
(if
(and
(region-active-p)
(null absolute-filename))
(speedbar-mark-all)
(let* (
beg
end
(current-node (speedbar-node-of-line (line-number-at-pos)))
(line-of-absolute-filename
(when absolute-filename
(speedbar-line-of-node absolute-filename))) )
(unless (equal current-node default-directory)
(save-excursion
(when
(and
absolute-filename
line-of-absolute-filename
(not (equal current-node absolute-filename)))
(goto-line line-of-absolute-filename))
(unless (eq (point) (point-at-eol))
(goto-char (point-at-eol)))
(when (looking-back speedbar-node-regexp)
(setq beg (match-beginning 2))
(setq end (point-at-eol))
(unless (memq 'speedbar-marked-face
(mapcar (function (lambda (ovr)
(overlay-get ovr 'face))) (overlays-in beg end)))
(overlay-put (make-overlay beg end)
'face 'speedbar-marked-face))))))))
(defun speedbar-unmark ()
(interactive)
(let* (
(beg (point-at-bol))
(end (point-at-eol))
(current-node (speedbar-node-of-line (line-number-at-pos))) )
(unless (equal current-node default-directory)
(save-excursion
(unless (eq (point) end)
(goto-char end))
(re-search-backward speedbar-node-regexp beg t)
(setq beg (point)))
(remove-overlays beg end 'face 'speedbar-marked-face))))
(defun speedbar-mark-all ()
(interactive)
(let* (
(opoint (point))
(current-node (speedbar-node-of-line (line-number-at-pos)))
(speedbar-active-region (region-active-p))
(region-beg (when speedbar-active-region (region-beginning)))
(region-end (when speedbar-active-region (region-end))) )
(save-excursion
(catch 'done
(if speedbar-active-region
(goto-char region-end)
(goto-char (point-max)))
(while t
(setq current-node (speedbar-node-of-line (line-number-at-pos)))
(speedbar-mark current-node)
(re-search-backward "\n" nil t)
(when
(or
(and speedbar-active-region (<= (point) region-beg))
(equal current-node default-directory))
(throw 'done nil))))))
(setq mark-active nil))
(defun speedbar-unmark-all ()
(interactive)
(remove-overlays nil nil))
(defun speedbar-get-marked-files ()
(let* (
beg
end
current-node
marked-list
(point-min (point-min)) )
(save-excursion
(goto-char (point-max))
(catch 'done
(while t
(setq end (point-at-eol))
(setq current-node (speedbar-node-of-line (line-number-at-pos)))
(unless (eq (point) end)
(goto-char end))
(when (looking-back speedbar-node-regexp)
(setq beg (match-beginning 2))
(when
(memq 'speedbar-marked-face
(mapcar (function (lambda (ovr)
(overlay-get ovr 'face))) (overlays-in beg end)))
(push current-node marked-list)))
(when (equal current-node default-directory)
(throw 'done nil))
(re-search-backward "\n" point-min t))))
(when
(and
(not (eq this-command 'speedbar-refresh))
(null marked-list))
(push (speedbar-node-of-line (line-number-at-pos)) marked-list)
(delete-dups (delq nil marked-list)))
marked-list))
(defun speedbar-delete-file (&optional file recursive trash)
(interactive)
(let* (
(trashing t)
(trash (if trash trash t))
(recursive (if recursive recursive 'always))
(files (if file file (speedbar-get-marked-files)))
(arg (length files)) )
(when
(dired-mark-pop-up ;; returns t if yes or nil if no.
" *Deletions*" 'delete files dired-deletion-confirmer
(format "%s %s "
(if trashing "Trash" "Delete")
(dired-mark-prompt arg files)))
(if (listp files)
(mapcar
(lambda (x)
(dired-delete-file x recursive trash))
files)
(dired-delete-file files recursive trash))
(speedbar-refresh) )))
(defun speedbar-insert-generic-list (level lst expand-fun find-fun)
"At LEVEL, insert a generic multi-level alist LST.
Associations with lists get {+} tags (to expand into more nodes) and
those with positions just get a > as the indicator. {+} buttons will
have the function EXPAND-FUN and the token is the cdr list. The token
name will have the function FIND-FUN and not token."
;; Remove imenu rescan button
(when (string= (car (car lst)) "*Rescan*")
(setq lst (cdr lst)))
;; Get, and set up variables that define how we treat these tags.
(let* (
expand-button
tag-button
(f
(save-excursion
(forward-line -1)
(or
(speedbar-line-file)
(speedbar-line-directory)))) )
(save-excursion
(when (get-file-buffer f)
(set-buffer (get-file-buffer f)))
(setq expand-button speedbar-generic-list-group-expand-button-type
tag-button speedbar-generic-list-tag-button-type))
;; Adjust the list.
(setq lst (speedbar-create-tag-hierarchy lst))
(let* (
(current-line (1- (line-number-at-pos)))
(increment (length lst))
(copied-line-to-node-table
(copy-hash-table speedbar-line-to-node-table))
(copied-node-to-line-table
(copy-hash-table speedbar-node-to-line-table)) )
(maphash
(lambda (line filename)
(when (> line current-line)
(puthash (+ line increment) filename speedbar-line-to-node-table)))
copied-line-to-node-table)
(maphash
(lambda (filename line)
(when (> line current-line)
(puthash filename (+ line increment) speedbar-node-to-line-table)))
copied-node-to-line-table))
;; insert the parts
(while lst
(cond ((null (car-safe lst)) nil) ;this would be a separator
((speedbar-generic-list-tag-p (car lst))
(speedbar-make-tag-line tag-button
nil nil nil ;no expand button data
(car (car lst)) ;button name
find-fun ;function
(cdr (car lst)) ;token is position
'speedbar-tag-face
(1+ level)))
((speedbar-generic-list-positioned-group-p (car lst))
(speedbar-make-tag-line expand-button
?+ expand-fun (cdr (cdr (car lst)))
(car (car lst)) ;button name
find-fun ;function
(car (cdr (car lst))) ;token is posn
'speedbar-tag-face
(1+ level)))
((speedbar-generic-list-group-p (car lst))
(speedbar-make-tag-line expand-button
?+ expand-fun (cdr (car lst))
(car (car lst)) ;button name
nil nil 'speedbar-tag-face
(1+ level)))
(t (message "speedbar-insert-generic-list: malformed list!")))
(setq lst (cdr lst)))))
(defun speedbar-delete-subblock (indent)
"Delete text from point to indentation level INDENT or greater.
Handles end-of-sublist smartly."
(speedbar-with-writable
(let* (
start
end-line
increment
copied-line-to-node-table
copied-node-to-line-table
(beg-line (line-number-at-pos)))
(save-excursion
(end-of-line)
(forward-char 1)
(setq start (point))
(while
(and
(looking-at "^\\([0-9]+\\):")
(> (string-to-number (match-string 1)) indent)
(not (eobp)))
(setq end-line (line-number-at-pos))
(remhash end-line speedbar-line-to-node-table)
(remhash (speedbar-node-of-line end-line) speedbar-node-to-line-table)
(forward-line 1)
(unless (eobp)
(beginning-of-line)))
(setq increment (- end-line beg-line))
(setq copied-line-to-node-table
(copy-hash-table speedbar-line-to-node-table))
(setq copied-node-to-line-table
(copy-hash-table speedbar-node-to-line-table))
(delete-region start (point))
(maphash
(lambda (line filename)
(when (> line beg-line)
(puthash (- line increment) filename speedbar-line-to-node-table)
(remhash line speedbar-line-to-node-table)))
copied-line-to-node-table)
(maphash
(lambda (filename line)
(when (> line beg-line)
(puthash filename (- line increment) speedbar-node-to-line-table)
(remhash filename speedbar-node-to-line-table)))
copied-node-to-line-table)))))
(defun speedbar-default-directory-list (directory index)
"Insert files for DIRECTORY with level INDEX at point.
This function is used by `speedbar-update-directory-contents' and `speedbar-dired'."
;; previously a separate function -- `speedbar-insert-files-at-point'.
(let* (
(files (speedbar-file-lists directory))
(dirs (car files))
(lst (car (cdr files))) )
(cond
((= (buffer-size) 0)
(setq default-directory directory)
(setq speedbar-line-to-node-table (make-hash-table))
(setq speedbar-node-to-line-table (make-hash-table :test 'equal))
(puthash 1 directory speedbar-line-to-node-table)
(puthash directory 1 speedbar-node-to-line-table)
(let (
path
(displayme (expand-file-name directory))
(p (point)) )
(insert displayme "\n")
(save-excursion
(goto-char p)
(speedbar-make-button p (1+ p)
'speedbar-directory-face
'speedbar-highlight-face
'speedbar-directory-buttons-follow "/")
(put-text-property p (1+ p) 'help-echo "\"/\"")
(while (re-search-forward "\\([^/\\]+\\)[/\\]" nil t)
(setq path
(if
(and
(= (match-beginning 1) p)
(not (char-equal (char-after (+ p 1)) ?:)))
(expand-file-name "~/") ;the tilde
(buffer-substring-no-properties p (match-end 0))))
(speedbar-make-button (match-beginning 1) (match-end 1)
'speedbar-directory-face
'speedbar-highlight-face
'speedbar-directory-buttons-follow path)
(put-text-property (match-beginning 1) (match-end 1)
'help-echo path)))))
(t
(let* (
(current-line (1- (line-number-at-pos)))
(increment (+ (length dirs) (length lst)))
(copied-line-to-node-table
(copy-hash-table speedbar-line-to-node-table))
(copied-node-to-line-table
(copy-hash-table speedbar-node-to-line-table)) )
(maphash
(lambda (line filename)
(when (> line current-line)
(puthash (+ line increment) filename speedbar-line-to-node-table)))
copied-line-to-node-table)
(maphash
(lambda (filename line)
(when (> line current-line)
(puthash filename (+ line increment) speedbar-node-to-line-table)))
copied-node-to-line-table))))
(while dirs
(puthash (line-number-at-pos (point))
(expand-file-name (car dirs)) speedbar-line-to-node-table)
(puthash (expand-file-name (car dirs)) (line-number-at-pos (point))
speedbar-node-to-line-table)
(speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
(car dirs) 'speedbar-dir-follow nil 'speedbar-directory-face index)
(setq dirs (cdr dirs)))
(let ((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)) )
(when (or speedbar-show-unknown-files (/= expchar ??))
(puthash (line-number-at-pos (point))
(expand-file-name (car lst)) speedbar-line-to-node-table)
(puthash (expand-file-name (car lst))
(line-number-at-pos (point)) speedbar-node-to-line-table)
(speedbar-make-tag-line 'bracket expchar fn (car lst)
(car lst) 'speedbar-find-file nil 'speedbar-file-face index)))
(setq lst (cdr lst)))))
(speedbar-reset-scanners)
(if (= index 0)
(let ((sf (cdr (reverse speedbar-shown-directories))))
(setq speedbar-shown-directories
(list (expand-file-name default-directory)))
;; Expand them all as we find them.
(while sf
(if (speedbar-goto-this-file (car sf))
(progn
(beginning-of-line)
(if (looking-at "[0-9]+:[ ]*<")
(progn
(goto-char (match-end 0))
(speedbar-do-function-pointer)))))
(setq sf (cdr sf))))))
(defun speedbar-update-directory-contents ()
"Update the contents of the speedbar buffer based on the current directory."
(let* (
(cbd (expand-file-name default-directory))
cbd-parent
(funclst (speedbar-initial-expansion-list))
(cache speedbar-full-text-cache)
;; disable stealth during update
;; (speedbar-stealthy-function-list nil)
(use-cache nil)
(expand-local nil)
;; Because there is a bug I can't find just yet
(inhibit-quit nil) )
(set-buffer speedbar-buffer)
;; If we are updating contents to where we are, then this is
;; really a request to update existing contents, so we must be
;; careful with our text cache!
(if (member cbd speedbar-shown-directories)
(progn
(setq cache nil)
;; If the current directory is not the last element in the dir
;; list, then we ALSO need to zap the list of expanded directories
(if (/= (length (member cbd speedbar-shown-directories)) 1)
(setq speedbar-shown-directories (list cbd))))
;; Build cbd-parent, and see if THAT is in the current shown
;; directories. First, go through pains to get the parent directory
(if (and speedbar-smart-directory-expand-flag
(save-match-data
(setq cbd-parent cbd)
(if (string-match "[/\\]$" cbd-parent)
(setq cbd-parent (substring cbd-parent 0
(match-beginning 0))))
(setq cbd-parent (file-name-directory cbd-parent)))
(member cbd-parent speedbar-shown-directories))
(setq expand-local t)
;; If this directory is NOT in the current list of available
;; directories, then use the cache, and set the cache to our new
;; value. Make sure to unhighlight the current file, or if we
;; come back to this directory, it might be a different file
;; and then we get a mess!
(if (> (point-max) 1)
(progn
(speedbar-clear-current-file)
(setq speedbar-full-text-cache (cons speedbar-shown-directories (buffer-string)))))
;; Check if our new directory is in the list of directories
;; shown in the text-cache
(if (member cbd (car cache))
(setq speedbar-shown-directories (car cache)
use-cache t)
;; default the shown directories to this list...
(setq speedbar-shown-directories (list cbd)))))
(if (not expand-local) (setq speedbar-last-selected-file nil))
(speedbar-with-writable
(if (and expand-local
;; Find this directory as a speedbar node.
(speedbar-directory-line cbd))
;; Open it.
(speedbar-expand-line)
(let* ((window (get-buffer-window speedbar-buffer 0))
(p (window-point window))
(start (window-start window)))
(erase-buffer)
(remove-overlays)
(cond
(use-cache
(setq default-directory
(nth (1- (length speedbar-shown-directories))
speedbar-shown-directories))
(insert (cdr cache)))
(t
(dolist (func funclst)
;; func = `speedbar-default-directory-list' ******
(funcall func cbd 0))))
(goto-char (point-min))
(set-window-point window p)
(set-window-start window start)
(speedbar-reconfigure-keymaps)
(when (not speedbar-stealthy-update-recurse)
(let* (
(l (speedbar-initial-stealthy-functions))
(speedbar-stealthy-update-recurse t))
(unwind-protect
(while (and l (funcall (car l)))
(setq l (cdr l))) ))))))))
