emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/treeview 7fc5f30552 03/25: Initial commit of treeview.el


From: ELPA Syncer
Subject: [nongnu] elpa/treeview 7fc5f30552 03/25: Initial commit of treeview.el
Date: Sat, 10 Sep 2022 17:59:37 -0400 (EDT)

branch: elpa/treeview
commit 7fc5f30552253627e3c35680b8b6c7b07a5f9a47
Author: Tilman Rassy <tilman.rassy@googlemail.com>
Commit: Tilman Rassy <tilman.rassy@googlemail.com>

    Initial commit of treeview.el
---
 treeview.el | 867 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 867 insertions(+)

diff --git a/treeview.el b/treeview.el
new file mode 100644
index 0000000000..d41aeab7f3
--- /dev/null
+++ b/treeview.el
@@ -0,0 +1,867 @@
+;;; treeview.el --- A generic tree navigation library -*- lexical-binding: t 
-*-
+
+;; Copyright (C) 2018 Tilman Rassy
+
+;; Author: Tilman Rassy <tilman.rassy@googlemail.com>
+;; URL: TODO
+;; Package-Version: 1.0.0
+;; Keywords: lisp, tools, internal, convenience
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Abstract framework for tree navigation.  Based on this framework, specific 
libraries for
+;; particular hierarchical data can be implemented, for example, file systems.
+;; 
+;; A typical tree would look like the following:
+;;
+;;   [+] Node 1
+;;   [-] Node 2
+;;    |    [+] Node 21
+;;    |    [+] Node 22
+;;    |    [-] Node 23
+;;    |     |    [+] Node 231
+;;    |     |      Leaf 231
+;;    |     |      Leaf 232
+;;    |     |      Leaf 233
+;;    |    [+] Node 24
+;;   [+] Node 3
+;;   [+] Node 4
+;;
+;; Each node has a "label".  Non-leaf nodes also have a "control".  The label 
is the text by which
+;; the node is represented.  The control is a clickable piece of text  in 
front of the label which
+;; allows the user to fold or unfold the node.  Nodes without children usually 
don't have a control.
+;; Nodes can also have an icon, but this is optional.  Icons are implemented 
as symbols in an icon
+;; font.  Control, icon, and label are always displayed in this order, and are 
always displayed in
+;; one line.  Thus, multi-line nodes are not supported by this library.
+;;
+;; Nodes are represented by lists of the form:
+;;
+;;   (NAME PROPS PARENT CHILDREN)
+;;
+;; where the elements have the following meaning:
+;;
+;;   NAME      The name of the node.  A string.
+;;
+;;   PROPS     The properties of the node.  A plist.  See below for details.
+;;
+;;   PARENT    The parent of the node.  Another node-representing list.
+;;
+;;   CHILDREN  The children of the node.  List of node-representing lists.
+;;
+;; Node properties are implemented as plists with Lisp symbols as keys.  The 
following
+;; properties exist:
+;;
+;;   node-line-overlay
+;;          The overlay containing the node line
+;;
+;;   indent-overlay
+;;          The overlay containing the node indentation
+;;
+;;   label-overlay
+;;          The overlay containing the node label
+;;
+;;   control-overlay
+;;          The overlay containing the node control
+;;
+;;   icon-overlay
+;;          The overlay containing the node icon
+;;
+;;   start  A marker at the position where the node begins
+;;
+;;   end    A marker at the position where the node ends
+;;
+;;   state  The state of the node.  See below for details
+;;
+;; Node states: Each node is in exactly one of three states, which are 
represented by the
+;; following Lisp symbols:
+;;
+;;   folded-unread   The node is folded and has not been unfolded before
+;;
+;;   folded-read     The node is folded, but has been unfolded before
+;;
+;;   expanded        The node is expanded
+;;
+;; Initially, a node is in the state 'folded-unread'.  If it gets expanded for 
the first time,
+;; the state changes to 'expanded'.  If it gets folded again, the state 
changes to 'folded-read'.
+;; From then, the state toggles between 'expanded' and 'folded-read' each time 
the node is
+;; expanded or folded.
+;;
+;; The framework is used by implementing several functions which are defined 
as function variables,
+;; thus, variables whose values are function symbols.  Here is a list of that 
variables:
+;;
+;;   treeview-node-leaf-p-function
+;;   treeview-update-node-children-function
+;;   treeview-get-indent-function
+;;   treeview-get-indent-face-function
+;;   treeview-get-control-function
+;;   treeview-get-control-margin-left-function
+;;   treeview-get-control-margin-right-function
+;;   treeview-get-icon-function
+;;   treeview-get-icon-margin-left-function
+;;   treeview-get-icon-margin-right-function
+;;   treeview-get-label-function
+;;   treeview-get-label-margin-left-function
+;;   treeview-get-control-keymap-function
+;;   treeview-get-control-face-function
+;;   treeview-get-control-mouse-face-function
+;;   treeview-get-label-keymap-function
+;;   treeview-get-label-face-function
+;;   treeview-get-label-mouse-face-function
+;;   treeview-get-icon-keymap-function
+;;   treeview-get-icon-face-function
+;;   treeview-get-icon-mouse-face-function
+;;   treeview-suggest-point-pos-in-control-function
+;;
+;; A description of each variable can be found in the repsetive documentation 
strings.  All
+;; variables are buffer-local.  Libraries using this framework should create a 
new buffer and
+;; set the variables to particular functions in that buffer.  Then, the root 
node should be
+;; created and rendered in the buffer by a call to treeview-display-node.
+;;
+;; See library "dir-treeview" for an example where this framework is used.
+
+;;; Code:
+
+(intern "treeview")
+(intern "treeview-node")
+(intern "start")
+(intern "end")
+(intern "node-line-overlay")
+(intern "indent-overlay")
+(intern "control-overlay")
+(intern "icon-overlay")
+(intern "label-overlay")
+(intern "state")
+(intern "folded-unread")
+(intern "folded-read")
+(intern "expanded")
+
+(define-error 'treeview-error "Treeview error" 'error)
+(define-error 'treeview-invalid-node-state-error "Invalid node state" 
'treeview-error)
+
+(defun treeview-new-node ()
+  "Create and return a new node.
+The name, parent and children of the new node are nil.  The properties have 
only
+the entry `state' with the value `folder-unread'."
+  (list nil                           ;; name
+        (list 'state 'folded-unread)  ;; properties
+        nil                           ;; parent
+        nil))                         ;; children
+
+(defun treeview-get-node-name (node)
+  "Return the name of NODE."
+  (car node))
+
+(defun treeview-set-node-name (node name)
+  "Set NODE's name to NAME."
+  (setcar node name))
+
+(defun treeview-get-node-props (node)
+  "Return the properties of NODE."
+  (nth 1 node))
+
+(defun treeview-set-node-props (node props)
+  "Set the properties of NODE to PROPS."
+  (setcar (nthcdr 1 node) props))
+
+(defun treeview-get-node-prop (node key)
+  "Return the property KEY of NODE."
+  (plist-get (treeview-get-node-props node) key))
+
+(defun treeview-set-node-prop (node key value)
+  "Set the property KEY of NODE to VALUE."
+  (let ( (props (treeview-get-node-props node)) )
+    (treeview-set-node-props node (plist-put props key value))))
+
+(defun treeview-get-node-state (node)
+  "Return the state of NODE."
+  (treeview-get-node-prop node 'state))
+
+(defun treeview-set-node-state (node state)
+  "Set the state of NODE to STATE."
+  (unless (memq state '(folded-unread folded-read expanded))
+    (error 'treeview-invalid-node-state-error state))
+  (treeview-set-node-prop node 'state state))
+
+(defun treeview-node-unread-p (node)
+  "Return non-nil if NODE's children have not been read yet.
+This is the case if, and only if, NODE's state is `folded-unread'."
+  (eq (treeview-get-node-state node) 'folded-unread))
+
+(defun treeview-node-folded-p (node)
+  "Return non-nil if NODE is folded.
+This is the case is and only if NODES's state is `folded-unred' or 
`folded-read'."
+  (memq (treeview-get-node-state node) '(folded-unread folded-read)))
+
+(defun treeview-node-expanded-p (node)
+  "Return non-nil if NODE is expanded, otherwise nil."
+  (eq (treeview-get-node-state node) 'expanded))
+
+(defun treeview-get-node-parent (node)
+  "Return the parent of NODE."
+  (nth 2 node))
+
+(defun treeview-set-node-parent (node parent)
+  "Set the parent of NODE to PARENT."
+  (setcar (nthcdr 2 node) parent))
+
+(defun treeview-get-node-children (node)
+  "Return the children of NODE."
+  (nth 3 node))
+
+(defun treeview-set-node-children (node children)
+  "Set the children of NODE to CHILDREN."
+  (setcar (nthcdr 3 node) children))
+
+(defun treeview-get-parent-children (node)
+  "Return the children of the parent of NODE.
+If NODE has no parent, return nil."
+  (let ( (parent (treeview-get-node-parent node)) )
+    (if parent (treeview-get-node-children parent) )))
+
+(defun treeview-last-child-p (node)
+  "Return non-nil of NODE is the last child, otherwise nil."
+  (let ( (parent (treeview-get-node-parent node)) )
+    (or (not parent)
+        (let* ( (parent-children (treeview-get-node-children parent))
+                (last-parent-child (if parent-children (car (last 
parent-children)))) )
+          (eq last-parent-child node)))))
+
+(defun treeview-parent-is-last-child-p (node)
+  "Return non-nil if the parent of NODE is the last child of its parent,  
otherwise nil."
+  (let ( (parent (treeview-get-node-parent node)) )
+    (if parent (treeview-last-child-p parent) t)))
+
+(defvar treeview-node-leaf-p-function
+  (lambda (node)
+    (or (treeview-node-unread-p node) (not (treeview-get-node-children node))))
+  "Function that returns non-nil if NODE is a leaf of the tree.
+The default implementation considers a node to be a leaf if, and only if, the
+node has no children or is unread (i.e., its state is 'folded-unred'.")
+
+(make-variable-buffer-local 'treeview-node-leaf-p-function)
+
+(defun treeview-node-leaf-p (node)
+  "Return non-nil if NODE is a leaf of the tree; otherwise, return nil.
+Calls the buffer local function `treeview-node-leaf-p-function' with one 
argument, NODE."
+  (funcall treeview-node-leaf-p-function node))
+
+(defun treeview-put (&rest args)
+  "Insert ARGS at point.
+Each element of ARGS may be a string, a character, nil, or a list.  If nil, the
+element is ignored.  If a list, the function recursively calls itself."
+  (while args
+    (let ( (arg (car args)) )
+      (if arg (if (listp arg) (apply 'treeview-put arg) (insert arg)))
+      (setq args (cdr args)) )))
+
+(defun treeview-return-nil (_node)
+  "Return nil.
+Default implementation of functions that provide optional data, e.g.,
+`treeview-get-control-face-function'.  The argument _NODE is ignored."
+  nil)
+
+(defun treeview--not-nil-or-empty-string-p (str)
+  "Return non-nil if STR is neither nil nor the empty string."
+  (and str (not (string-equal str ""))))
+
+(defvar treeview-update-node-children-function nil
+  "Function that updates the children of a node.
+Called with one argument, the node.  For example, if the nodes represent
+directories, this function could re-read the directory to update the children.
+The function should not redisplay the node, this is done automatically.")
+
+(make-variable-buffer-local 'treeview-update-node-children-function)
+
+(defvar treeview-get-indent-function nil
+  "Function to create the indentation before a node.
+Called with one argument, the node.  Should return a list of strings.  These 
are
+concatenated to the indentation.")
+
+(make-variable-buffer-local 'treeview-get-indent-function)
+
+(defvar treeview-get-control-function 'treeview-return-nil
+  "Function to create and return the control of a node.
+Called with one argument, the node.  Should return a string or nil.  In the
+latter case the node  does not get a control.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-control-function)
+
+(defvar treeview-get-control-margin-left-function 'treeview-return-nil
+  "Function to create the left margin of a node control.
+Called with one argument, the node.  The return value is inserted with
+`treeview-put'.  Thus, the return value  must be a string, a character, nil, or
+a list.  If nil, the left margin is suppressed.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-control-margin-left-function)
+
+(defvar treeview-get-control-margin-right-function 'treeview-return-nil
+  "Function to create the right margin of a node control.
+Called with one argument, the node.  The return value is inserted with
+`treeview-put'.  Thus, the return value  must be a string, a character, nil, or
+a list.  If nil, the right margin is suppressed.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-control-margin-right-function)
+
+(defvar treeview-get-icon-function 'treeview-return-nil
+  "Function to create and return the icon of a node.
+Called with one argument, the node.  Should return a string or nil.  In the
+latter case the node  does not get an icon.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-icon-function)
+
+(defvar treeview-get-icon-margin-left-function 'treeview-return-nil
+  "Function to create the left margin of a node icon.
+Called with one argument, the node.  The return value is inserted with
+`treeview-put'.  Thus, the return value  must be a string, a character, nil, or
+a list.  If nil, the left margin is suppressed.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-icon-margin-left-function)
+
+(defvar treeview-get-icon-margin-right-function 'treeview-return-nil
+  "Function to create the right margin of a node icon.
+Called with one argument, the node.  The return value is inserted with
+`treeview-put'.  Thus, the return value  must be a string, a character, nil, or
+a list.  If nil, the right margin is suppressed.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-icon-margin-right-function)
+
+(defvar treeview-get-label-function 'treeview-return-nil
+  "Function to create and retrun the label of a node.
+Called with one argument, the node.  Should return a string or nil.  In the
+latter case the node does not get a label.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-label-function)
+
+(defvar treeview-get-label-margin-left-function 'treeview-return-nil
+  "Function to create the left margin of a node label.
+Called with one argument, the node.  The return value is inserted with
+`treeview-put'.  Thus, the return value  must be a string, a character, nil, or
+a list.  If nil, the left margin is suppressed.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-label-margin-left-function)
+
+(defvar treeview-get-control-keymap-function 'treeview-return-nil
+  "Function to get the keymap of the control of a node.
+Called with one argument, the node.  The return value is passed as the KEYMAP
+argument to `treeview-make-node-component-overlay'.  Thus, the return value 
must
+be a keymap or nil.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-control-keymap-function)
+
+(defvar treeview-get-indent-face-function 'treeview-return-nil
+  "Function to get the face of the indentation of a node.
+Called with one argument, the node.  The return value is passed as the FACE
+argument to `treeview-make-node-component-overlay'.  Thus, the return value 
must
+be a face or nil.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-indent-face-function)
+
+(defvar treeview-get-control-face-function 'treeview-return-nil
+  "Function to get the face of the control of a node.
+Called with one argument, the node.  The return value is passed as the FACE
+argument to `treeview-make-node-component-overlay'.  Thus, the return value 
must
+be a face or nil.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-control-face-function)
+
+(defvar treeview-get-control-mouse-face-function 'treeview-return-nil
+  "Function to get the mouse face of the control of a node.
+Called with one argument, the node.  The return value is passed as the
+MOUSE-FACE argument to `treeview-make-node-component-overlay'.  Thus, the 
return
+value must be a face or nil.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-control-mouse-face-function)
+
+(defvar treeview-get-label-keymap-function 'treeview-return-nil
+  "Function to get the keymap of the label of a node.
+Called with one argument, the node.  The return value is passed as the KEYMAP
+argument to `treeview-make-node-component-overlay'.  Thus, the return value 
must
+be a keymap or nil.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-label-keymap-function)
+
+(defvar treeview-get-label-face-function 'treeview-return-nil
+  "Function to get the mouse face of the label of a node.
+Called with one argument, the node.  The return value is passed as the
+MOUSE-FACE argument to `treeview-make-node-component-overlay'.  Thus, the
+return value must be a face or nil.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-label-face-function)
+
+(defvar treeview-get-label-mouse-face-function 'treeview-return-nil
+  "Function to get the mouse face of the label of a node.
+Called with one argument, the node.  The return value is passed as the
+MOUSE-FACE argument to `treeview-make-node-component-overlay'.  Thus, the
+return value must be a face or nil.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-label-mouse-face-function)
+
+(defvar treeview-get-icon-keymap-function 'treeview-return-nil
+  "Function to get the keymap of the icon of a node.
+Called with one argument, the node.  The return value is passed as the KEYMAP
+argument to `treeview-make-node-component-overlay'.  Thus, the return value 
must
+be a keymap or nil.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-icon-keymap-function)
+
+(defvar treeview-get-icon-face-function 'treeview-return-nil
+  "Function to get the mouse face of the icon of a node.
+Called with one argument, the node.  The return value is passed as the
+MOUSE-FACE argument to `treeview-make-node-component-overlay'.  Thus, the 
return
+value must be a face or nil.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-icon-face-function)
+
+(defvar treeview-get-icon-mouse-face-function 'treeview-return-nil
+  "Function to get the mouse face of the icon of a node.
+Called with one argument, the node.  The return value is passed as the
+MOUSE-FACE argument to `treeview-make-node-component-overlay'.  Thus, the
+return value must be a face or nil.
+
+The default implementation is `treeview-return-nil'.")
+
+(make-variable-buffer-local 'treeview-get-icon-mouse-face-function)
+
+(defun treeview-get-node-at-pos (pos)
+  "Return the node at the buffer position POS, or nil if there is no node at 
that position."
+  (let ( (overlays (overlays-at pos t))
+         (node nil) )
+    (while (and overlays (not node))
+      (setq node (overlay-get (car overlays) 'treeview-node)
+            overlays (cdr overlays)))
+    node))
+
+(defun treeview-get-node-at-point ()
+  "Return the node at point, or nil if there is no node at point."
+  (treeview-get-node-at-pos (point)))
+
+(defun treeview-get-node-at-event (event)
+  "Return the node at the position of EVENT.
+If there is no node at that position, nil is returned.  The function assumes
+that the event occurred in the current buffer, and that the current buffer is a
+treeview buffer.  It should be called only if this is guaranteed."
+  (treeview-get-node-at-pos (posn-point (event-start event))))
+
+(defun treeview-first-line-p ()
+  "Return non-nil if point is in the first line of the buffer, otherwise nil."
+  (save-excursion
+    (beginning-of-line)
+    (bobp)))
+
+(defun treeview-last-line-p ()
+  "Return non-nil if point is in the last line of the buffer, otherwise nil."
+  (save-excursion
+    (end-of-line)
+    (eobp)))
+
+(defun treeview-find-node-in-current-line ()
+  "Find and return the node in the current line.
+If there is no node in the current line, return nil."
+  (treeview-get-node-at-pos (point)))
+
+(defun treeview-find-next-node ()
+  "Find and return the next node in the lines following the current line.
+If no such node exists, return nil."
+  (save-excursion
+    (let ( (node nil) )
+      (while (not (or (treeview-last-line-p) node))
+        (forward-line)
+        (setq node (treeview-get-node-at-point)))
+      node)))
+
+(defun treeview-find-previous-node ()
+  "Find and return the previous node.
+This is the closest node in the lines preceeding the current line.  If no such
+node exists, return nil."
+  (save-excursion
+    (let ( (node nil) )
+      (while (not (or (treeview-first-line-p) node))
+        (forward-line -1)
+        (setq node (treeview-get-node-at-point)))
+      node)))
+
+(defun treeview-inside-node-p (pos node)
+  "Return non-nil if POS is a position inside NODE, otherwise nil."
+  (and (<= (marker-position (treeview-get-node-prop node 'start)) pos)
+       (<= pos (marker-position (treeview-get-node-prop node 'end)))))
+
+(defun treeview-make-node-component-overlay (node content &optional keymap 
face mouse-face)
+  "Create an overlay representing a specific component of a node.
+
+This function is used to create the imdemtation, control, icon, and label
+overlays of nodes.  NODE is the node to which the overlay belongs.  The
+`treeview-node' property of the overlay is set to NODE.  CONTENT is a string.
+It is inserted as the content of the overlay.  If non-nil, KEYMAP, FACE, and
+MOUSE-FACE are the keymap, face, and mouse face of the overlay, respectively.
+
+The overlay is inserted at the current point position.  Thus, the overlay
+starts where the point was when the function was called.  The point is moved
+to the position after the overlay end by this function.
+
+The overlay gets the priority 300.
+
+The function returns the new overlay."
+  (let* ( (start (point))
+          (overlay (progn (treeview-put content) (make-overlay start 
(point)))) )
+    (overlay-put overlay 'treeview t)
+    (overlay-put overlay 'treeview-node node)
+    (overlay-put overlay 'priority 300)
+    (if keymap (overlay-put overlay 'keymap keymap))
+    (if face (overlay-put overlay 'face face))
+    (if mouse-face (overlay-put overlay 'mouse-face mouse-face))
+    overlay))
+
+(defun treeview-make-node-line-overlay (node start end)
+  "Create the overlay covering the line of NODE.
+
+NODE is the node to which the overlay belongs.  The `treeview-node' property of
+the overlay is set to NODE.  START and END are the start and end positions of
+the overlay (integers or markers).  They should point to the beginning and end
+of the line containing NODE, respectively.
+
+The overlay gets the priority 200.
+
+The function returns the new overlay."
+  (let ( (overlay (make-overlay start end)) )
+    (overlay-put overlay 'treeview t)
+    (overlay-put overlay 'treeview-node node)
+    (overlay-put overlay 'priority 200)
+    overlay))
+
+(defun treeview-make-text-overlay (text &optional keymap face mouse-face)
+  "Insert TEXT at point and create and return an overlay containing that text.
+If non-nil, KEYMAP, FACE, and MOUSE-FACE become the keymap, face, and mouse 
face
+of the overlay, respectively (see overlay documentation in the Emacs Lisp 
reference)."
+  (let* ( (start (point))
+          (overlay (progn (insert text) (make-overlay start (point)))) )
+    (if keymap (overlay-put overlay 'keymap keymap))
+    (if face (overlay-put overlay 'face face))
+    (if mouse-face (overlay-put overlay 'mouse-face mouse-face))
+    overlay))
+
+(defun treeview-set-node-start (node &optional pos)
+  "Set the start marker of NODE to POS.
+If POS is nil, do nothing."
+  (if pos (treeview-set-node-prop node 'start (copy-marker pos))))
+
+(defun treeview-set-node-end (node &optional pos type)
+  "Set the end marker of NODE.
+The end marker is set to POS and its insertion type  to TYPE (see
+`marker-insertion-type').  POS must be an integer buffer position or a marker,
+and defaults to the current end marker of NODE (this can be used to change the
+latter's insertion type).  If POS is nil and its default is also nil, nothing
+is done."
+  (if (not pos) (setq pos (treeview-get-node-prop node 'end)))
+  (if pos (treeview-set-node-prop node 'end (copy-marker pos type))))
+
+(defun treeview-display-node-internal (node &optional append-newline-p)
+  "Display NODE, i.e., render it in the current buffer.
+The node is placed at the current line.  All descendent nodes are rendered by
+calling this function recursively.  If APPEND-NEWLINE-P is non-nil, a newline
+is appended to the node.
+
+This is an auxiliary function used in `treeview-display-node'."
+  (let ( (start nil)
+         ;; Indentation:
+         (indent (funcall treeview-get-indent-function node))
+         (indent-face (funcall treeview-get-indent-face-function node))
+         (indent-overlay nil)
+         ;; Control:
+         (control-margin-left (funcall 
treeview-get-control-margin-left-function node))
+         (control-content (funcall treeview-get-control-function node))
+         (control-keymap (funcall treeview-get-control-keymap-function node))
+         (control-face (funcall treeview-get-control-face-function node))
+         (control-mouse-face (funcall treeview-get-control-mouse-face-function 
node))
+         (control-margin-right (funcall 
treeview-get-control-margin-right-function node))
+         (control-overlay nil)
+         ;; Icon:
+         (icon-margin-left (funcall treeview-get-icon-margin-left-function 
node))
+         (icon-content (funcall treeview-get-icon-function node))
+         (icon-keymap (funcall treeview-get-icon-keymap-function node))
+         (icon-face (funcall treeview-get-icon-face-function node))
+         (icon-mouse-face (funcall treeview-get-icon-mouse-face-function node))
+         (icon-margin-right (funcall treeview-get-icon-margin-right-function 
node))
+         (icon-overlay nil)
+         ;; Label:
+         (label-margin-left (funcall treeview-get-label-margin-left-function 
node))
+         (label-content (funcall treeview-get-label-function node))
+         (label-keymap (funcall treeview-get-label-keymap-function node))
+         (label-face (funcall treeview-get-label-face-function node))
+         (label-mouse-face (funcall treeview-get-label-mouse-face-function 
node))
+         (label-overlay nil)
+         ;; Node line:
+         (node-line-overlay nil) )
+    (beginning-of-line)
+    (setq start (point))
+    (treeview-set-node-start node start)
+    (treeview-set-node-end node start t)
+    ;; Indentation:
+    (when indent
+      (setq indent-overlay
+            (treeview-make-node-component-overlay node indent nil 
indent-face)))
+    ;; Control:
+    (treeview-put control-margin-left)
+    (when control-content
+      (setq control-overlay
+            (treeview-make-node-component-overlay node control-content 
control-keymap control-face control-mouse-face)))
+    (treeview-put control-margin-right)
+    ;; Icon:
+    (treeview-put icon-margin-left)
+    (when icon-content
+      (setq icon-overlay
+            (treeview-make-node-component-overlay node icon-content 
icon-keymap icon-face icon-mouse-face)))
+    (treeview-put icon-margin-right)
+    ;; Label:
+    (treeview-put label-margin-left)
+    (setq label-overlay
+          (treeview-make-node-component-overlay node label-content 
label-keymap label-face label-mouse-face))
+    ;; Node line:
+    (setq node-line-overlay (treeview-make-node-line-overlay node start 
(point)))
+    (unless (treeview-node-folded-p node)
+      (let ( (children (treeview-get-node-children node)) )
+        (if children (newline))
+        (while children
+          (treeview-display-node-internal (car children) (setq children (cdr 
children)))) ))
+    (treeview-set-node-end node nil nil)
+    (if append-newline-p (newline))
+    (treeview-set-node-prop node 'indent-overlay indent-overlay)
+    (treeview-set-node-prop node 'control-overlay control-overlay)
+    (treeview-set-node-prop node 'icon-overlay icon-overlay)
+    (treeview-set-node-prop node 'label-overlay label-overlay)
+    (treeview-set-node-prop node 'node-line-overlay node-line-overlay) ))
+
+(defun treeview-set-node-end-after-display (node)
+  "Set the insertion type of the end marker of NODE and its descendants to t.
+This is an auxiliary function used in `treeview-display-node'."
+  (treeview-set-node-end node nil t)
+  (unless (treeview-node-folded-p node)
+    (let ( (children (treeview-get-node-children node)) )
+      (while children
+        (progn
+          (treeview-set-node-end-after-display (car children))
+          (setq children (cdr children))) ))))
+
+(defun treeview-display-node (node &optional append-newline-p)
+  "Display NODE, i.e., render it in the current buffer.
+
+The node is placed at the current line.  All descendent nodes are rendered as
+well unless they are folded.  If APPEND-NEWLINE-P is non-nil, a newline is
+appended to the node.
+
+The main implementation is outsourced and split into two other functions:
+`treeview-display-node-internal' and `treeview-set-node-end-after-display'.
+The first one does the rendering, the latter one fixes the
+`marker-insertion-type's of the end markers of the rendered nodes."
+  (let ( (read-only-p buffer-read-only) )
+    (setq buffer-read-only nil)
+    (treeview-display-node-internal node append-newline-p)
+    (treeview-set-node-end-after-display node)
+    (setq buffer-read-only read-only-p) ))
+
+(defun treeview--recursivlely-remove-overlays (node)
+  "Remove all overlays of NODE and its descendents."
+  (let ( (overlay-prop-keys '(indent-overlay control-overlay icon-overlay 
label-overlay node-line-overlay)) )
+    (while overlay-prop-keys
+      (let* ( (overlay-prop-key (car overlay-prop-keys))
+              (overlay (treeview-get-node-prop node overlay-prop-key)) )
+        (treeview-set-node-prop node overlay-prop-key nil)
+        (if overlay (delete-overlay overlay))
+        (setq overlay-prop-keys (cdr overlay-prop-keys)) )))
+  (let ( (children (treeview-get-node-children node)) )
+    (while children
+      (progn
+        (treeview--recursivlely-remove-overlays (car children))
+        (setq children (cdr children)) ))) )
+
+(defun treeview-erase-node (node)
+  "Remove NODE and all its descendents from the display in the buffer.
+
+The 'start' and 'end' properties of NODE are set to nil.  Except this, the
+internal representation of the tree is not altered.  Neither NODE or its
+descendents are removed from the children of their respective parents.
+
+The main purpose of this function is to implement the
+`treeview-redisplay-node' function."
+  (let* ( (read-only-p buffer-read-only)
+          (start (treeview-get-node-prop node 'start))
+          (end (treeview-get-node-prop node 'end)) )
+    (treeview--recursivlely-remove-overlays node)
+    (setq buffer-read-only nil)
+    (delete-region start end)
+    (treeview-set-node-prop node 'start nil)
+    (treeview-set-node-prop node 'end nil)
+    (setq buffer-read-only read-only-p)))
+
+(defun treeview-redisplay-node (node)
+  "Redisplay NODE.
+
+NODE is erased by `treeview-erase-node' and displayed again by
+`treeview-display-node'.  This function can be used to update the display of a
+node after it has changed."
+  (let ( (start-marker (treeview-get-node-prop node 'start)) )
+    (treeview-erase-node node)
+    (goto-char start-marker)
+    (treeview-display-node node)))
+
+(defun treeview-expand-node (node)
+  "Expands NODE."
+  (treeview-set-node-state node 'expanded)
+  (funcall treeview-update-node-children-function node))
+
+(defun treeview-fold-node (node)
+  "Folds NODE."
+  (treeview-set-node-state node 'folded-read)
+  (funcall treeview-update-node-children-function node))
+
+(defun treeview-update-node (node)
+  "Update NODE.
+
+If NODE is not folded, the following is done: First, the function calls
+`treeview-update-node-children-function' for NODE.  Then, the function
+calls itself for all children of NODE.
+
+If NODE is not folded, does nothing."
+  (unless (treeview-node-folded-p node)
+    (funcall treeview-update-node-children-function node)
+    (let ( (children (treeview-get-node-children node)) )
+      (while children
+        (progn
+          (treeview-update-node (car children))
+          (setq children (cdr children))) )) ))
+
+(defun treeview-toggle-node-state (node)
+  "Unfolds NODE if it is folded, folds it if it is unfolded."
+  (if (treeview-node-folded-p node) (treeview-expand-node node) 
(treeview-fold-node node))
+  (treeview-redisplay-node node))
+
+(defun treeview-toggle-node-state-at-event (event)
+  "Toggle the state of the node where EVENT occurred.
+
+EVENT may for example be a mouse click.  If there there is no node at the
+position where EVENT occurred, does nothing.
+
+See also `treeview-toggle-node-state'."
+  (interactive "@e")
+  (let ( (node (treeview-get-node-at-event event)) )
+    (when node
+      (treeview-toggle-node-state node)
+      (mouse-set-point event))))
+
+(defun treeview-toggle-node-state-at-point ()
+  "Toggle the state of the node at point.
+If there is no node at point, does nothing.
+
+See also `treeview-toggle-node-state'."
+  (interactive)
+  (let ( (node (treeview-get-node-at-pos (point))) )
+    (if node
+        (let ( (old-pos (point)) )
+          (treeview-toggle-node-state (treeview-get-node-at-pos (point)))
+          (goto-char old-pos)))))
+
+(defun treeview-get-overlay-center (overlay)
+  "Return the position of the center of OVERLAY."
+  (let* ( (start (overlay-start overlay))
+          (end (overlay-end overlay))
+          (offset (/ (- end start) 2)) )
+    (+ start offset)))
+
+(defvar treeview-suggest-point-pos-in-control-function 
'treeview-get-overlay-center
+  "Function to suggest an appropriate position for the point in a node control.
+Called with one argument, the control overlay.  Auxiliary for implementing
+functions with move the point to the control of a node.")
+
+(make-variable-buffer-local 'treeview-suggest-point-pos-in-control-function)
+
+(defun treeview-place-point-in-node (node)
+  "Move the point to an appropriate position in NODE.
+
+If NODE has a control, point is placed at the position obtained by calling
+`treeview-suggest-point-pos-in-control-function' with the control overlay as
+argument.  Otherwise, point is placed at the beginning of the label."
+  (goto-char
+   (or
+    ;; Control:
+    (let ( (control-overlay (treeview-get-node-prop node 'control-overlay)) )
+      (if control-overlay
+          (funcall treeview-suggest-point-pos-in-control-function 
control-overlay)))
+    ;; Label:
+    (overlay-start (treeview-get-node-prop node 'label-overlay)))))
+
+(defun treeview-next-line ()
+  "Move the point one line down, and, if there is a node in that line, move 
the point to the node."
+  (interactive)
+  (forward-line)
+  (let ( (node (treeview-get-node-at-point)) )
+    (if node (treeview-place-point-in-node node))))
+
+(defun treeview-previous-line ()
+  "Move the point one line up, and, if there is a node in that line, move the 
point to the node."
+  (interactive)
+  (forward-line -1)
+  (let ( (node (treeview-get-node-at-point)) )
+    (if node (treeview-place-point-in-node node))))
+
+(defun treeview-make-keymap (key-table)
+  "Create and return a keymap from KEY-TABLE.
+The latter must be an alist whose car's are strings describing key sequences in
+a format understood by `kbd', and whose cdr's are commands."
+  (let ( (keymap (make-keymap)) )
+    (while key-table
+      (let* ( (key-def (car key-table))
+              (key-seq (car key-def))
+              (key-cmd (cdr key-def)) )
+        (define-key keymap (kbd key-seq) key-cmd)
+        (setq key-table (cdr key-table))))
+    keymap))
+
+(provide 'treeview)
+
+;;; treeview.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]