;;; dired-subtree.el --- Insert subdirectories in a tree-like fashion

;; Copyright (C) 2014-2015 Matúš Goljer

;; Author: Matúš Goljer <matus.goljer@gmail.com>

;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>

;; Keywords: files

;; Version: 0.0.1

;; Created: 25th February 2014

;; Package-requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1"))

;; This program 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 3 of the License, or

;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,

;; but WITHOUT ANY WARRANTY; without even the implied warranty of

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License

;; along with this program. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Introduction

;; ------------

;; The basic command to work with subdirectories in dired is `i',

;; which inserts the subdirectory as a separate listing in the active

;; dired buffer.

;; This package defines function `dired-subtree-insert' which instead

;; inserts the subdirectory directly below its line in the original

;; listing, and indent the listing of subdirectory to resemble a

;; tree-like structure (somewhat similar to tree(1) except the pretty

;; graphics). The tree display is somewhat more intuitive than the

;; default "flat" subdirectory manipulation provided by `i'.

;; There are several presentation options and faces you can customize

;; to change the way subtrees are displayed.

;; You can further remove the unwanted lines from the subtree by using

;; `k' command or some of the built-in "focusing" functions, such as

;; `dired-subtree-only-*' (see list below).

;; If you have the package `dired-filter', you can additionally filter

;; the subtrees with global or local filters.

;; A demo of basic functionality is available on youtube:

;; https://www.youtube.com/watch?v=z26b8HKFsNE

;; Interactive functions

;; ---------------------

;; Here's a list of available interactive functions. You can read

;; more about each one by using the built-in documentation facilities

;; of emacs. It is adviced to place bindings for these into a

;; convenient prefix key map, for example C-,

;; * `dired-subtree-insert'

;; * `dired-subtree-remove'

;; * `dired-subtree-toggle'

;; * `dired-subtree-cycle'

;; * `dired-subtree-revert'

;; * `dired-subtree-narrow'

;; * `dired-subtree-up'

;; * `dired-subtree-down'

;; * `dired-subtree-next-sibling'

;; * `dired-subtree-previous-sibling'

;; * `dired-subtree-beginning'

;; * `dired-subtree-end'

;; * `dired-subtree-mark-subtree'

;; * `dired-subtree-unmark-subtree'

;; * `dired-subtree-only-this-file'

;; * `dired-subtree-only-this-directory'

;; If you have package `dired-filter', additional command

;; `dired-subtree-apply-filter' is available.

;; See https://github.com/Fuco1/dired-hacks for the entire collection.

;;; Code:

