diff options
| author | Lev Lamberov <dogsleg@debian.org> | 2017-01-06 02:22:04 -0400 |
|---|---|---|
| committer | Lev Lamberov <dogsleg@debian.org> | 2017-01-06 02:22:04 -0400 |
| commit | 6e93683540e0b3c12321a1fff4983698053ffae3 (patch) | |
| tree | 7d69bda2c7dcb8546898802e36f4213950249185 | |
Import ztree_1.0.5.orig.tar.bz2
[dgit import orig ztree_1.0.5.orig.tar.bz2]
| -rw-r--r-- | ChangeLog | 121 | ||||
| -rw-r--r-- | README.md | 108 | ||||
| -rw-r--r-- | ztree-diff-model.el | 386 | ||||
| -rw-r--r-- | ztree-diff.el | 561 | ||||
| -rw-r--r-- | ztree-dir.el | 204 | ||||
| -rw-r--r-- | ztree-pkg.el | 2 | ||||
| -rw-r--r-- | ztree-util.el | 98 | ||||
| -rw-r--r-- | ztree-view.el | 672 | ||||
| -rw-r--r-- | ztree.el | 37 |
9 files changed, 2189 insertions, 0 deletions
diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..710b92d --- /dev/null +++ b/ChangeLog @@ -0,0 +1,121 @@ +2017-01-05 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + 1) Implemented feature: narrow/widen directories in ztree-dir 2) Fixed + regression in TRAMP mode while in ztree-diff 3) Updated docstrings. + + Merge commit '3a4df17edddef84160194802acc034cfa2dbd678' + +2016-12-27 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merge commit '2751b96aca36cc5c31dc105ec985c269126420a0' + +2016-12-26 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Issue #18: files considered different if they have different sizes + + Merge commit '6826c3f3f3735fbf060206072392d67f0990f817' + +2016-09-25 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merge commit 'e5eb534859acc0cc0a13403fd166457db9fb7eb5' + + Added fix for debbugs 24200 debbugs.gnu.org/24200 proposed by Michael + Albinus + +2016-09-24 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + ztree: increased version + +2016-09-24 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merge commit '07009d7695eb7b82225712336fe388495dd48169' + - Fixed broken 'x' button in ztree-dir + - Fixed broken compare over tramp + +2016-07-11 Paul Eggert <eggert@cs.ucla.edu> + + Fix some quoting problems in doc strings + + Most of these are minor issues involving, e.g., quoting `like this' + instead of 'like this'. A few involve escaping ` and ' with a preceding + \= when the characters should not be turned into curved single quotes. + +2016-01-28 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merged from upstream with StefanM's changes + +2016-01-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * ztree/ztree-diff-model.el (ztree-diff-node): Use cl-defstruct + + (ztree-diff-model-partial-rescan, ztree-diff-model-subtree) + (ztree-diff-node-update-diff-from-children, ) + (ztree-diff-node-traverse): + * ztree/ztree-diff.el (ztree-diff-copy-file, ztree-diff-copy-dir) + (ztree-diff-delete-file): Adjust accordingly. + * ztree/ztree-dir.el (ztree-dir): Don't quote lambda. + * ztree/ztree.el: Fix up maintainer address. Add cl-lib dependency. + * ztree/ztree-util.el (ztree-defrecord): Delete. + +2016-01-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * packages/gnome-c-style/gnome-c-tests.el: Add copyright blurb + +2015-07-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * ztree/ztree-pkg.el: Remove since it's auto-generated + +2015-06-18 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merge remote-tracking branch 'ztree/master' + + 1) Fixed bug with where the user unable to delete a file + or directory 2) Added hotkey 'H' in ztree-diff to toggle between + hide/show + of the ignored files (i.e. starting with .dot) 3) Ignored files do not + affect the directory status anymore. 4) Since the new hotkey is added, + the version number is increased. + +2015-06-17 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merge remote-tracking branch 'ztree/master' + + Fixed code submitted by mistake + +2015-06-13 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merge remote-tracking branch 'ztree/master' + + 1) All functions now starts with ztree- prefix 2) All files now have + lexical-binding enabled + +2015-06-13 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merge remote-tracking branch 'ztree/master' + + Added added variable ztree-dir-move-focus; if set move the focus to + opened editor window when the user press Enter + +2015-06-12 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merge remote-tracking branch 'ztree/master' + + 1) Removed redundant comments about compatibility with GNU Emacs 2) + Removed workaround for electric-indent-mode + +2015-06-11 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merge remote-tracking branch 'ztree/master' + + Replaced pkg file with autogenerated for ztree package. + +2015-06-11 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Merge remote-tracking branch 'ztree/master' + + Added missing ztree.el + +2015-06-11 Alexey Veretennikov <alexey.veretennikov@gmail.com> + + Added ztree package + diff --git a/README.md b/README.md new file mode 100644 index 0000000..dc1907a --- /dev/null +++ b/README.md @@ -0,0 +1,108 @@ +# ztree +Ztree is a project dedicated to implementation of several text-tree applications inside [GNU Emacs](http://www.gnu.org/software/emacs/). It consists of 2 subprojects: **ztree-diff** and **ztree-dir** (the basis of **ztree-diff**). Available in [GNU ELPA](https://elpa.gnu.org/) and [MELPA](http://melpa.org/#/). + +## Installation + +### Using ELPA +Press `M-x` in GNU Emacs and write `list-packages`. Find the `ztree` in the list of packages and press `i` to select this package, `x` to install the package. + +### Using MELPA +Add to your `.emacs` or `.emacs.d/init.el` following lines: + +```scheme +(setq package-archives '(("gnu" . "http://elpa.gnu.org/packages/") + ("melpa" . "http://melpa.milkbox.net/packages/"))) +``` + +Follow the installation instructions for the GNU ELPA above. + +### Manual +Add the following to your .emacs file: + +```scheme +(push (substitute-in-file-name "path-to-ztree-directory") load-path) +(require 'ztree) +``` + +## ztree-diff +**ztree-diff** is a directory-diff tool for Emacs inspired by commercial tools like Beyond Compare or Araxis Merge. It supports showing the difference between two directories; calling **Ediff** for not matching files, copying between directories, deleting file/directories, hiding/showing equal files/directories. + +The comparison itself performed with the external **GNU diff** tool, so make sure to have one in the executable path. Verified on OSX and Linux. + +If one wants to have a stand-alone application, consider the (WIP)[zdircmp](https://github.com/fourier/zdircmp) project based on **ztree-diff**. + +Call the `ztree-diff` interactive function: + +``` +M-x ztree-diff +``` +Then you need to specify the left and right directories to compare. + +### Hotkeys supported + * Open/close directories with double-click, `RET` or `Space` keys. + * To jump to the parent directory, hit the `Backspace` key. + * To toggle open/closed state of the subtree of the current directory, hit the `x` key. + * `RET` on different files starts the **Ediff** (or open file if one absent or the same) + * `Space` show the simple diff window for the current file instead of **Ediff** (or view file if one absent or the same) + * `TAB` to fast switch between panels + * `h` key to toggle show/hide identical files/directories + * `H` key to toggle show/hide hidden/ignored files/directories + * `C` key to copy current file or directory to the left or right panel + * `D` key to delete current file or directory + * `v` key to quick view the current file + * `r` initiates the rescan/refresh of current file or subdirectory + * `F5` forces the full rescan. + +### Customizations +By default all files starting with dot (like `.gitignore`) are not shown and excluded from the difference status for directories. One can add an additional regexps to the list `ztree-diff-filter-list`. + +One also could turn on unicode characters to draw the tree with instead of normal ASCII-characters. This is controlled by the `ztree-draw-unicode-lines` variable. + +### Screenshots + + + + + +## ztree-dir + +**ztree-dir** is a simple text-mode directory tree for Emacs. See screenshots below for the GUI and the terminal versions of the **ztree-dir**. + +Call the `ztree-dir` interactive function: + +``` +M-x ztree-dir +``` + +### Hotkeys supported +* Open/close directories with double-click, `RET` or `Space` keys. +* To jump to the parent directory, hit the `Backspace` key. +* To toggle open/closed state of the subtree of the current directory, hit the `x` key. +* To visit a file, press `Space` key. +* To open file in other window, use `RET` key. + +### Customizations +Set the `ztree-dir-move-focus` variable to `t` in order to move focus to the other window when the `RET` key is pressed; the default behavior is to keep focus in `ztree-dir` window. + + + + + + + +## Contributions +You can contribute to **ztree** in one of the following ways. +- Submit a bug report +- Submit a feature request +- Submit a simple pull request (with changes < 15 lines) + +### Copyright issues +Since **ztree** is a part of [GNU ELPA](https://elpa.gnu.org/), it is copyrighted by the [Free Software Foundation, Inc.](http://www.fsf.org/). Therefore in order to submit nontrivial changes (with total amount of lines > 15), one needs to to grant the right to include your works in GNU Emacs to the FSF. + +For this you need to complete [this](https://raw.githubusercontent.com/fourier/ztree/contributions/request-assign.txt) form, and send it to [assign@gnu.org](mailto:assign@gnu.org). The FSF will send you the assignment contract that both you and the FSF will sign. + +For more information one can read [here](http://www.gnu.org/licenses/why-assign.html) to understand why it is needed. + +As soon as the paperwork is done one can contribute to **ztree** with bigger pull requests. +Note what pull requests without paperwork done will not be accepted, so please notify the [maintainer](mailto:alexey.veretennikov@gmail.com) if everything is in place. + diff --git a/ztree-diff-model.el b/ztree-diff-model.el new file mode 100644 index 0000000..6f4c951 --- /dev/null +++ b/ztree-diff-model.el @@ -0,0 +1,386 @@ +;;; ztree-diff-model.el --- diff model for directory trees -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; +;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com> +;; +;; Created: 2013-11-11 +;; +;; Keywords: files tools +;; URL: https://github.com/fourier/ztree +;; Compatibility: GNU Emacs 24.x +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs 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. +;; +;; GNU Emacs 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: + +;; Diff model + +;;; Code: +(require 'ztree-util) +(eval-when-compile (require 'cl-lib)) + +(defvar-local ztree-diff-model-ignore-fun nil + "Function which determines if the node should be excluded from comparison.") + +(defvar-local ztree-diff-model-progress-fun nil + "Function which should be called whenever the progress indications is updated.") + + +(defun ztree-diff-model-update-progress () + "Update the progress." + (when ztree-diff-model-progress-fun + (funcall ztree-diff-model-progress-fun))) + +;; Create a record ztree-diff-node with defined fields and getters/setters +;; here: +;; parent - parent node +;; left-path is the full path on the left side of the diff window, +;; right-path is the full path of the right side, +;; short-name - is the file or directory name +;; children - list of nodes - files or directories if the node is a directory +;; different = {nil, 'same, 'new, 'diff, 'ignore} - means comparison status +(cl-defstruct (ztree-diff-node + (:constructor) + (:constructor ztree-diff-node-create + (parent left-path right-path + different + &aux + (short-name (ztree-file-short-name + (or left-path right-path))) + (right-short-name + (if (and left-path right-path) + (ztree-file-short-name right-path) + short-name))))) + parent left-path right-path short-name right-short-name children different) + +(defun ztree-diff-model-ignore-p (node) + "Determine if the NODE should be excluded from comparison results." + (when ztree-diff-model-ignore-fun + (funcall ztree-diff-model-ignore-fun node))) + +(defun ztree-diff-node-to-string (node) + "Construct the string with contents of the NODE given." + (let ((string-or-nil #'(lambda (x) (if x + (cond ((stringp x) x) + ((eq x 'new) "new") + ((eq x 'diff) "different") + ((eq x 'ignore) "ignored") + ((eq x 'same) "same") + (t (ztree-diff-node-short-name x))) + "(empty)"))) + (children (ztree-diff-node-children node)) + (ch-str "")) + (dolist (x children) + (setq ch-str (concat ch-str "\n * " (ztree-diff-node-short-name x) + ": " + (funcall string-or-nil (ztree-diff-node-different x))))) + (concat "Node: " (ztree-diff-node-short-name node) + "\n" + " * Parent: " (funcall string-or-nil (ztree-diff-node-parent node)) + "\n" + " * Status: " (funcall string-or-nil (ztree-diff-node-different node)) + "\n" + " * Left path: " (funcall string-or-nil (ztree-diff-node-left-path node)) + "\n" + " * Right path: " (funcall string-or-nil (ztree-diff-node-right-path node)) + "\n" + " * Children: " ch-str + "\n"))) + + +(defun ztree-diff-node-short-name-wrapper (node &optional right-side) + "Return the short name of the NODE given. +If the RIGHT-SIDE is true, take the right leaf" + (if (not right-side) + (ztree-diff-node-short-name node) + (ztree-diff-node-right-short-name node))) + + +(defun ztree-diff-node-is-directory (node) + "Determines if the NODE is a directory." + (let ((left (ztree-diff-node-left-path node)) + (right (ztree-diff-node-right-path node))) + (if left + (file-directory-p left) + (file-directory-p right)))) + +(defun ztree-diff-node-side (node) + "Determine the side there the file is present for NODE. +Return BOTH if the file present on both sides; +LEFT if only on the left side and +RIGHT if only on the right side." + (let ((left (ztree-diff-node-left-path node)) + (right (ztree-diff-node-right-path node))) + (if (and left right) 'both + (if left 'left 'right)))) + + +(defun ztree-diff-node-equal (node1 node2) + "Determines if NODE1 and NODE2 are equal." + (and (string-equal (ztree-diff-node-short-name node1) + (ztree-diff-node-short-name node2)) + (string-equal (ztree-diff-node-left-path node1) + (ztree-diff-node-left-path node2)) + (string-equal (ztree-diff-node-right-path node1) + (ztree-diff-node-right-path node1)))) + +(defun ztree-diff-model-files-equal (file1 file2) + "Compare files FILE1 and FILE2 using external diff. +Returns t if equal." + (unless (ztree-same-host-p file1 file2) + (error "Compared files are not on the same host")) + (let* ((file1-untrampified (ztree-untrampify-filename file1)) + (file2-untrampified (ztree-untrampify-filename file2))) + (if (or + (/= (nth 7 (file-attributes file1)) + (nth 7 (file-attributes file2))) + (/= 0 (process-file diff-command nil nil nil "-q" + file1-untrampified + file2-untrampified))) + 'diff + 'same))) + +(defun ztree-directory-files (dir) + "Return the list of full paths of files in a directory DIR. +Filters out . and .." + (ztree-filter #'(lambda (file) (let ((simple-name (ztree-file-short-name file))) + (not (or (string-equal simple-name ".") + (string-equal simple-name ".."))))) + (directory-files dir 'full))) + +(defun ztree-diff-model-partial-rescan (node) + "Rescan the NODE. +The node is a either a file or directory with both +left and right parts existing." + ;; if a directory - recreate + (if (ztree-diff-node-is-directory node) + (ztree-diff-node-recreate node) + ;; if a file, change a status + (setf (ztree-diff-node-different node) + (if (or (ztree-diff-model-ignore-p node) ; if should be ignored + (eql (ztree-diff-node-different node) 'ignore) ; was ignored + (eql (ztree-diff-node-different ; or parent was ignored + (ztree-diff-node-parent node)) + 'ignore)) + 'ignore + (ztree-diff-model-files-equal (ztree-diff-node-left-path node) + (ztree-diff-node-right-path node))))) + ;; update all parents statuses + (ztree-diff-node-update-all-parents-diff node)) + +(defun ztree-diff-model-subtree (parent path side diff) + "Create a subtree with given PARENT for the given PATH. +Argument SIDE either `left' or `right' side. +Argument DIFF different status to be assigned to all created nodes." + (let ((files (ztree-directory-files path)) + (result nil)) + (dolist (file files) + (if (file-directory-p file) + (let* ((node (ztree-diff-node-create + parent + (when (eq side 'left) file) + (when (eq side 'right) file) + diff)) + (children (ztree-diff-model-subtree node file side diff))) + (setf (ztree-diff-node-children node) children) + (push node result)) + (push (ztree-diff-node-create + parent + (when (eq side 'left) file) + (when (eq side 'right) file) + diff) + result))) + result)) + +(defun ztree-diff-node-update-diff-from-children (node) + "Set the diff status for the NODE based on its children." + (unless (eql (ztree-diff-node-different node) 'ignore) + (let ((diff (cl-reduce #'ztree-diff-model-update-diff + (ztree-diff-node-children node) + :initial-value 'same + :key 'ztree-diff-node-different))) + (setf (ztree-diff-node-different node) diff)))) + +(defun ztree-diff-node-update-all-parents-diff (node) + "Recursively update all parents diff status for the NODE." + (let ((parent node)) + (while (setq parent (ztree-diff-node-parent parent)) + (ztree-diff-node-update-diff-from-children parent)))) + + +(defun ztree-diff-model-update-diff (old new) + "Get the diff status depending if OLD or NEW is not nil. +If the OLD is `ignore', do not change anything" + ;; if the old whole directory is ignored, ignore children's status + (cond ((eql old 'ignore) 'ignore) + ;; if the new status is ignored, use old + ((eql new 'ignore) old) + ;; if the old or new status is different, return different + ((or (eql old 'diff) + (eql new 'diff)) 'diff) + ;; if new is 'new, return new + ((eql new 'new) 'new) + ;; all other cases return old + (t old))) + +(defun ztree-diff-node-update-diff-from-parent (node) + "Recursively update diff status of all children of NODE. +This function will traverse through all children recursively +setting status from the NODE, unless they have an ignore status" + (let ((status (ztree-diff-node-different node)) + (children (ztree-diff-node-children node))) + ;; if the parent has ignore status, force all kids this status + ;; otherwise only update status when the child status is not ignore + (mapc (lambda (child) + (when (or (eql status 'ignore) + (not + (or (eql status 'ignore) + (eql (ztree-diff-node-different child) 'ignore)))) + (setf (ztree-diff-node-different child) status) + (ztree-diff-node-update-diff-from-parent child))) + children))) + + + +(defun ztree-diff-model-find-in-files (list shortname is-dir) + "Find in LIST of files the file with name SHORTNAME. +If IS-DIR searching for directories; assume files otherwise" + (ztree-find list + (lambda (x) (and (string-equal (ztree-file-short-name x) + shortname) + (eq is-dir (file-directory-p x)))))) + + +(defun ztree-diff-model-should-ignore (node) + "Determine if the NODE and its children should be ignored. +If no parent - never ignore; +if in ignore list - ignore +if parent has ignored status - ignore" + (let ((parent (ztree-diff-node-parent node))) + (and parent + (or (eql (ztree-diff-node-different parent) 'ignore) + (ztree-diff-model-ignore-p node))))) + + +(defun ztree-diff-node-recreate (node) + "Traverse 2 paths defined in the NODE updating its children and status." + (let* ((list1 (ztree-directory-files (ztree-diff-node-left-path node))) ;; left list of liles + (list2 (ztree-directory-files (ztree-diff-node-right-path node))) ;; right list of files + (should-ignore (ztree-diff-model-should-ignore node)) + ;; status automatically assigned to children of the node + (children-status (if should-ignore 'ignore 'new)) + (children nil)) ;; list of children + ;; update waiting status + (ztree-diff-model-update-progress) + ;; update node status ignore status either inhereted from the + ;; parent or the own + (when should-ignore + (setf (ztree-diff-node-different node) 'ignore)) + ;; first - adding all entries from left directory + (dolist (file1 list1) + ;; for every entry in the first directory + ;; we are creating the node + (let* ((simple-name (ztree-file-short-name file1)) + (isdir (file-directory-p file1)) + ;; find if the file is in the second directory and the type + ;; is the same - i.e. both are directories or both are files + (file2 (ztree-diff-model-find-in-files list2 simple-name isdir)) + ;; create a child. The current node is a parent + ;; new by default - will be overriden below if necessary + (child + (ztree-diff-node-create node file1 file2 children-status))) + ;; update child own ignore status + (when (ztree-diff-model-should-ignore child) + (setf (ztree-diff-node-different child) 'ignore)) + ;; if exists on a right side with the same type, + ;; remove from the list of files on the right side + (when file2 + (setf list2 (cl-delete file2 list2 :test #'string-equal))) + (cond + ;; when exist just on a left side and is a directory, add all + ((and isdir (not file2)) + (setf (ztree-diff-node-children child) + (ztree-diff-model-subtree child + file1 + 'left + (ztree-diff-node-different child)))) + ;; if 1) exists on both sides and 2) it is a file + ;; and 3) not ignored file + ((and file2 (not isdir) (not (eql (ztree-diff-node-different child) 'ignore))) + (setf (ztree-diff-node-different child) + (ztree-diff-model-files-equal file1 file2))) + ;; if exists on both sides and it is a directory, traverse further + ((and file2 isdir) + (ztree-diff-node-recreate child))) + ;; push the created node to the children list + (push child children))) + ;; second - adding entries from the right directory which are not present + ;; in the left directory + (dolist (file2 list2) + ;; for every entry in the second directory + ;; we are creating the node + (let* ((isdir (file-directory-p file2)) + ;; create the child to be added to the results list + (child + (ztree-diff-node-create node nil file2 children-status))) + ;; update ignore status of the child + (when (ztree-diff-model-should-ignore child) + (setf (ztree-diff-node-different child) 'ignore)) + ;; if it is a directory, set the whole subtree to children + (when isdir + (setf (ztree-diff-node-children child) + (ztree-diff-model-subtree child + file2 + 'right + (ztree-diff-node-different child)))) + ;; push the created node to the result list + (push child children))) + ;; finally set different status based on all children + ;; depending if the node should participate in overall result + (unless should-ignore + (setf (ztree-diff-node-different node) + (cl-reduce #'ztree-diff-model-update-diff + children + :initial-value 'same + :key 'ztree-diff-node-different))) + ;; and set children + (setf (ztree-diff-node-children node) children))) + + +(defun ztree-diff-model-update-node (node) + "Refresh the NODE." + (ztree-diff-node-recreate node)) + + + +(defun ztree-diff-model-set-ignore-fun (ignore-p) + "Set the buffer-local ignore function to IGNORE-P. +Ignore function is a function of one argument (ztree-diff-node) +which returns t if the node should be ignored (like files starting +with dot etc)." + (setf ztree-diff-model-ignore-fun ignore-p)) + + +(defun ztree-diff-model-set-progress-fun (progress-fun) + "Setter for the buffer-local PROGRESS-FUN callback. +This callback is called to indicate the ongoing activity. +Callback is a function without arguments." + (setf ztree-diff-model-progress-fun progress-fun)) + +(provide 'ztree-diff-model) + +;;; ztree-diff-model.el ends here diff --git a/ztree-diff.el b/ztree-diff.el new file mode 100644 index 0000000..a4bd012 --- /dev/null +++ b/ztree-diff.el @@ -0,0 +1,561 @@ +;;; ztree-diff.el --- Text mode diff for directory trees -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; +;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com> +;; +;; Created: 2013-11-11 +;; +;; Keywords: files tools +;; URL: https://github.com/fourier/ztree +;; Compatibility: GNU Emacs 24.x +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs 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. +;; +;; GNU Emacs 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: + +;;; Code: +(require 'ztree-view) +(require 'ztree-diff-model) + +(defconst ztree-diff-hidden-files-regexp "^\\." + "Hidden files regexp. +By default all filest starting with dot `.', including . and ..") + +(defface ztreep-diff-header-face + '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) + (((background dark)) (:height 1.2 :foreground "lightblue" :weight bold)) + (t :height 1.2 :foreground "darkblue" :weight bold)) + "*Face used for the header in Ztree Diff buffer." + :group 'Ztree-diff :group 'font-lock-highlighting-faces) +(defvar ztreep-diff-header-face 'ztreep-diff-header-face) + +(defface ztreep-diff-header-small-face + '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) + (((background dark)) (:foreground "lightblue" :weight bold)) + (t :weight bold :foreground "darkblue")) + "*Face used for the header in Ztree Diff buffer." + :group 'Ztree-diff :group 'font-lock-highlighting-faces) +(defvar ztreep-diff-header-small-face 'ztreep-diff-header-small-face) + +(defface ztreep-diff-model-diff-face + '((t (:foreground "red"))) + "*Face used for different files in Ztree-diff." + :group 'Ztree-diff :group 'font-lock-highlighting-faces) +(defvar ztreep-diff-model-diff-face 'ztreep-diff-model-diff-face) + +(defface ztreep-diff-model-add-face + '((t (:foreground "blue"))) + "*Face used for added files in Ztree-diff." + :group 'Ztree-diff :group 'font-lock-highlighting-faces) +(defvar ztreep-diff-model-add-face 'ztreep-diff-model-add-face) + +(defface ztreep-diff-model-ignored-face + '((((type tty pc) (class color) (min-colors 256)) :foreground "#2f2f2f") + (((type tty pc) (class color) (min-colors 8)) :foreground "white") + (t (:foreground "#7f7f7f" :strike-through t))) + "*Face used for non-modified files in Ztree-diff." + :group 'Ztree-diff :group 'font-lock-highlighting-faces) +(defvar ztreep-diff-model-ignored-face 'ztreep-diff-model-ignored-face) + +(defface ztreep-diff-model-normal-face + '((((type tty pc) (class color) (min-colors 8)) :foreground "white") + (t (:foreground "#7f7f7f"))) + "*Face used for non-modified files in Ztree-diff." + :group 'Ztree-diff :group 'font-lock-highlighting-faces) +(defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face) + + +(defvar-local ztree-diff-filter-list (list ztree-diff-hidden-files-regexp) + "List of regexp file names to filter out. +By default paths starting with dot (like .git) are ignored") + +(defvar-local ztree-diff-dirs-pair nil + "Pair of the directories stored. Used to perform the full rescan.") + +(defvar-local ztree-diff-show-equal-files t + "Show or not equal files/directories on both sides.") + +(defvar-local ztree-diff-show-filtered-files nil + "Show or not files from the filtered list.") + +(defvar-local ztree-diff-wait-message nil + "Message showing while constructing the diff tree.") + + +;;;###autoload +(define-minor-mode ztreediff-mode + "A minor mode for displaying the difference of the directory trees in text mode." + ;; initial value + nil + ;; modeline name + " Diff" + ;; The minor mode keymap + `( + (,(kbd "C") . ztree-diff-copy) + (,(kbd "h") . ztree-diff-toggle-show-equal-files) + (,(kbd "H") . ztree-diff-toggle-show-filtered-files) + (,(kbd "D") . ztree-diff-delete-file) + (,(kbd "v") . ztree-diff-view-file) + (,(kbd "d") . ztree-diff-simple-diff-files) + (,(kbd "r") . ztree-diff-partial-rescan) + (,(kbd "R") . ztree-diff-full-rescan) + ([f5] . ztree-diff-full-rescan))) + + +(defun ztree-diff-node-face (node) + "Return the face for the NODE depending on diff status." + (let ((diff (ztree-diff-node-different node))) + (cond ((eq diff 'ignore) ztreep-diff-model-ignored-face) + ((eq diff 'diff) ztreep-diff-model-diff-face) + ((eq diff 'new) ztreep-diff-model-add-face) + ((eq diff 'same) ztreep-diff-model-normal-face)))) + +(defun ztree-diff-insert-buffer-header () + "Insert the header to the ztree buffer." + (ztree-insert-with-face "Differences tree" ztreep-diff-header-face) + (insert "\n") + (when ztree-diff-dirs-pair + (ztree-insert-with-face (concat "Left: " (car ztree-diff-dirs-pair)) + ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair)) + ztreep-diff-header-small-face) + (insert "\n")) + (ztree-insert-with-face "Legend:" ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face " Normal file " ztreep-diff-model-normal-face) + (ztree-insert-with-face "- same on both sides" ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face " Orphan file " ztreep-diff-model-add-face) + (ztree-insert-with-face "- does not exist on other side" ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face " Mismatch file " ztreep-diff-model-diff-face) + (ztree-insert-with-face "- different from other side" ztreep-diff-header-small-face) + (insert "\n ") + (ztree-insert-with-face "Ignored file" ztreep-diff-model-ignored-face) + (ztree-insert-with-face " - ignored from comparison" ztreep-diff-header-small-face) + (insert "\n") + + (ztree-insert-with-face "==============" ztreep-diff-header-face) + (insert "\n")) + +(defun ztree-diff-full-rescan () + "Force full rescan of the directory trees." + (interactive) + (when (and ztree-diff-dirs-pair + (yes-or-no-p (format "Force full rescan?"))) + (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair)))) + + + +(defun ztree-diff-existing-common (node) + "Return the NODE if both left and right sides exist." + (let ((left (ztree-diff-node-left-path node)) + (right (ztree-diff-node-right-path node))) + (if (and left right + (file-exists-p left) + (file-exists-p right)) + node + nil))) + +(defun ztree-diff-existing-common-parent (node) + "Return the first node in up in hierarchy of the NODE which has both sides." + (let ((common (ztree-diff-existing-common node))) + (if common + common + (ztree-diff-existing-common-parent (ztree-diff-node-parent node))))) + +(defun ztree-diff-do-partial-rescan (node) + "Partly rescan the NODE." + (let* ((common (ztree-diff-existing-common-parent node)) + (parent (ztree-diff-node-parent common))) + (if (not parent) + (when ztree-diff-dirs-pair + (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair))) + (ztree-diff-update-wait-message + (concat "Updating " (ztree-diff-node-short-name common) " ...")) + (ztree-diff-model-partial-rescan common) + (message "Done") + (ztree-refresh-buffer (line-number-at-pos))))) + + +(defun ztree-diff-partial-rescan () + "Perform partial rescan on the current node." + (interactive) + (let ((found (ztree-find-node-at-point))) + (when found + (ztree-diff-do-partial-rescan (car found))))) + + +(defun ztree-diff-simple-diff (node) + "Create a simple diff buffer for files from left and right panels. +Argument NODE node containing paths to files to call a diff on." + (let* ((node-left (ztree-diff-node-left-path node)) + (node-right (ztree-diff-node-right-path node))) + (when (and + node-left + node-right + (not (file-directory-p node-left))) + ;; show the diff window on the bottom + ;; to not to crush tree appearance + (let ((split-width-threshold nil)) + (diff node-left node-right))))) + + +(defun ztree-diff-simple-diff-files () + "Create a simple diff buffer for files from left and right panels." + (interactive) + (let ((found (ztree-find-node-at-point))) + (when found + (let ((node (car found))) + (ztree-diff-simple-diff node))))) + +(defun ztree-diff-node-action (node hard) + "Perform action on NODE: +1 if both left and right sides present: + 1.1 if they are differend + 1.1.1 if HARD ediff + 1.1.2 simple diff otherwiste + 1.2 if they are the same - view left +2 if left or right present - view left or rigth" + (let ((left (ztree-diff-node-left-path node)) + (right (ztree-diff-node-right-path node)) + ;; FIXME: The GNU convention is to only use "path" for lists of + ;; directories as in load-path. + (open-f #'(lambda (path) (if hard (find-file path) + (let ((split-width-threshold nil)) + (view-file-other-window path)))))) + (cond ((and left right) + (if (eql (ztree-diff-node-different node) 'same) + (funcall open-f left) + (if hard + (ediff left right) + (ztree-diff-simple-diff node)))) + (left (funcall open-f left)) + (right (funcall open-f right)) + (t nil)))) + + + +(defun ztree-diff-copy-file (node source-path destination-path copy-to-right) + "Update the NODE status and copy the file. +File copied from SOURCE-PATH to DESTINATION-PATH. +COPY-TO-RIGHT specifies which side of the NODE to update." + (let ((target-path (concat + (file-name-as-directory destination-path) + (file-name-nondirectory + (directory-file-name source-path))))) + (let ((err (condition-case error-trap + (progn + ;; don't ask for overwrite + ;; keep time stamp + (copy-file source-path target-path t t) + nil) + (error error-trap)))) + ;; error message if failed + (if err (message (concat "Error: " (nth 2 err))) + ;; otherwise: + ;; assuming all went ok when left and right nodes are the same + ;; set both as not different if they were not ignored + (unless (eq (ztree-diff-node-different node) 'ignore) + (setf (ztree-diff-node-different node) 'same)) + ;; update left/right paths + (if copy-to-right + (setf (ztree-diff-node-right-path node) target-path) + (setf (ztree-diff-node-left-path node) target-path)) + (ztree-diff-node-update-all-parents-diff node) + (ztree-refresh-buffer (line-number-at-pos)))))) + + +(defun ztree-diff-copy-dir (node source-path destination-path copy-to-right) + "Update the NODE status and copy the directory. +Directory copied from SOURCE-PATH to DESTINATION-PATH. +COPY-TO-RIGHT specifies which side of the NODE to update." + (let* ((src-path (file-name-as-directory source-path)) + (target-path (file-name-as-directory destination-path)) + (target-full-path (concat + target-path + (file-name-nondirectory + (directory-file-name source-path))))) + (let ((err (condition-case error-trap + (progn + ;; keep time stamp + ;; ask for overwrite + (copy-directory src-path target-path t t) + nil) + (error error-trap)))) + ;; error message if failed + (if err + (progn + (message (concat "Error: " (nth 1 err))) + ;; and do rescan of the node + (ztree-diff-do-partial-rescan node)) + ;; if everything is ok, update statuses + (message target-full-path) + (if copy-to-right + (setf (ztree-diff-node-right-path node) target-full-path) + (setf (ztree-diff-node-left-path node) target-full-path)) + (ztree-diff-update-wait-message + (concat "Updating " (ztree-diff-node-short-name node) " ...")) + ;; TODO: do not rescan the node. Use some logic like in delete + (ztree-diff-model-update-node node) + (message "Done.") + (ztree-diff-node-update-all-parents-diff node) + (ztree-refresh-buffer (line-number-at-pos)))))) + + +(defun ztree-diff-copy () + "Copy the file under the cursor to other side." + (interactive) + (let ((found (ztree-find-node-at-point))) + (when found + (let* ((node (car found)) + (side (cdr found)) + (node-side (ztree-diff-node-side node)) + (copy-to-right t) ; copy from left to right + (node-left (ztree-diff-node-left-path node)) + (node-right (ztree-diff-node-right-path node)) + (source-path nil) + (destination-path nil) + (parent (ztree-diff-node-parent node))) + (when parent ; do not copy the root node + ;; determine a side to copy from/to + ;; algorithm: + ;; 1) if both side are present, use the side + ;; variable + (setq copy-to-right (if (eq node-side 'both) + (eq side 'left) + ;; 2) if one of sides is absent, copy from + ;; the side where the file is present + (eq node-side 'left))) + ;; 3) in both cases determine if the destination + ;; directory is in place + (setq source-path (if copy-to-right node-left node-right) + destination-path (if copy-to-right + (ztree-diff-node-right-path parent) + (ztree-diff-node-left-path parent))) + (when (and source-path destination-path + (yes-or-no-p (format "Copy [%s]%s to [%s]%s/ ?" + (if copy-to-right "LEFT" "RIGHT") + (ztree-diff-node-short-name node) + (if copy-to-right "RIGHT" "LEFT") + destination-path))) + (if (file-directory-p source-path) + (ztree-diff-copy-dir node + source-path + destination-path + copy-to-right) + (ztree-diff-copy-file node + source-path + destination-path + copy-to-right)))))))) + +(defun ztree-diff-view-file () + "View file at point, depending on side." + (interactive) + (let ((found (ztree-find-node-at-point))) + (when found + (let* ((node (car found)) + (side (cdr found)) + (node-side (ztree-diff-node-side node)) + (node-left (ztree-diff-node-left-path node)) + (node-right (ztree-diff-node-right-path node))) + (when (or (eq node-side 'both) + (eq side node-side)) + (cond ((and (eq side 'left) + node-left) + (view-file node-left)) + ((and (eq side 'right) + node-right) + (view-file node-right)))))))) + + +(defun ztree-diff-delete-file () + "Delete the file under the cursor." + (interactive) + (let ((found (ztree-find-node-at-point))) + (when found + (let* ((node (car found)) + (side (cdr found)) + (node-side (ztree-diff-node-side node)) + (parent (ztree-diff-node-parent node)) + ;; algorithm for determining what to delete similar to copy: + ;; 1. if the file is present on both sides, delete + ;; from the side currently selected + ;; 2. if one of sides is absent, delete + ;; from the side where the file is present + (delete-from-left + (or (eql node-side 'left) + (and (eql node-side 'both) + (eql side 'left)))) + (remove-path (if delete-from-left + (ztree-diff-node-left-path node) + (ztree-diff-node-right-path node)))) + (when (and parent ; do not delete the root node + (yes-or-no-p (format "Delete the file [%s]%s ?" + (if delete-from-left "LEFT" "RIGHT") + remove-path))) + (let* ((delete-command + (if (file-directory-p remove-path) + #'delete-directory + #'delete-file)) + (children (ztree-diff-node-children parent)) + (err + (condition-case error-trap + (progn + (funcall delete-command remove-path t) + nil) + (error error-trap)))) + (if err + (progn + (message (concat "Error: " (nth 2 err))) + ;; when error happened while deleting the + ;; directory, rescan the node + ;; and update the parents with a new status + ;; of this node + (when (file-directory-p remove-path) + (ztree-diff-model-partial-rescan node))) + ;; if everything ok + ;; if was only on one side + ;; remove the node from children + (if (or (and (eql node-side 'left) + delete-from-left) + (and (eql node-side 'right) + (not delete-from-left))) + (setf (ztree-diff-node-children parent) + (ztree-filter + (lambda (x) (not (ztree-diff-node-equal x node))) + children)) + ;; otherwise update only one side + (mapc (if delete-from-left + (lambda (x) (setf (ztree-diff-node-left-path x) nil)) + (lambda (x) (setf (ztree-diff-node-right-path x) nil))) + (cons node (ztree-diff-node-children node))) + ;; and update diff status + ;; if was ignored keep the old status + (unless (eql (ztree-diff-node-different node) 'ignore) + (setf (ztree-diff-node-different node) 'new)) + ;; finally update all children statuses + (ztree-diff-node-update-diff-from-parent node))) + (ztree-diff-node-update-all-parents-diff node) + (ztree-refresh-buffer (line-number-at-pos)))))))) + + + +(defun ztree-diff-node-ignore-p (node) + "Determine if the NODE is in filter list. +If the node is in the filter list it shall not be visible, +unless it is a parent node." + (let ((name (ztree-diff-node-short-name node))) + ;; ignore then + ;; not a root and is in filter list + (and (ztree-diff-node-parent node) + (ztree-find ztree-diff-filter-list #'(lambda (rx) (string-match rx name)))))) + + +(defun ztree-node-is-visible (node) + "Determine if the NODE should be visible." + (let ((diff (ztree-diff-node-different node))) + ;; visible then + ;; either it is a root. root have no parent + (or (not (ztree-diff-node-parent node)) ; parent is always visible + ;; or the files are different or orphan + (or (eql diff 'new) + (eql diff 'diff)) + ;; or it is ignored but we show ignored for now + (and (eql diff 'ignore) + ztree-diff-show-filtered-files) + ;; or they are same but we show same for now + (and (eql diff 'same) + ztree-diff-show-equal-files)))) + +(defun ztree-diff-toggle-show-equal-files () + "Toggle visibility of the equal files." + (interactive) + (setq ztree-diff-show-equal-files (not ztree-diff-show-equal-files)) + (message (concat (if ztree-diff-show-equal-files "Show" "Hide") " equal files")) + (ztree-refresh-buffer)) + +(defun ztree-diff-toggle-show-filtered-files () + "Toggle visibility of the filtered files." + (interactive) + (setq ztree-diff-show-filtered-files (not ztree-diff-show-filtered-files)) + (message (concat (if ztree-diff-show-filtered-files "Show" "Hide") " filtered files")) + (ztree-refresh-buffer)) + + +(defun ztree-diff-update-wait-message (&optional msg) + "Update the wait message MSG with one more `.' progress indication." + (if msg + (setq ztree-diff-wait-message msg) + (when ztree-diff-wait-message + (setq ztree-diff-wait-message (concat ztree-diff-wait-message ".")))) + (message ztree-diff-wait-message)) + +;;;###autoload +(defun ztree-diff (dir1 dir2) + "Create an interactive buffer with the directory tree of the path given. +Argument DIR1 left directory. +Argument DIR2 right directory." + (interactive "DLeft directory \nDRight directory ") + (unless (and dir1 (file-directory-p dir1)) + (error "Path %s is not a directory" dir1)) + (unless (file-exists-p dir1) + (error "Path %s does not exist" dir1)) + (unless (and dir2 (file-directory-p dir2)) + (error "Path %s is not a directory" dir2)) + (unless (file-exists-p dir2) + (error "Path %s does not exist" dir2)) + (unless (ztree-same-host-p dir1 dir2) + (error "Compared directories are not on the same host")) + (let* ((model + (ztree-diff-node-create nil dir1 dir2 nil)) + (buf-name (concat "*" + (ztree-diff-node-short-name model) + " <--> " + (ztree-diff-node-right-short-name model) + "*"))) + ;; after this command we are in a new buffer, + ;; so all buffer-local vars are valid + (ztree-view buf-name + model + 'ztree-node-is-visible + 'ztree-diff-insert-buffer-header + 'ztree-diff-node-short-name-wrapper + 'ztree-diff-node-is-directory + 'ztree-diff-node-equal + 'ztree-diff-node-children + 'ztree-diff-node-face + 'ztree-diff-node-action + 'ztree-diff-node-side) + (ztreediff-mode) + (ztree-diff-model-set-ignore-fun #'ztree-diff-node-ignore-p) + (ztree-diff-model-set-progress-fun #'ztree-diff-update-wait-message) + (setq ztree-diff-dirs-pair (cons dir1 dir2)) + (ztree-diff-update-wait-message (concat "Comparing " dir1 " and " dir2 " ...")) + (ztree-diff-node-recreate model) + (message "Done.") + + (ztree-refresh-buffer))) + + + + + + +(provide 'ztree-diff) +;;; ztree-diff.el ends here diff --git a/ztree-dir.el b/ztree-dir.el new file mode 100644 index 0000000..dada7d0 --- /dev/null +++ b/ztree-dir.el @@ -0,0 +1,204 @@ +;;; ztree-dir.el --- Text mode directory tree -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; +;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com> +;; +;; Created: 2013-11-11 +;; +;; Keywords: files tools +;; URL: https://github.com/fourier/ztree +;; Compatibility: GNU Emacs 24.x +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs 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. +;; +;; GNU Emacs 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: +;; +;; Add the following to your .emacs file: +;; +;; (push (substitute-in-file-name "path-to-ztree-directory") load-path) +;; (require 'ztree-dir) +;; +;; Call the ztree interactive function: +;; M-x ztree-dir +;; Open/close directories with double-click, Enter or Space keys +;; +;;; Issues: +;; +;;; TODO: +;; 1) Add some file-handling and marking abilities +;; +;;; Code: + +(require 'ztree-util) +(require 'ztree-view) +(require 'cl-lib) + +;; +;; Constants +;; + +(defconst ztree-hidden-files-regexp "^\\." + "Hidden files regexp. +By default all filest starting with dot `.', including . and ..") + +;; +;; Configurable variables +;; + +(defvar ztree-dir-move-focus nil + "Defines if move focus to opened window on hard-action command (RETURN) on a file.") + +(defvar-local ztree-dir-filter-list (list ztree-hidden-files-regexp) + "List of regexp file names to filter out. +By default paths starting with dot (like .git) are ignored. +One could add own filters in the following way: + +(setq-default ztree-dir-filter-list (cons \"^.*\\.pyc\" ztree-dir-filter-list)) +") + +(defvar-local ztree-dir-show-filtered-files nil + "Show or not files from the filtered list.") + + +;; +;; Faces +;; + +(defface ztreep-header-face + '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) + (((background dark)) (:height 1.2 :foreground "lightblue" :weight bold)) + (t :height 1.2 :foreground "darkblue" :weight bold)) + "*Face used for the header in Ztree buffer." + :group 'Ztree :group 'font-lock-highlighting-faces) +(defvar ztreep-header-face 'ztreep-header-face) + + +(define-minor-mode ztreedir-mode + "A minor mode for displaying the directory trees in text mode." + ;; initial value + nil + ;; modeline name + " Dir" + ;; The minor mode keymap + `( + (,(kbd "H") . ztree-dir-toggle-show-filtered-files) + (,(kbd ">") . ztree-dir-narrow-to-dir) + (,(kbd "<") . ztree-dir-widen-to-parent))) + + + + +;; +;; File bindings to the directory tree control +;; + +(defun ztree-insert-buffer-header () + "Insert the header to the ztree buffer." + (let ((start (point))) + (insert "Directory tree") + (insert "\n") + (insert "==============") + (set-text-properties start (point) '(face ztreep-header-face))) + (insert "\n")) + +(defun ztree-file-not-hidden (filename) + "Determines if the file with FILENAME should be visible." + (let ((name (ztree-file-short-name filename))) + (and (not (or (string= name ".") (string= name ".."))) + (or + ztree-dir-show-filtered-files + (not (cl-find-if (lambda (rx) (string-match rx name)) ztree-dir-filter-list)))))) + + +(defun ztree-find-file (node hard) + "Find the file at NODE. + +If HARD is non-nil, the file is opened in another window. +Otherwise, the ztree window is used to find the file." + (when (and (stringp node) (file-readable-p node)) + (cond ((and hard ztree-dir-move-focus) + (find-file-other-window node)) + (hard + (save-selected-window (find-file-other-window node))) + (t + (find-file node))))) + + +(defun ztree-dir-toggle-show-filtered-files () + "Toggle visibility of the filtered files." + (interactive) + (setq ztree-dir-show-filtered-files (not ztree-dir-show-filtered-files)) + (message (concat (if ztree-dir-show-filtered-files "Show" "Hide") " filtered files")) + (ztree-refresh-buffer)) + + +(defun ztree-dir-directory-files (path) + "Return the list of files/directories for the given PATH." + ;; remove . and .. from the list of files to avoid infinite + ;; recursion + (cl-remove-if (lambda (x) (string-match-p "/\\.\\.?$" x)) + (directory-files path 'full))) + + +(defun ztree-dir-narrow-to-dir () + "Interactive command to narrow the current directory buffer. +The buffer is narrowed to the directory under the cursor. +If the cursor is on a file, the buffer is narrowed to the parent directory." + (interactive) + (let* ((line (line-number-at-pos)) + (node (ztree-find-node-in-line line)) + (parent (ztree-get-parent-for-line line))) + (if (file-directory-p node) + (ztree-change-start-node node) + (when parent + (ztree-change-start-node (ztree-find-node-in-line parent)))))) + + +(defun ztree-dir-widen-to-parent () + "Interactive command to widen the current directory buffer to parent. +The buffer is widened to the parent of the directory of the current buffer. +This allows to jump to the parent directory if this directory is one level +up of the opened." + (interactive) + (let* ((node ztree-start-node) + (parent (file-name-directory (directory-file-name node)))) + (when parent + (ztree-change-start-node parent)))) + + +;;;###autoload +(defun ztree-dir (path) + "Create an interactive buffer with the directory tree of the PATH given." + (interactive "DDirectory: ") + (when (and (file-exists-p path) (file-directory-p path)) + (let ((buf-name (concat "*Directory " path " tree*"))) + (ztree-view buf-name + (expand-file-name (substitute-in-file-name path)) + #'ztree-file-not-hidden + #'ztree-insert-buffer-header + #'ztree-file-short-name + #'file-directory-p + #'string-equal + #'ztree-dir-directory-files + nil ; face + #'ztree-find-file) ; action + (ztreedir-mode)))) + + + +(provide 'ztree-dir) +;;; ztree-dir.el ends here diff --git a/ztree-pkg.el b/ztree-pkg.el new file mode 100644 index 0000000..ff10730 --- /dev/null +++ b/ztree-pkg.el @@ -0,0 +1,2 @@ +;; Generated package description from ztree.el +(define-package "ztree" "1.0.5" "Text mode directory tree" '((cl-lib "0")) :url "https://github.com/fourier/ztree" :keywords '("files" "tools")) diff --git a/ztree-util.el b/ztree-util.el new file mode 100644 index 0000000..5ac764b --- /dev/null +++ b/ztree-util.el @@ -0,0 +1,98 @@ +;;; ztree-util.el --- Auxiliary utilities for the ztree package -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; +;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com> +;; +;; Created: 2013-11-11 +;; +;; Keywords: files tools +;; URL: https://github.com/fourier/ztree +;; Compatibility: GNU Emacs 24.x +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs 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. +;; +;; GNU Emacs 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: + +;;; Code: +(defun ztree-find (where which) + "Find element of the list WHERE matching predicate WHICH." + (catch 'found + (dolist (elt where) + (when (funcall which elt) + (throw 'found elt))) + nil)) + +(defun ztree-filter (condp lst) + "Filter out elements not satisfying predicate CONDP in the list LST. +Taken from http://www.emacswiki.org/emacs/ElispCookbook#toc39" + (delq nil + (mapcar (lambda (x) (and (funcall condp x) x)) lst))) + + +(defun ztree-printable-string (string) + "Strip newline character from file names, like `Icon\n'. +Argument STRING string to process.'." + (replace-regexp-in-string "\n" "" string)) + + +(defun ztree-file-short-name (file) + "By given FILE name return base file/directory name. +Taken from http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg01238.html" + (let* ((dir (directory-file-name file)) + (simple-dir (file-name-nondirectory dir))) + ;; check if the root directory + (if (string= "" simple-dir) + dir + (ztree-printable-string simple-dir)))) + + +(defun ztree-car-atom (value) + "Return VALUE if value is an atom, otherwise (car value) or nil. +Used since `car-safe' returns nil for atoms" + (if (atom value) value (car value))) + + +(defun ztree-insert-with-face (text face) + "Insert TEXT with the FACE provided." + (let ((start (point))) + (insert text) + (put-text-property start (point) 'face face))) + +(defun ztree-untrampify-filename (file) + "Return FILE as the local file name." + (or (file-remote-p file 'localname) file)) + +(defun ztree-quotify-string (str) + "Surround STR with quotes." + (concat "\"" str "\"")) + +(defun ztree-same-host-p (file1 file2) + "Return t if FILE1 and FILE2 are on the same host." + (let ((file1-remote (file-remote-p file1)) + (file2-remote (file-remote-p file2))) + (string-equal file1-remote file2-remote))) + + +(defun ztree-scroll-to-line (line) + "Recommended way to set the cursor to specified LINE." + (goto-char (point-min)) + (forward-line (1- line))) + + +(provide 'ztree-util) + +;;; ztree-util.el ends here diff --git a/ztree-view.el b/ztree-view.el new file mode 100644 index 0000000..8cf0ced --- /dev/null +++ b/ztree-view.el @@ -0,0 +1,672 @@ +;;; ztree-view.el --- Text mode tree view (buffer) -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; +;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com> +;; +;; Created: 2013-11-11 +;; +;; Keywords: files tools +;; URL: https://github.com/fourier/ztree +;; Compatibility: GNU Emacs 24.x +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs 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. +;; +;; GNU Emacs 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: +;; +;; Add the following to your .emacs file: +;; +;; (push (substitute-in-file-name "path-to-ztree-directory") load-path) +;; (require 'ztree-view) +;; +;; Call the ztree interactive function: +;; Use the following function: ztree-view +;; +;;; Issues: +;; +;;; TODO: +;; +;; +;;; Code: + +(require 'ztree-util) + +;; +;; Globals +;; + +(defvar ztree-draw-unicode-lines nil + "If set forces ztree to draw lines with unicode characters.") + +(defvar-local ztree-expanded-nodes-list nil + "A list of Expanded nodes (i.e. directories) entries.") + +(defvar-local ztree-start-node nil + "Start node(i.e. directory) for the window.") + +(defvar-local ztree-line-to-node-table nil + "List of tuples with full node(i.e. file/directory name and the line.") + +(defvar-local ztree-start-line nil + "Index of the start line - the root.") + +(defvar-local ztree-parent-lines-array nil + "Array of parent lines. +The ith value of the array is the parent line for line i. +If ith value is i - it is the root line") + +(defvar-local ztree-count-subsequent-bs nil + "Counter for the subsequest BS keys (to identify double BS). +Used in order to not to use cl package and `lexical-let'") + +(defvar-local ztree-line-tree-properties nil + "Hash with key - line number, value - property (`left', `right', `both'). +Used for 2-side trees, to determine if the node exists on left or right +or both sides") + +(defvar-local ztree-tree-header-fun nil + "Function inserting the header into the tree buffer. +MUST inster newline at the end!") + +(defvar-local ztree-node-short-name-fun nil + "Function which creates a pretty-printable short string from the node.") + +(defvar-local ztree-node-is-expandable-fun nil + "Function which determines if the node is expandable. +For example if the node is a directory") + +(defvar-local ztree-node-equal-fun nil + "Function which determines if the 2 nodes are equal.") + +(defvar-local ztree-node-contents-fun nil + "Function returning list of node contents.") + +(defvar-local ztree-node-side-fun nil + "Function returning position of the node: `left', `right' or `both'. +If not defined (by default) - using single screen tree, otherwise +the buffer is split to 2 trees") + +(defvar-local ztree-node-face-fun nil + "Function returning face for the node.") + +(defvar-local ztree-node-action-fun nil + "Function called when Enter/Space pressed on the node.") + +(defvar-local ztree-node-showp-fun nil + "Function called to decide if the node should be visible.") + + +;; +;; Major mode definitions +;; + +(defvar ztree-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "\r") 'ztree-perform-action) + (define-key map (kbd "SPC") 'ztree-perform-soft-action) + (define-key map [double-mouse-1] 'ztree-perform-action) + (define-key map (kbd "TAB") 'ztree-jump-side) + (define-key map (kbd "g") 'ztree-refresh-buffer) + (define-key map (kbd "x") 'ztree-toggle-expand-subtree) + (if window-system + (define-key map (kbd "<backspace>") 'ztree-move-up-in-tree) + (define-key map "\177" 'ztree-move-up-in-tree)) + map) + "Keymap for `ztree-mode'.") + + +(defface ztreep-node-face + '((((background dark)) (:foreground "#ffffff")) + (((type nil)) (:inherit 'font-lock-function-name-face)) + (t (:foreground "Blue"))) + "*Face used for expandable entries(directories etc) in Ztree buffer." + :group 'Ztree :group 'font-lock-highlighting-faces) +(defvar ztreep-node-face 'ztreep-node-face) + +(defface ztreep-leaf-face + '((((background dark)) (:foreground "cyan1")) + (((type nil)) (:inherit 'font-lock-variable-name-face)) + (t (:foreground "darkblue"))) + "*Face used for not expandable nodes(leafs, i.e. files) in Ztree buffer." + :group 'Ztree :group 'font-lock-highlighting-faces) +(defvar ztreep-leaf-face 'ztreep-leaf-face) + +(defface ztreep-arrow-face + '((((background dark)) (:foreground "#7f7f7f")) + (t (:foreground "#8d8d8d"))) + "*Face used for arrows in Ztree buffer." + :group 'Ztree :group 'font-lock-highlighting-faces) +(defvar ztreep-arrow-face 'ztreep-arrow-face) + +(defface ztreep-expand-sign-face + '((((background dark)) (:foreground "#7f7fff")) + (t (:foreground "#8d8d8d"))) + "*Face used for expand sign [+] in Ztree buffer." + :group 'Ztree :group 'font-lock-highlighting-faces) +(defvar ztreep-expand-sign-face 'ztreep-expand-sign-face) + + +;;;###autoload +(define-derived-mode ztree-mode special-mode "Ztree" + "A major mode for displaying the directory tree in text mode." + ;; only spaces + (setq indent-tabs-mode nil) + (setq buffer-read-only t)) + + +(defun ztree-find-node-in-line (line) + "Return the node for the LINE specified. +Search through the array of node-line pairs." + (gethash line ztree-line-to-node-table)) + +(defun ztree-find-node-at-point () + "Find the node at point. +Returns cons pair (node, side) for the current point +or nil if there is no node" + (let ((center (/ (window-width) 2)) + (node (ztree-find-node-in-line (line-number-at-pos)))) + (when node + (cons node (if (> (current-column) center) 'right 'left))))) + + +(defun ztree-is-expanded-node (node) + "Find if the NODE is in the list of expanded nodes." + (ztree-find ztree-expanded-nodes-list + #'(lambda (x) (funcall ztree-node-equal-fun x node)))) + + +(defun ztree-set-parent-for-line (line parent) + "For given LINE set the PARENT in the global array." + (aset ztree-parent-lines-array (- line ztree-start-line) parent)) + + +(defun ztree-get-parent-for-line (line) + "For given LINE return a parent." + (when (and (>= line ztree-start-line) + (< line (+ (length ztree-parent-lines-array) ztree-start-line))) + (aref ztree-parent-lines-array (- line ztree-start-line)))) + + +(defun ztree-do-toggle-expand-subtree-iter (node state) + "Iteration in expanding subtree. +Argument NODE current node. +Argument STATE node state." + (when (funcall ztree-node-is-expandable-fun node) + (let ((children (funcall ztree-node-contents-fun node))) + (ztree-do-toggle-expand-state node state) + (dolist (child children) + (ztree-do-toggle-expand-subtree-iter child state))))) + + +(defun ztree-do-toggle-expand-subtree () + "Implements the subtree expand." + (let* ((line (line-number-at-pos)) + (node (ztree-find-node-in-line line)) + ;; save the current window start position + (current-pos (window-start))) + ;; only for expandable nodes + (when (funcall ztree-node-is-expandable-fun node) + ;; get the current expand state and invert it + (let ((do-expand (not (ztree-is-expanded-node node)))) + (ztree-do-toggle-expand-subtree-iter node do-expand)) + ;; refresh buffer and scroll back to the saved line + (ztree-refresh-buffer line) + ;; restore window start position + (set-window-start (selected-window) current-pos)))) + + +(defun ztree-do-perform-action (hard) + "Toggle expand/collapsed state for nodes or perform an action. +HARD specifies (t or nil) if the hard action, binded on RET, +should be performed on node." + (let* ((line (line-number-at-pos)) + (node (ztree-find-node-in-line line))) + (when node + (if (funcall ztree-node-is-expandable-fun node) + ;; only for expandable nodes + (ztree-toggle-expand-state node) + ;; perform action + (when ztree-node-action-fun + (funcall ztree-node-action-fun node hard))) + ;; save the current window start position + (let ((current-pos (window-start))) + ;; refresh buffer and scroll back to the saved line + (ztree-refresh-buffer line) + ;; restore window start position + (set-window-start (selected-window) current-pos))))) + + +(defun ztree-perform-action () + "Toggle expand/collapsed state for nodes or perform the action. +Performs the hard action, binded on RET, on node." + (interactive) + (ztree-do-perform-action t)) + +(defun ztree-perform-soft-action () + "Toggle expand/collapsed state for nodes or perform the action. +Performs the soft action, binded on Space, on node." + (interactive) + (ztree-do-perform-action nil)) + + +(defun ztree-toggle-expand-subtree() + "Toggle Expanded/Collapsed state on all nodes of the subtree" + (interactive) + (ztree-do-toggle-expand-subtree)) + +(defun ztree-do-toggle-expand-state (node do-expand) + "Set the expanded state of the NODE to DO-EXPAND." + (if (not do-expand) + (setq ztree-expanded-nodes-list + (ztree-filter + #'(lambda (x) (not (funcall ztree-node-equal-fun node x))) + ztree-expanded-nodes-list)) + (push node ztree-expanded-nodes-list))) + + +(defun ztree-toggle-expand-state (node) + "Toggle expanded/collapsed state for NODE." + (ztree-do-toggle-expand-state node (not (ztree-is-expanded-node node)))) + + +(defun ztree-move-up-in-tree () + "Action on Backspace key. +Jump to the line of a parent node. If previous key was Backspace +then close the node." + (interactive) + (when ztree-parent-lines-array + (let* ((line (line-number-at-pos (point))) + (parent (ztree-get-parent-for-line line))) + (when parent + (if (and (equal last-command 'ztree-move-up-in-tree) + (not ztree-count-subsequent-bs)) + (let ((node (ztree-find-node-in-line line))) + (when (ztree-is-expanded-node node) + (ztree-toggle-expand-state node)) + (setq ztree-count-subsequent-bs t) + (ztree-refresh-buffer line)) + (progn (setq ztree-count-subsequent-bs nil) + (ztree-scroll-to-line parent))))))) + + +(defun ztree-get-splitted-node-contens (node) + "Return pair of 2 elements: list of expandable nodes and list of leafs. +Argument NODE node which contents will be returned." + (let ((nodes (funcall ztree-node-contents-fun node)) + (comp #'(lambda (x y) + (string< (funcall ztree-node-short-name-fun x) + (funcall ztree-node-short-name-fun y))))) + (cons (sort (ztree-filter + #'(lambda (f) (funcall ztree-node-is-expandable-fun f)) + nodes) + comp) + (sort (ztree-filter + #'(lambda (f) (not (funcall ztree-node-is-expandable-fun f))) + nodes) + comp)))) + + +(defun ztree-draw-char (c x y &optional face) + "Draw char C at the position (1-based) (X Y). +Optional argument FACE face to use to draw a character." + (save-excursion + (ztree-scroll-to-line y) + (beginning-of-line) + (goto-char (+ x (-(point) 1))) + (delete-char 1) + (insert-char c 1) + (put-text-property (1- (point)) (point) 'font-lock-face (if face face 'ztreep-arrow-face)))) + +(defun ztree-vertical-line-char () + "Return the character used to draw vertical line." + (if ztree-draw-unicode-lines #x2502 ?\|)) + +(defun ztree-horizontal-line-char () + "Return the character used to draw vertical line." + (if ztree-draw-unicode-lines #x2500 ?\-)) + +(defun ztree-left-bottom-corner-char () + "Return the character used to draw vertical line." + (if ztree-draw-unicode-lines #x2514 ?\`)) + +(defun ztree-left-intersection-char () + "Return left intersection character. +It is just vertical bar when unicode disabled" + (if ztree-draw-unicode-lines #x251C ?\|)) + +(defun ztree-draw-vertical-line (y1 y2 x &optional face) + "Draw a vertical line of `|' characters from Y1 row to Y2 in X column. +Optional argument FACE face to draw line with." + (let ((ver-line-char (ztree-vertical-line-char)) + (count (abs (- y1 y2)))) + (if (> y1 y2) + (progn + (dotimes (y count) + (ztree-draw-char ver-line-char x (+ y2 y) face)) + (ztree-draw-char ver-line-char x (+ y2 count) face)) + (progn + (dotimes (y count) + (ztree-draw-char ver-line-char x (+ y1 y) face)) + (ztree-draw-char ver-line-char x (+ y1 count) face))))) + +(defun ztree-draw-vertical-rounded-line (y1 y2 x &optional face) + "Draw a vertical line of `|' characters finishing with `\\=`' character. +Draws the line from Y1 row to Y2 in X column. +Optional argument FACE facet to draw the line with." + (let ((ver-line-char (ztree-vertical-line-char)) + (corner-char (ztree-left-bottom-corner-char)) + (count (abs (- y1 y2)))) + (if (> y1 y2) + (progn + (dotimes (y count) + (ztree-draw-char ver-line-char x (+ y2 y) face)) + (ztree-draw-char corner-char x (+ y2 count) face)) + (progn + (dotimes (y count) + (ztree-draw-char ver-line-char x (+ y1 y) face)) + (ztree-draw-char corner-char x (+ y1 count) face))))) + + +(defun ztree-draw-horizontal-line (x1 x2 y) + "Draw the horizontal line from column X1 to X2 in the row Y." + (let ((hor-line-char (ztree-horizontal-line-char))) + (if (> x1 x2) + (dotimes (x (1+ (- x1 x2))) + (ztree-draw-char hor-line-char (+ x2 x) y)) + (dotimes (x (1+ (- x2 x1))) + (ztree-draw-char hor-line-char (+ x1 x) y))))) + + +(defun ztree-draw-tree (tree depth start-offset) + "Draw the TREE of lines with parents. +Argument DEPTH current depth. +Argument START-OFFSET column to start drawing from." + (if (atom tree) + nil + (let* ((root (car tree)) + (children (cdr tree)) + (offset (+ start-offset (* depth 4))) + (line-start (+ 3 offset)) + (line-end-leaf (+ 7 offset)) + (line-end-node (+ 4 offset)) + (corner-char (ztree-left-bottom-corner-char)) + (intersection-char (ztree-left-intersection-char)) + ;; determine if the line is visible. It is always the case + ;; for 1-sided trees; however for 2 sided trees + ;; it depends on which side is the actual element + ;; and which tree (left with offset 0 or right with offset > 0 + ;; we are drawing + (visible #'(lambda (line) () + (if (not ztree-node-side-fun) t + (let ((side + (gethash line ztree-line-tree-properties))) + (cond ((eq side 'left) (= start-offset 0)) + ((eq side 'right) (> start-offset 0)) + (t t))))))) + (when children + ;; draw the line to the last child + ;; since we push'd children to the list, it's the first visible line + ;; from the children list + (let ((last-child (ztree-find children + #'(lambda (x) + (funcall visible (ztree-car-atom x))))) + (x-offset (+ 2 offset))) + (when last-child + (ztree-draw-vertical-line (1+ root) + (ztree-car-atom last-child) + x-offset)) + ;; draw recursively + (dolist (child children) + (ztree-draw-tree child (1+ depth) start-offset) + (let ((end (if (listp child) line-end-node line-end-leaf)) + (row (ztree-car-atom child))) + (when (funcall visible (ztree-car-atom child)) + (ztree-draw-char intersection-char (1- line-start) row) + (ztree-draw-horizontal-line line-start + end + row)))) + ;; finally draw the corner at the end of vertical line + (when last-child + (ztree-draw-char corner-char + x-offset + (ztree-car-atom last-child)))))))) + +(defun ztree-fill-parent-array (tree) + "Set the root lines array. +Argument TREE nodes tree to create an array of lines from." + (let ((root (car tree)) + (children (cdr tree))) + (dolist (child children) + (ztree-set-parent-for-line (ztree-car-atom child) root) + (when (listp child) + (ztree-fill-parent-array child))))) + + +(defun ztree-insert-node-contents (path) + "Insert node contents with initial depth 0. +`ztree-insert-node-contents-1' return the tree of line +numbers to determine who is parent line of the +particular line. This tree is used to draw the +graph. +Argument PATH start node." + (let ((tree (ztree-insert-node-contents-1 path 0)) + ;; number of 'rows' in tree is last line minus start line + (num-of-items (- (line-number-at-pos (point)) ztree-start-line))) + ;; create a parents array to store parents of lines + ;; parents array used for navigation with the BS + (setq ztree-parent-lines-array (make-vector num-of-items 0)) + ;; set the root node in lines parents array + (ztree-set-parent-for-line ztree-start-line ztree-start-line) + ;; fill the parent arrray from the tree + (ztree-fill-parent-array tree) + ;; draw the tree starting with depth 0 and offset 0 + (ztree-draw-tree tree 0 0) + ;; for the 2-sided tree we need to draw the vertical line + ;; and an additional tree + (if ztree-node-side-fun ; 2-sided tree + (let ((width (window-width))) + ;; draw the vertical line in the middle of the window + (ztree-draw-vertical-line ztree-start-line + (1- (+ num-of-items ztree-start-line)) + (/ width 2) + 'vertical-border) + (ztree-draw-tree tree 0 (1+ (/ width 2))))))) + + +(defun ztree-insert-node-contents-1 (node depth) + "Recursively insert contents of the NODE with current DEPTH." + (let* ((expanded (ztree-is-expanded-node node)) + ;; insert node entry with defined depth + (root-line (ztree-insert-entry node depth expanded)) + ;; children list is the list of lines which are children + ;; of the root line + (children nil)) + (when expanded ;; if expanded we need to add all subnodes + (let* ((contents (ztree-get-splitted-node-contens node)) + ;; contents is the list of 2 elements: + (nodes (car contents)) ; expandable entries - nodes + (leafs (cdr contents))) ; leafs - which doesn't have subleafs + ;; iterate through all expandable entries to insert them first + (dolist (node nodes) + ;; if it is not in the filter list + (when (funcall ztree-node-showp-fun node) + ;; insert node on the next depth level + ;; and push the returning result (in form (root children)) + ;; to the children list + (push (ztree-insert-node-contents-1 node (1+ depth)) + children))) + ;; now iterate through all the leafs + (dolist (leaf leafs) + ;; if not in filter list + (when (funcall ztree-node-showp-fun leaf) + ;; insert the leaf and add it to children + (push (ztree-insert-entry leaf (1+ depth) nil) + children))))) + ;; result value is the list - head is the root line, + ;; rest are children + (cons root-line children))) + +(defun ztree-insert-entry (node depth expanded) + "Inselt the NODE to the current line with specified DEPTH and EXPANDED state." + (let ((line (line-number-at-pos)) + (expandable (funcall ztree-node-is-expandable-fun node)) + (short-name (funcall ztree-node-short-name-fun node))) + (if ztree-node-side-fun ; 2-sided tree + (let ((right-short-name (funcall ztree-node-short-name-fun node t)) + (side (funcall ztree-node-side-fun node)) + (width (window-width))) + (when (eq side 'left) (setq right-short-name "")) + (when (eq side 'right) (setq short-name "")) + (ztree-insert-single-entry short-name depth + expandable expanded 0 + (when ztree-node-face-fun + (funcall ztree-node-face-fun node))) + (ztree-insert-single-entry right-short-name depth + expandable expanded (1+ (/ width 2)) + (when ztree-node-face-fun + (funcall ztree-node-face-fun node))) + (puthash line side ztree-line-tree-properties)) + (ztree-insert-single-entry short-name depth expandable expanded 0)) + (puthash line node ztree-line-to-node-table) + (insert "\n") + line)) + +(defun ztree-insert-single-entry (short-name depth + expandable expanded + offset + &optional face) + "Writes a SHORT-NAME in a proper position with the type given. +Writes a string with given DEPTH, prefixed with [ ] if EXPANDABLE +and [-] or [+] depending on if it is EXPANDED from the specified OFFSET. +Optional argument FACE face to write text with." + (let ((node-sign #'(lambda (exp) + (let ((sign (concat "[" (if exp "-" "+") "]"))) + (insert (propertize sign + 'font-lock-face + ztreep-expand-sign-face))))) + ;; face to use. if FACE is not null, use it, otherwise + ;; deside from the node type + (entry-face (cond (face face) + (expandable 'ztreep-node-face) + (t ztreep-leaf-face)))) + ;; move-to-column in contrast to insert reuses the last property + ;; so need to clear it + (let ((start-pos (point))) + (move-to-column offset t) + (remove-text-properties start-pos (point) '(font-lock-face nil))) + (delete-region (point) (line-end-position)) + ;; every indentation level is 4 characters + (when (> depth 0) + (insert-char ?\s (* 4 depth))) ; insert 4 spaces + (when (> (length short-name) 0) + (let ((start-pos (point))) + (if expandable + (funcall node-sign expanded)) ; for expandable nodes insert "[+/-]" + ;; indentation for leafs 4 spaces from the node name + (insert-char ?\s (- 4 (- (point) start-pos)))) + (insert (propertize short-name 'font-lock-face entry-face))))) + + + +(defun ztree-jump-side () + "Jump to another side for 2-sided trees." + (interactive) + (when ztree-node-side-fun ; 2-sided tree + (let ((center (/ (window-width) 2))) + (cond ((< (current-column) center) + (move-to-column (1+ center))) + ((> (current-column) center) + (move-to-column 1)) + (t nil))))) + + + +(defun ztree-refresh-buffer (&optional line) + "Refresh the buffer. +Optional argument LINE scroll to the line given." + (interactive) + (when (and (equal major-mode 'ztree-mode) + (boundp 'ztree-start-node)) + (setq ztree-line-to-node-table (make-hash-table)) + ;; create a hash table of node properties for line + ;; used in 2-side tree mode + (when ztree-node-side-fun + (setq ztree-line-tree-properties (make-hash-table))) + (let ((inhibit-read-only t)) + (erase-buffer) + (funcall ztree-tree-header-fun) + (setq ztree-start-line (line-number-at-pos (point))) + (ztree-insert-node-contents ztree-start-node)) + (ztree-scroll-to-line (if line line ztree-start-line)))) + + +(defun ztree-change-start-node (node) + "Refresh the buffer setting the new root NODE. +This will reuse all other settings for the current ztree buffer, but +change the root node to the node specified." + (setq ztree-start-node node + ztree-expanded-nodes-list (list ztree-start-node)) + (ztree-refresh-buffer)) + + +(defun ztree-view ( + buffer-name + start-node + filter-fun + header-fun + short-name-fun + expandable-p + equal-fun + children-fun + face-fun + action-fun + &optional + node-side-fun + ) + "Create a ztree view buffer configured with parameters given. +Argument BUFFER-NAME Name of the buffer created. +Argument START-NODE Starting node - the root of the tree. +Argument FILTER-FUN Function which will define if the node should not be +visible. +Argument HEADER-FUN Function which inserts the header into the buffer +before drawing the tree. +Argument SHORT-NAME-FUN Function which return the short name for a node given. +Argument EXPANDABLE-P Function to determine if the node is expandable. +Argument EQUAL-FUN An equality function for nodes. +Argument CHILDREN-FUN Function to get children from the node. +Argument FACE-FUN Function to determine face of the node. +Argument ACTION-FUN an action to perform when the Return is pressed. +Optional argument NODE-SIDE-FUN Determines the side of the node." + (let ((buf (get-buffer-create buffer-name))) + (switch-to-buffer buf) + (ztree-mode) + ;; configure ztree-view + (setq ztree-start-node start-node) + (setq ztree-expanded-nodes-list (list ztree-start-node)) + (setq ztree-node-showp-fun filter-fun) + (setq ztree-tree-header-fun header-fun) + (setq ztree-node-short-name-fun short-name-fun) + (setq ztree-node-is-expandable-fun expandable-p) + (setq ztree-node-equal-fun equal-fun) + (setq ztree-node-contents-fun children-fun) + (setq ztree-node-face-fun face-fun) + (setq ztree-node-action-fun action-fun) + (setq ztree-node-side-fun node-side-fun) + (ztree-refresh-buffer))) + + +(provide 'ztree-view) +;;; ztree-view.el ends here diff --git a/ztree.el b/ztree.el new file mode 100644 index 0000000..d615f64 --- /dev/null +++ b/ztree.el @@ -0,0 +1,37 @@ +;;; ztree.el --- Text mode directory tree -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; +;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com> +;; Created: 2013-11-11 +;; Version: 1.0.5 +;; Package-Requires: ((cl-lib "0")) +;; Keywords: files tools +;; URL: https://github.com/fourier/ztree +;; Compatibility: GNU Emacs 24.x +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs 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. +;; +;; GNU Emacs 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: +;; +;; +;;; Code: + +(require 'ztree-dir) +(require 'ztree-diff) + +(provide 'ztree) +;;; ztree.el ends here |