[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ztree 0be261d 5/8: Refactored using generics instead of
From: |
Stefan Monnier |
Subject: |
[elpa] externals/ztree 0be261d 5/8: Refactored using generics instead of function variables |
Date: |
Mon, 15 Mar 2021 22:26:16 -0400 (EDT) |
branch: externals/ztree
commit 0be261d4c0f5892441709293fd962a323f1fb34f
Author: Alexey Veretennikov <fourier@protonmail.ch>
Commit: Alexey Veretennikov <fourier@protonmail.ch>
Refactored using generics instead of function variables
---
ztree-diff.el | 61 ++++++++++++++++++++++++++--------
ztree-dir.el | 48 ++++++++++++++++++++++-----
ztree-protocol.el | 98 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
ztree-view.el | 93 +++++++++++-----------------------------------------
4 files changed, 204 insertions(+), 96 deletions(-)
diff --git a/ztree-diff.el b/ztree-diff.el
index 33eca5e..9745053 100644
--- a/ztree-diff.el
+++ b/ztree-diff.el
@@ -563,6 +563,52 @@ unless it is a parent node."
(setq ztree-diff-wait-message (concat ztree-diff-wait-message "."))))
(message ztree-diff-wait-message))
+;;
+;; Implementation of the ztree-protocol
+;;
+
+(cl-defmethod ztree-node-visible-p ((node ztree-diff-node))
+ "Return T if the NODE shall be visible."
+ (ztree-node-is-visible node))
+
+(cl-defmethod ztree-node-short-name ((node ztree-diff-node))
+ "Return the short name for a node."
+ (ztree-diff-node-short-name-wrapper node nil))
+
+(cl-defmethod ztree-node-short-name ((node ztree-diff-node))
+ "Return the short name for a node."
+ (ztree-diff-node-short-name-wrapper node t))
+
+
+(cl-defmethod ztree-node-expandable-p ((node ztree-diff-node))
+ "Return T if the node is expandable."
+ (ztree-diff-node-is-directory node))
+
+(cl-defmethod ztree-node-equal ((node1 ztree-diff-node) (node2
ztree-diff-node))
+ "Equality function for NODE1 and NODE2.
+Return T if nodes are equal"
+ (ztree-diff-node-equal node1 node2))
+
+(cl-defmethod ztree-node-children ((node ztree-diff-node))
+ "Return a list of NODE children"
+ (ztree-diff-node-children node))
+
+(cl-defmethod ztree-node-action ((node ztree-diff-node) hard)
+ "Perform an action when the Return is pressed on a NODE."
+ (ztree-diff-node-action node hard))
+
+(cl-defmethod ztree-node-side ((node ztree-diff-node))
+ "Determine the side of the NODE."
+ (ztree-diff-node-side node))
+
+(cl-defmethod ztree-node-face ((node ztree-diff-node))
+ "Return a face to write a NODE in"
+ (ztree-diff-node-face node))
+
+;;
+;; Entry point
+;;
+
;;;###autoload
(defun ztree-diff (dir1 dir2)
"Create an interactive buffer with the directory tree of the path given.
@@ -589,16 +635,9 @@ Argument DIR2 right directory."
;; after this command we are in a new buffer,
;; so all buffer-local vars are valid
(ztree-view buf-name
+ #'ztree-diff-insert-buffer-header
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)
+ t)
(ztreediff-mode)
(ztree-diff-model-set-ignore-fun #'ztree-diff-node-ignore-p)
(ztree-diff-model-set-progress-fun #'ztree-diff-update-wait-message)
@@ -610,9 +649,5 @@ Argument DIR2 right directory."
(ztree-refresh-buffer)))
-
-
-
-
(provide 'ztree-diff)
;;; ztree-diff.el ends here
diff --git a/ztree-dir.el b/ztree-dir.el
index 1483a65..68daec0 100644
--- a/ztree-dir.el
+++ b/ztree-dir.el
@@ -45,6 +45,7 @@
(require 'ztree-util)
(require 'ztree-view)
+(require 'ztree-protocol)
(eval-when-compile (require 'cl-lib))
;;
@@ -198,7 +199,42 @@ Otherwise open DIRED with the parent directory"
(dired node))
(parent
(dired (ztree-find-node-in-line parent))))))
-
+
+;;
+;; Implementation of the ztree-protocol
+;;
+
+(cl-defmethod ztree-node-visible-p ((file string))
+ "Return T if the NODE shall be visible."
+ (ztree-file-not-hidden file))
+
+(cl-defmethod ztree-node-short-name ((file string))
+ "Return the short name for a node."
+ (ztree-file-short-name file))
+
+(cl-defmethod ztree-node-expandable-p ((file string))
+ "Return T if the node is expandable."
+ (file-directory-p file))
+
+(cl-defmethod ztree-node-equal ((file1 string) (file2 string))
+ "Equality function for NODE1 and NODE2.
+Return T if nodes are equal"
+ (string-equal file1 file2))
+
+(cl-defmethod ztree-node-children ((file string))
+ "Return a list of NODE children"
+ (ztree-dir-directory-files file))
+
+(cl-defmethod ztree-node-action ((file string) hard)
+ "Perform an action when the Return is pressed on a NODE."
+ (ztree-find-file file hard))
+
+;; for ztree-node-side, ztree-node-face, ztree-node-left-short-name
+;; and ztree-node-right-short-name use default implementations
+
+;;
+;; Entry point
+;;
;;;###autoload
(defun ztree-dir (path)
@@ -207,15 +243,9 @@ Otherwise open DIRED with the parent directory"
(when (and (file-exists-p path) (file-directory-p path))
(let ((buf-name (concat "*Directory " path " tree*")))
(ztree-view buf-name
+ #'ztree-insert-buffer-header
(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
+ nil)
(ztreedir-mode))))
diff --git a/ztree-protocol.el b/ztree-protocol.el
new file mode 100644
index 0000000..b458008
--- /dev/null
+++ b/ztree-protocol.el
@@ -0,0 +1,98 @@
+;;; ztree-protocol.el --- generic protocol for ztree-view -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
+;;
+;; Created: 2021-02-12
+;;
+;; 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:
+
+;; Generic protocol for ztree-view
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+
+
+;;; Obligatory to implement
+
+(cl-defgeneric ztree-node-visible-p (node)
+ "Return T if the NODE shall be visible.")
+
+(cl-defgeneric ztree-node-short-name (node)
+ "Return the short name for a node.")
+
+(cl-defgeneric ztree-node-expandable-p (node)
+ "Return T if the node is expandable.")
+
+(cl-defgeneric ztree-node-equal (node1 node2)
+ "Equality function for NODE1 and NODE2.
+Return T if nodes are equal")
+
+(cl-defgeneric ztree-node-children (node)
+ "Return a list of NODE children")
+
+;;; Optional to implement
+(cl-defgeneric ztree-node-side (node)
+ "Determine the side of the NODE.")
+
+(cl-defgeneric ztree-node-face (node)
+ "Return a face to write a NODE in")
+
+(cl-defgeneric ztree-node-action (node)
+ "Perform an action when the Return is pressed on a NODE.")
+
+(cl-defgeneric ztree-node-left-short-name (node)
+ "Return the left short name for a node in 2-sided tree.")
+
+(cl-defgeneric ztree-node-right-short-name (node)
+ "Return the right short name for a node in 2-sided tree.")
+
+
+;;; Default implentations of optional methods
+
+(cl-defmethod ztree-node-side ((node t))
+ (ignore node)
+ :left)
+
+(cl-defmethod ztree-node-face ((node t))
+ "Return a face to write a NODE in"
+ (ignore node))
+
+(cl-defmethod ztree-node-action ((node t) hard)
+ "Perform an action when the Return is pressed on a NODE.
+Argument HARD specifies if the Return was pressed (t) or
+Space (nil)"
+ (ignore node)
+ (ignore hard))
+
+(cl-defmethod ztree-node-left-short-name ((node t))
+ "Return the left short name for a node in 2-sided tree."
+ (ztree-node-short-name node))
+
+(cl-defmethod ztree-node-right-short-name ((node t))
+ "Return the right short name for a node in 2-sided tree."
+ (ztree-node-short-name node))
+
+(provide 'ztree-protocol)
+;;; ztree-protocol.el ends here
diff --git a/ztree-view.el b/ztree-view.el
index c670507..dfc23e4 100644
--- a/ztree-view.el
+++ b/ztree-view.el
@@ -45,7 +45,7 @@
(eval-when-compile (require 'cl-lib))
(require 'subr-x)
(require 'ztree-util)
-
+(require 'ztree-protocol)
;;
;; Globals
;;
@@ -89,38 +89,13 @@ or both sides
"The cons pair of the previous line and column. Used
to restore cursor position after refresh")
+(defvar-local ztree-two-sided-p nil
+ "If the tree is 2 sided, 2 trees shall be drawn side by side")
+
(def-ztree-local-fun ztree-tree-header
"Function inserting the header into the tree buffer.
MUST inster newline at the end!")
-(def-ztree-local-fun ztree-node-short-name
- "Function which creates a pretty-printable short string from the node.")
-
-(def-ztree-local-fun ztree-node-expandable-p
- "Function which determines if the node is expandable.
-For example if the node is a directory")
-
-(def-ztree-local-fun ztree-node-equal
- "Function which determines if the 2 nodes are equal.")
-
-(def-ztree-local-fun ztree-node-children
- "Function returning list of node contents.")
-
-(def-ztree-local-fun ztree-node-side
- "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")
-
-(def-ztree-local-fun ztree-node-face
- "Function returning face for the node.")
-
-(def-ztree-local-fun ztree-node-action
- "Function called when Enter/Space pressed on the node.")
-
-(def-ztree-local-fun ztree-node-visible-p
- "Function called to decide if the node should be visible.")
-
-
;;
;; Major mode definitions
;;
@@ -201,7 +176,7 @@ the buffer is split to 2 trees")
(gethash (line-number-at-pos)
ztree-line-tree-properties)
'offset))
- (when (and ztree-node-side-fun
+ (when (and ztree-two-sided-p
(>= (current-column) center))
(cl-incf offset (1+ center)))
(beginning-of-line)
@@ -280,8 +255,7 @@ should be performed on node."
;; only for expandable nodes
(ztree-toggle-expand-state node)
;; perform action
- (when ztree-node-action-fun
- (ztree-node-action node hard)))
+ (ztree-node-action node hard))
;; save the current window start position
(let ((current-pos (window-start)))
;; refresh buffer and scroll back to the saved line
@@ -452,7 +426,7 @@ Argument START-OFFSET column to start drawing from."
;; 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
+ (if (not ztree-two-sided-p) t
(let ((side
(plist-get (gethash line
ztree-line-tree-properties) 'side)))
(cond ((eq side 'left) (= start-offset 0))
@@ -518,7 +492,7 @@ Argument PATH start node."
(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
+ (if ztree-two-sided-p ; 2-sided tree
(let ((width (window-width)))
;; draw the vertical line in the middle of the window
(ztree-draw-vertical-line ztree-start-line
@@ -573,7 +547,7 @@ Argument PATH start node."
(when (and expandable ztree-show-number-of-children)
(ignore-errors
(length (cl-remove-if (lambda (n)
- (and ztree-node-side-fun
+ (and ztree-two-sided-p
(eql
(ztree-node-side n)
'right)))
@@ -582,13 +556,13 @@ Argument PATH start node."
(when (and expandable ztree-show-number-of-children)
(ignore-errors
(length (cl-remove-if (lambda (n)
- (and ztree-node-side-fun
+ (and ztree-two-sided-p
(eql
(ztree-node-side n)
'left)))
(ztree-node-children node)))))))
- (if ztree-node-side-fun ; 2-sided tree
- (let ((right-short-name (ztree-node-short-name node t))
+ (if ztree-two-sided-p ; 2-sided tree
+ (let ((right-short-name (ztree-node-right-short-name node))
(side (ztree-node-side node))
(width (window-width)))
(when (eq side 'left) (setq right-short-name ""))
@@ -599,13 +573,13 @@ Argument PATH start node."
(ztree-insert-single-entry short-name depth
expandable expanded 0
count-children-left
- (when ztree-node-face-fun
+ (when ztree-two-sided-p
(ztree-node-face
node)))))
;; right side
(ztree-insert-single-entry right-short-name depth
expandable expanded (1+ (/ width 2))
count-children-right
- (when ztree-node-face-fun
+ (when ztree-two-sided-p
(ztree-node-face node)))
(setq line-properties (plist-put line-properties 'side side)))
;; one sided view
@@ -674,7 +648,7 @@ Returns the position where the text starts."
(defun ztree-jump-side ()
"Jump to another side for 2-sided trees."
(interactive)
- (when ztree-node-side-fun ; 2-sided tree
+ (when ztree-two-sided-p ; 2-sided tree
(let ((center (/ (window-width) 2)))
(if (< (current-column) center)
(move-to-column (1+ center))
@@ -759,49 +733,20 @@ change the root node to the node specified."
(ztree-refresh-buffer))))
nil 'visible))
-(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
- )
+(defun ztree-view (buffer-name header-fun start-node &optional two-sided-p)
"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."
+Argument START-NODE Starting node - the root of the tree.
+Optional argument TWO-SIDED-P Determines if the tree is 2-sided (nil by
default)"
(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-visible-p-fun filter-fun)
(setq ztree-tree-header-fun header-fun)
- (setq ztree-node-short-name-fun short-name-fun)
- (setq ztree-node-expandable-p-fun expandable-p)
- (setq ztree-node-equal-fun equal-fun)
- (setq ztree-node-children-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)
+ (setq ztree-two-sided-p two-sided-p)
(add-hook 'window-configuration-change-hook
#'ztree-view-on-window-configuration-changed)
(ztree-refresh-buffer)))
- [elpa] externals/ztree updated (0a5b25f -> dc5f769), Stefan Monnier, 2021/03/15
- [elpa] externals/ztree f658f5a 1/8: Issue #71: Warning: Package cl is deprecated, Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 79a0d6e 2/8: Renamed cl function incf to cl-incf, Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 6eee81d 3/8: Issue #67: LICENSE / COPYING file missing, Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 8f1ff33 6/8: Reimplemented progress reporting., Stefan Monnier, 2021/03/15
- [elpa] externals/ztree dc5f769 8/8: Finalized the refactoring with protocol usage., Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 0be261d 5/8: Refactored using generics instead of function variables,
Stefan Monnier <=
- [elpa] externals/ztree 51b1604 7/8: Fixed bug with not expanded root, Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 07bca6c 4/8: Unified creation of callback functions, Stefan Monnier, 2021/03/15