tree.el

;;; tree.el -- Files tree.

;; Copyright (C) 2017, 2018 fubuki

;; Author: fubuki@*****.org
;; Keywords: tools

;; 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.

;; 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Files & Directory tree print.

;;; Installation:

;; (require 'tree)

;;; Code:

(require 'esh-io)

(defgroup tree nil
  "Files tree."
  :group   'applications
  :version "25.3")

(defcustom tree-option-d nil
  "NON-NIL is directory only."
  :type 'boolean
  :group 'tree)

(defcustom tree-option-Q nil
  "NON-NIL is files and directory name quart."
  :type 'boolean
  :group 'tree)

(defcustom tree-ignore-directory "^\\.+$"
  "\".\" \"..\" is exclusion by default."
  :type 'regexp
  :group 'tree)

(defmacro tree-quote (leaf)
  "String for `tree-option-Q'."
  `(if tree-option-Q
       (concat "\"" ,leaf "\"")
     ,leaf))

(defun tree-directory (dir &optional branch)
  "Main loop."
  (let ((files (tree-directory-files dir))
	(branch (or branch ""))
	leaf result)
    
    (while files
      (setq leaf  (car files)
	    files (cdr files))
      (push (concat branch (if files "|-- " "`-- ") (tree-quote leaf) "\n") result)

      (when (file-accessible-directory-p
	     (expand-file-name (tree-concat-directory-name dir leaf)))
	(setq result
	      (append
	       (tree-directory (tree-concat-directory-name dir leaf)
			       (concat branch (if files "|   " "    ")))
	       result))))
      result))

(defun tree-directory-files (directory &optional full-name match-regexp nosort)
  "`directory-files' for directory only option `tree-option-d'."
  (let ((files
	 (tree-delete-regexp-non-match
	  tree-ignore-directory
	  (directory-files directory full-name match-regexp nosort)))
	result)
    
    (if tree-option-d
	(dolist (a files (reverse result))
	  (if (file-accessible-directory-p
	       (expand-file-name (tree-concat-directory-name directory a)))
	      (setq result (cons a result))))
      files)))

(defun tree-dot-directory-p (dir)
  (string-match "^\\.+$" dir))

(defun tree-concat-directory-name (dir1 dir2)
  "Concat with DIR1 and DIR2.
If there is no `/ 'between them add it."
  (concat 
   (if (equal "/" (substring dir1 (1- (length dir1))))
       dir1
     (concat dir1 "/"))
   dir2))

(defun tree-delete-regexp-non-match (regexp list)
  "Creates and returns a LIST with REGEXP removed from LIST."
  (let (result)
    (dolist (a list (reverse result))
      (unless (string-match regexp a)
	(setq result (cons a result))))))

(defun do--tree (dir)
  (message "Directory tree make %s..." dir)
  (insert ".\n")
  (dolist (a (reverse (tree-directory dir)))
    (insert a))
  (message "Directory tree make %s...done." dir))

(defun do--eshell-tree (dir)
  (eshell-buffered-print ".\n")
  (dolist (a (reverse (tree-directory dir)))
    (eshell-buffered-print a))
  (eshell-flush))

;;
;; Execte commands.
;;

(defun dtree (dir)
  "Print of tree of directory only.
With Prefix, insert the result into the current buffer."
  (interactive "D")
  (let ((temp-buffer-show-function 'switch-to-buffer-other-window)
	(tree-option-Q t)
	(tree-option-d t))
    (unless current-prefix-arg
      (with-output-to-temp-buffer " * Directory Tree List *"))
    (do--tree dir)))

(defun ftree (dir)
  "Print of \"files\" tree.
With Prefix, insert the result into the current buffer."
  (interactive "D")
  (let ((temp-buffer-show-function 'switch-to-buffer-other-window)
	(tree-option-Q t)
	(tree-option-d nil))
    (unless current-prefix-arg
      (with-output-to-temp-buffer " * Directory Tree List *"))
    (do--tree dir)))

(defun tree (dir)
  "Print of files tree.
With Prefix, insert the result into the current buffer."
  (interactive "D")
  (let ((temp-buffer-show-function 'switch-to-buffer-other-window))
    (unless current-prefix-arg
      (with-output-to-temp-buffer " * Directory Tree List *"))
    (do--tree dir)))

;;
;; for eshell
;;

(defun eshell/dtree (&optional dir)
  "Print of tree of directory only.
With Prefix, insert the result into the current buffer."
  (let ((tree-option-Q t)
	(tree-option-d t)
        (dir (or dir default-directory)))
    (do--eshell-tree dir)))

(defun eshell/ftree (&optional dir)
  "Print of \"files\" tree.
With Prefix, insert the result into the current buffer."
  (let ((tree-option-Q t)
	(tree-option-d nil)
        (dir (or dir default-directory)))
    (do--eshell-tree dir)))

(provide 'tree)
;; fin.