[elpa] externals/ztree 0be261d 5/8: Refactored using generics instead of function variables

[Stefan Monnier]

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)))