(require 'dired-hacks-utils)

(require 'dash)

(require 'cl-lib)

(defgroup dired-subtree ()

"Insert subdirectories in a tree-like fashion."

:group 'dired-hacks

:prefix "dired-subtree-")

(defcustom dired-subtree-line-prefix " "

"A prefix put into each nested subtree.

The prefix is repeated \"depth\" times.

Alternatively, it can be a function taking one argument---the

depth---that creates the prefix."

:type '(choice string function)

:group 'dired-subtree)

(defcustom dired-subtree-line-prefix-face 'parents

"Specifies how the prefix is fontified."

:type '(radio

(const :tag "No face applied" nil)

(const :tag "Inherit from current subtree" subtree)

(const :tag "Inherit from all parents" parents))

:group 'dired-subtree)

(defcustom dired-subtree-use-backgrounds t

"When non-nil, add a background face to a subtree listing."

:type 'boolean

:group 'dired-subtree)

(defcustom dired-subtree-after-insert-hook ()

"Hook run at the end of `dired-subtree-insert'."

:type 'hook

:group 'dired-subtree)

(defcustom dired-subtree-after-remove-hook ()

"Hook run at the end of `dired-subtree-remove'."

:type 'hook

:group 'dired-subtree)

(defcustom dired-subtree-cycle-depth 3

"Default depth expanded by `dired-subtree-cycle'."

:type 'integer

:group 'dired-subtree)

(defcustom dired-subtree-ignored-regexp

(concat "^" (regexp-opt vc-directory-exclusion-list) "$")

"Matching directories will not be expanded in `dired-subtree-cycle'."

:type 'string

:group 'dired-subtree)

(defgroup dired-subtree-faces ()

"Faces used in `dired-subtree'."

:group 'dired-subtree)

(defface dired-subtree-depth-1-face

'((t (:background "#252e30")))

"Background for depth 1 subtrees"

:group 'dired-subtree-faces)

(defface dired-subtree-depth-2-face

'((t (:background "#232a2b")))

"Background for depth 2 subtrees"

:group 'dired-subtree-faces)

(defface dired-subtree-depth-3-face

'((t (:background "#212627")))

"Background for depth 3 subtrees"

:group 'dired-subtree-faces)

(defface dired-subtree-depth-4-face

'((t (:background "#1e2223")))

"Background for depth 4 subtrees"

:group 'dired-subtree-faces)

(defface dired-subtree-depth-5-face

'((t (:background "#1c1d1e")))

"Background for depth 5 subtrees"

:group 'dired-subtree-faces)

(defface dired-subtree-depth-6-face

'((t (:background "#1a191a")))

"Background for depth 6 subtrees"

:group 'dired-subtree-faces)

(defvar dired-subtree-overlays nil

"Subtree overlays in this buffer.")

(make-variable-buffer-local 'dired-subtree-overlays)



;;; Overlay manipulation

;; Maybe we should abstract the overlay-foo into some subtree

;; functions instead!!!

(defun dired-subtree--remove-overlay (ov)

"Remove dired-subtree overlay OV."

(setq dired-subtree-overlays

(--remove (equal it ov) dired-subtree-overlays))

(delete-overlay ov))

(defun dired-subtree--remove-overlays (ovs)

"Remove dired-subtree overlays OVS."

(mapc 'dired-subtree--remove-overlay ovs))

(defun dired-subtree--cleanup-overlays ()

"Remove the `nil' values from `dired-subtree-overlays'."

(setq dired-subtree-overlays

(--remove (not (overlay-buffer it)) dired-subtree-overlays)))

(defun dired-subtree--get-all-ovs ()

"Get all dired-subtree overlays in this buffer."

(--filter (overlay-get it 'dired-subtree-depth) (overlays-in (point-min) (point-max))))

(defun dired-subtree--get-all-ovs-at-point (&optional p)

"Get all dired-subtree overlays at point P."

(setq p (or p (point)))

(--filter (overlay-get it 'dired-subtree-depth) (overlays-at (point))))

(defun dired-subtree--get-ovs-in (&optional beg end)

"Get all dired-subtree overlays between BEG and END.

BEG and END default to the region spanned by overlay at point."

(when (not beg)

(let ((ov (dired-subtree--get-ov)))

(setq beg (overlay-start ov))

(setq end (overlay-end ov))))

(--filter (and (overlay-get it 'dired-subtree-depth)

(>= (overlay-start it) beg)

(<= (overlay-end it) end))

(overlays-in (point-min) (point-max))))

(defun dired-subtree--get-ov (&optional p)

"Get the parent subtree overlay at point."

(setq p (or p (point)))

(car (--sort (> (overlay-get it 'dired-subtree-depth)

(overlay-get other 'dired-subtree-depth))

(dired-subtree--get-all-ovs-at-point p))))

(defun dired-subtree--get-depth (ov)

"Get subtree depth."

(or (and ov (overlay-get ov 'dired-subtree-depth)) 0))



;;; helpers

(defvar dired-subtree-preserve-properties '(dired-subtree-filter)

"Properties that should be preserved between read-ins.")

(defun dired-subtree--after-readin (&optional subtrees)

"Insert the SUBTREES again after dired buffer has been reverted.

If no SUBTREES are specified, use `dired-subtree-overlays'."

(-when-let (subtrees-to-process (or subtrees dired-subtree-overlays))

(let* ((ovs-by-depth (--sort (< (car it) (car other))

(--group-by (overlay-get it 'dired-subtree-depth)

subtrees-to-process)))

(sorted-ovs (--map (cons (car it)

(--map (-cons* it

(overlay-get it 'dired-subtree-name)

(-map (lambda (x) (cons x (overlay-get it x)))

dired-subtree-preserve-properties)) (cdr it)))

ovs-by-depth)))

;; (depth (path1 ov1 (prop1 . value1) (prop2 . value2)) (path2 ...))

(--each sorted-ovs

(--each (cdr it)

(when (dired-utils-goto-line (cadr it))

(dired-subtree--remove-overlay (car it))

(dired-subtree-insert)

(let ((ov (dired-subtree--get-ov)))

(--each (cddr it)

(overlay-put ov (car it) (cdr it)))

(dired-subtree--filter-subtree ov))))))))

(defun dired-subtree--after-insert ()

"After inserting the subtree, setup dired-details/dired-hide-details-mode."

(if (fboundp 'dired-insert-set-properties)

(let ((inhibit-read-only t)

(ov (dired-subtree--get-ov)))

(dired-insert-set-properties (overlay-start ov) (overlay-end ov)))

(when (featurep 'dired-details)

(dired-details-delete-overlays)

(dired-details-activate))))

(add-hook 'dired-after-readin-hook 'dired-subtree--after-readin)

(add-hook 'dired-subtree-after-insert-hook 'dired-subtree--after-insert)

(defun dired-subtree--unmark ()

"Unmark a file without moving point."

(save-excursion (dired-unmark 1)))

(defun dired-subtree--is-expanded-p ()

"Return non-nil if directory under point is expanded."

(save-excursion

(when (dired-utils-get-filename)

;; We've replaced `file-directory-p' with the regexp test to

;; speed up filters over TRAMP. So long as dired/ls format

;; doesn't change, we're good.

;; 'd' for directories, 'l' for potential symlinks to directories.

(and (save-excursion (beginning-of-line) (looking-at "..[dl]"))

(let ((depth (dired-subtree--get-depth (dired-subtree--get-ov))))

(dired-next-line 1)

(< depth (dired-subtree--get-depth (dired-subtree--get-ov))))))))

(defmacro dired-subtree-with-subtree (&rest forms)

"Run FORMS on each file in this subtree."

(declare (debug (body)))

`(save-excursion

(dired-subtree-beginning)

,@forms

(while (dired-subtree-next-sibling)

,@forms)))



;;;; Interactive

;;;###autoload

(defun dired-subtree-narrow ()

"Narrow the buffer to this subtree."

(interactive)

(-when-let (ov (dired-subtree--get-ov))

(narrow-to-region (overlay-start ov)

(overlay-end ov))))

;;; Navigation

;; make the arguments actually do something

;;;###autoload

(defun dired-subtree-up (&optional arg)

"Jump up one directory."

(interactive "p")

(-when-let (ov (dired-subtree--get-ov))

(goto-char (overlay-start ov))

(dired-previous-line 1)))

;;;###autoload

(defun dired-subtree-down (&optional arg)

"Jump down one directory."

(interactive "p")

(-when-let* ((p (point))

(ov (car (--sort

(< (overlay-start it)

(overlay-start other))

(--remove

(< (overlay-start it) p)

(dired-subtree--get-all-ovs))))))

(goto-char (overlay-start ov))

(dired-move-to-filename)))

;;;###autoload

(defun dired-subtree-next-sibling (&optional arg)

"Go to the next sibling."

(interactive "p")

(let ((current-ov (dired-subtree--get-ov)))

(dired-next-line 1)

(let ((new-ov (dired-subtree--get-ov)))

(cond

((not (dired-utils-is-file-p))

nil)

((< (dired-subtree--get-depth current-ov)

(dired-subtree--get-depth new-ov))

(goto-char (overlay-end new-ov))

(dired-move-to-filename)

t)

((> (dired-subtree--get-depth current-ov)

(dired-subtree--get-depth new-ov))

;; add option to either go to top or stay at the end

(dired-previous-line 1)

nil)

(t t)))))

;;;###autoload

(defun dired-subtree-previous-sibling (&optional arg)

"Go to the previous sibling."

(interactive "p")

(let ((current-ov (dired-subtree--get-ov)))

(dired-previous-line 1)

(let ((new-ov (dired-subtree--get-ov)))

(cond

;; this will need better handlign if we have inserted

;; subdirectories

((not (dired-utils-is-file-p))

nil)

((< (dired-subtree--get-depth current-ov)

(dired-subtree--get-depth new-ov))

(goto-char (overlay-start new-ov))

(dired-previous-line 1)

t)

((> (dired-subtree--get-depth current-ov)

(dired-subtree--get-depth new-ov))

;; add option to either go to top or stay at the end

(dired-next-line 1)

nil)

(t t)))))

;;;###autoload

(defun dired-subtree-beginning ()

"Go to the first file in this subtree."

(interactive)

(let ((ov (dired-subtree--get-ov)))

(if (not ov)

;; do something when not in subtree

t

(goto-char (overlay-start ov))

(dired-move-to-filename))))

;;;###autoload

(defun dired-subtree-end ()

"Go to the first file in this subtree."

(interactive)

(let ((ov (dired-subtree--get-ov)))

(if (not ov)

;; do something when not in subtree

t

(goto-char (overlay-end ov))

(dired-previous-line 1))))

;;; Marking

;;;###autoload

(defun dired-subtree-mark-subtree (&optional all)

"Mark all files in this subtree.

With prefix argument mark all the files in subdirectories

recursively."

(interactive "P")

(save-excursion

(if all

(let ((beg (save-excursion

(dired-subtree-beginning)

(point)))

(end (save-excursion

(dired-subtree-end)

(point))))

(dired-mark-files-in-region

(progn (goto-char beg) (line-beginning-position))

(progn (goto-char end) (line-end-position))))

(dired-subtree-beginning)

(save-excursion (dired-mark 1))

(while (dired-subtree-next-sibling)

(save-excursion (dired-mark 1))))))

;;;###autoload

(defun dired-subtree-unmark-subtree (&optional all)

"Unmark all files in this subtree.

With prefix argument unmark all the files in subdirectories

recursively."

(interactive)

(let ((dired-marker-char ? ))

(dired-subtree-mark-subtree all)))

;;; Insertion/deletion

;;;###autoload

(defun dired-subtree-revert ()

"Revert the subtree.

This means reinserting the content of this subtree and all its

children."

(interactive)

(let ((inhibit-read-only t)

(file-name (dired-utils-get-filename)))

(-when-let* ((ov (dired-subtree--get-ov))

(ovs (dired-subtree--get-ovs-in)))

(dired-subtree-up)

(delete-region (overlay-start ov) (overlay-end ov))

(dired-subtree--after-readin ovs)

(when file-name

(dired-utils-goto-line file-name)))))

(defun dired-subtree--readin (dir-name)

"Read in the directory.

Return a string suitable for insertion in `dired' buffer."

(with-temp-buffer

(let ((insert-dir-fun (if (and (featurep 'tramp)

(tramp-tramp-file-p dir-name)

(tramp-sh-handle-file-directory-p dir-name))

#'tramp-handle-insert-directory

#'insert-directory)))

(funcall insert-dir-fun dir-name dired-listing-switches nil t))

(delete-char -1)

(goto-char (point-min))

(delete-region

(progn (beginning-of-line) (point))

(progn (forward-line

(if (save-excursion

(forward-line 1)

(end-of-line)

(looking-back "\\."))

3 1)) (point)))

(insert " ")

(while (= (forward-line) 0)

(insert " "))

(delete-char -2)

(buffer-string)))

;;;###autoload

(defun dired-subtree-insert ()

"Insert subtree under this directory."

(interactive)

(let* ((dir-name (dired-get-filename nil))

(listing (dired-subtree--readin dir-name))

beg end)

(read-only-mode -1)

(move-end-of-line 1)

;; this is pretty ugly, I'm sure it can be done better

(save-excursion

(insert listing)

(setq end (+ (point) 2)))

(newline)

(setq beg (point))

(let ((inhibit-read-only t))

(remove-text-properties (1- beg) beg '(dired-filename)))

(let* ((ov (make-overlay beg end))

(parent (dired-subtree--get-ov (1- beg)))

(depth (or (and parent (1+ (overlay-get parent 'dired-subtree-depth)))

1))

(face (intern (format "dired-subtree-depth-%d-face" depth))))

(when dired-subtree-use-backgrounds

(overlay-put ov 'face face))

;; refactor this to some function

(overlay-put ov 'line-prefix

(if (stringp dired-subtree-line-prefix)

(if (not dired-subtree-use-backgrounds)

(apply 'concat (-repeat depth dired-subtree-line-prefix))

(cond

((eq nil dired-subtree-line-prefix-face)

(apply 'concat

(-repeat depth dired-subtree-line-prefix)))

((eq 'subtree dired-subtree-line-prefix-face)

(concat

dired-subtree-line-prefix

(propertize

(apply 'concat

(-repeat (1- depth) dired-subtree-line-prefix))

'face face)))

((eq 'parents dired-subtree-line-prefix-face)

(concat

dired-subtree-line-prefix

(apply 'concat

(--map

(propertize dired-subtree-line-prefix

'face

(intern (format "dired-subtree-depth-%d-face" it)))

(number-sequence 1 (1- depth))))))))

(funcall dired-subtree-line-prefix depth)))

(overlay-put ov 'dired-subtree-name dir-name)

(overlay-put ov 'dired-subtree-parent parent)

(overlay-put ov 'dired-subtree-depth depth)

(overlay-put ov 'evaporate t)

(push ov dired-subtree-overlays))

(goto-char beg)

(dired-move-to-filename)

(read-only-mode 1)

(run-hooks 'dired-subtree-after-insert-hook)))

;;;###autoload

(defun dired-subtree-remove ()

"Remove subtree at point."

(interactive)

(-when-let* ((ov (dired-subtree--get-ov))

(ovs (dired-subtree--get-ovs-in

(overlay-start ov)

(overlay-end ov))))

(let ((inhibit-read-only t))

(dired-subtree-up)

(delete-region (overlay-start ov)

(overlay-end ov))

(dired-subtree--remove-overlays ovs)))

(run-hooks 'dired-subtree-after-remove-hook))

;;;###autoload

(defun dired-subtree-toggle ()

"Insert subtree at point or remove it if it was not present."

(interactive)

(cond

((dired-subtree--is-expanded-p)

(dired-next-line 1)

(dired-subtree-remove))

(t

(save-excursion

(dired-subtree-insert)))))

(defun dired-subtree--insert-recursive (depth max-depth)

"Insert full subtree at point."

(save-excursion

(let ((name (dired-get-filename nil t)))

(when (and name (file-directory-p name)

(<= depth (or max-depth depth))

(or (= 1 depth)

(not (string-match-p dired-subtree-ignored-regexp

(file-name-nondirectory name)))))

(if (dired-subtree--is-expanded-p)

(dired-next-line 1)

(dired-subtree-insert))

(dired-subtree-end)

(dired-subtree--insert-recursive (1+ depth) max-depth)

(while (dired-subtree-previous-sibling)

(dired-subtree--insert-recursive (1+ depth) max-depth))))))

(defvar dired-subtree--cycle-previous nil

"Remember previous action for `dired-subtree-cycle'")

;;;###autoload

(defun dired-subtree-cycle (&optional max-depth)

"Org-mode like cycle visibility:

1) Show subtree

2) Show subtree recursively (if previous command was cycle)

3) Remove subtree

Numeric prefix will set max depth"

(interactive "P")

(save-excursion

(cond

;; prefix - show subtrees up to max-depth

(max-depth

(when (dired-subtree--is-expanded-p)

(dired-next-line 1)

(dired-subtree-remove))

(dired-subtree--insert-recursive 1 (if (integerp max-depth) max-depth nil))

(setq dired-subtree--cycle-previous :full))

;; if directory is not expanded, expand one level

((not (dired-subtree--is-expanded-p))

(dired-subtree-insert)

(setq dired-subtree--cycle-previous :insert))

;; hide if previous command was not cycle or tree was fully expanded

((or (not (eq last-command 'dired-subtree-cycle))

(eq dired-subtree--cycle-previous :full))

(dired-next-line 1)

(dired-subtree-remove)

(setq dired-subtree--cycle-previous :remove))

(t

(dired-subtree--insert-recursive 1 dired-subtree-cycle-depth)

(setq dired-subtree--cycle-previous :full)))))

(defun dired-subtree--filter-up (keep-dir kill-siblings)

(save-excursion

(let (ov)

(save-excursion

(while (dired-subtree-up))

(dired-next-line 1)

(dired-subtree-mark-subtree t))

(if keep-dir

(dired-subtree-unmark-subtree)

(dired-subtree--unmark))

(while (and (dired-subtree-up)

(> (dired-subtree--get-depth (dired-subtree--get-ov)) 0))

(if (not kill-siblings)

(dired-subtree--unmark)

(dired-subtree--unmark)

(let ((here (point)))

(dired-subtree-with-subtree

(when (and (dired-subtree--is-expanded-p)

(/= (point) here))

(dired-subtree--unmark)

(save-excursion

(dired-next-line 1)

(dired-subtree-unmark-subtree t)))))))

(dired-do-kill-lines)

(dired-subtree--cleanup-overlays))))

;;;###autoload

(defun dired-subtree-only-this-file (&optional arg)

"Remove all the siblings on the route from this file to the top-most directory.

With ARG non-nil, do not remove expanded directories in parents."

(interactive "P")

(dired-subtree--filter-up nil arg))

;;;###autoload

(defun dired-subtree-only-this-directory (&optional arg)

"Remove all the siblings on the route from this directory to the top-most directory.

With ARG non-nil, do not remove expanded directories in parents."

(interactive "P")

(dired-subtree--filter-up t arg))

;;; filtering

(defun dired-subtree--filter-update-bs (ov)

"Update the local filter list.

This function assumes that `dired-filter-stack' is dynamically

bound to relevant value."

(let* ((filt (dired-filter--describe-filters))

(before-str (if (equal filt "") nil (concat " Local filters: " filt "\n"))))

(overlay-put ov 'before-string before-str)))

(defun dired-subtree--filter-subtree (ov)

"Run the filter for this subtree.

It is only safe to call this from readin.

This depends on `dired-filter' package."

(when (featurep 'dired-filter)

(let ((dired-filter-stack (overlay-get ov 'dired-subtree-filter)))

(save-restriction

(widen)

(dired-subtree-narrow)

(dired-filter--expunge)

(dired-subtree--filter-update-bs ov)))))

;;;###autoload

(defun dired-subtree-apply-filter ()

"Push a local filter for this subtree.

This depends on `dired-filter' package.

It works exactly the same as global dired filters, only

restricted to a subtree. The global filter is also applied to

the subtree. The filter action is read from `dired-filter-map'."

(interactive)

(when (featurep 'dired-filter)

(-when-let (ov (dired-subtree--get-ov))

(let ((dired-filter-stack (overlay-get ov 'dired-subtree-filter))

(glob (current-global-map))

(loc (current-local-map))

cmd)

(cl-flet ((dired-filter--update

()

(save-restriction

(overlay-put ov 'dired-subtree-filter dired-filter-stack)

(widen)

(dired-subtree-revert)

(dired-subtree--filter-update-bs ov))))

(unwind-protect

(progn

(use-global-map dired-filter-map)

(use-local-map nil)

(setq cmd (key-binding (read-key-sequence "Choose filter action: "))))

(use-global-map glob)

(use-local-map loc))

(let ((p (point))

(beg (overlay-start ov))

(current-file (dired-utils-get-filename)))

(unwind-protect

(call-interactively cmd)

(unless (dired-utils-goto-line current-file)

(goto-char beg)

(forward-line)

(goto-char (min p (1- (overlay-end (dired-subtree--get-ov)))))

(dired-move-to-filename)))))))))



;;; Here we redefine a couple of functions from dired.el to make them

;;; subtree-aware

;; If the point is in a subtree, we need to provide a proper

;; directory, not the one that would come from `dired-subdir-alist'.

(defun dired-current-directory (&optional localp)

"Return the name of the subdirectory to which this line belongs.

This returns a string with trailing slash, like `default-directory'.

Optional argument means return a file name relative to `default-directory'."

(let ((here (point))

(alist (or dired-subdir-alist

;; probably because called in a non-dired buffer

(error "No subdir-alist in %s" (current-buffer))))

elt dir)

(while alist

(setq elt (car alist)

dir (car elt)

;; use `<=' (not `<') as subdir line is part of subdir

alist (if (<= (dired-get-subdir-min elt) here)

nil ; found

(cdr alist))))

;; dired-subdir: modify dir here if we are in a "subtree" view

(-when-let (parent (dired-subtree--get-ov))

(setq dir (concat (overlay-get parent 'dired-subtree-name) "/")))

;; end

(if localp

(dired-make-relative dir default-directory)

dir)))

;; Since the tree-inserted directory is not in the dired-subdir-alist,

;; we need to guard against nil.

(defun dired-get-subdir ()

;;"Return the subdir name on this line, or nil if not on a headerline."

;; Look up in the alist whether this is a headerline.

(save-excursion

(let ((cur-dir (dired-current-directory)))

(beginning-of-line) ; alist stores b-o-l positions

(and (zerop (- (point)

(or (dired-get-subdir-min

(assoc cur-dir

dired-subdir-alist))

0))) ;; dired-subtree: return zero if current

;; dir is not in `dired-subdir-alist'.

cur-dir))))

(provide 'dired-subtree)

;;; dired-subtree.el ends here