Download
(eval-when-compile
(require 'cl))
(require 'tree-mode)
(require 'windata)
(require 'dired-x)
(defgroup dirtree nil
"Directory tree views"
:group 'tools)
(defcustom dirtree-windata '(frame left 0.3 delete)
"*Arguments to set the window buffer display.
See `windata-display-buffer' for setup the arguments."
:type 'sexp
:group 'dirtree)
(defcustom dirtree-buffer "*dirtree*"
"*Buffer name for `dirtree'"
:type 'string
:group 'dirtree)
(define-widget 'dirtree-dir-widget 'tree-widget
"Directory Tree widget."
:dynargs 'dirtree-expand
:has-children t)
(define-widget 'dirtree-file-widget 'push-button
"File widget."
:format "%[%t%]\n"
:button-face 'default
:notify 'dirtree-select)
(defun dirtree-show ()
"Show `dirtree-buffer'. Create tree when no parent directory find."
(interactive)
(let ((buffer (get-buffer-create dirtree-buffer))
(dir default-directory)
trees tree button path)
(with-current-buffer buffer
(setq trees tree-mode-list)
(while (and trees
(not tree))
(if (string-match (concat "^" (regexp-quote (widget-get (car trees) :file))) dir)
(setq tree (car trees))
(setq trees (cdr trees)))))
(if tree
(progn
(setq path (split-string (file-relative-name buffer-file-name (widget-get tree :file)) "/"))
(dirtree (widget-get tree :file) t)
(setq button (tree-mode-find-node tree path))
(if button
(goto-char (widget-get (car button) :from))))
(call-interactively 'dirtree))))
(defun dirtree (root select)
"create tree of `root' directory
With prefix arguement select `dirtree-buffer'"
(interactive "DDirectory: \nP")
(let ((buffer (get-buffer-create dirtree-buffer))
tree win)
(with-current-buffer buffer
(unless (eq major-mode 'dirtree-mode)
(dirtree-mode))
(dolist (atree tree-mode-list)
(if (string= (widget-get atree :file) root)
(setq tree atree)))
(or tree
(setq tree (tree-mode-insert (dirtree-root-widget root)))))
(setq win (get-buffer-window dirtree-buffer))
(unless win
(setq win (apply 'windata-display-buffer dirtree-buffer dirtree-windata))
(select-window win))
(with-selected-window win
(unless (widget-get tree :open)
(widget-apply-action tree))
(goto-char (widget-get tree :from))
(recenter 1))
(if select
(select-window win))))
(define-derived-mode dirtree-mode tree-mode "Dir-Tree"
"A mode to display tree of directory"
(tree-widget-set-theme "folder"))
(defun dirtree-root-widget (directory)
"create the root directory"
`(dirtree-dir-widget
:node (dirtree-file-widget
:tag ,directory
:file ,directory)
:file ,directory
:open t))
(defun dirtree-expand (tree)
"expand directory"
(or (widget-get tree :args)
(let ((directory (widget-get tree :file))
(re (dired-omit-regexp))
dirs files basename)
(dolist (file (directory-files directory t))
(setq basename (file-name-nondirectory file))
(unless (string-match re basename)
(if (file-directory-p file)
(push (cons file basename) dirs)
(push (cons file basename) files))))
(setq dirs (sort dirs (lambda (a b) (string< (cdr a) (cdr b)))))
(setq files (sort files (lambda (a b) (string< (cdr a) (cdr b)))))
(append
(mapcar (lambda (file)
`(dirtree-dir-widget
:file ,(car file)
:node (dirtree-file-widget
:tag ,(cdr file)
:file ,(car file))))
dirs)
(mapcar (lambda (file)
`(dirtree-file-widget
:file ,(car file)
:tag ,(cdr file)))
files)))))
(defun dirtree-select (node &rest ignore)
"Open file in other window"
(let ((file (widget-get node :file)))
(and file
(find-file-other-window file))))
(defun dirtree-display ()
"Open file under point"
(interactive)
(let ((widget (widget-at (1- (line-end-position))))
file)
(if (setq file (widget-get widget :file))
(find-file-other-window file))))
(define-key dirtree-mode-map "\C-o" 'dirtree-display)
(provide 'dirtree)