;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-

;; Copyright (C) 2020 Alexander Miller

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:
;;; API required for writing extensions for/with treemacs.

;;; Code:

(require 's)
(require 'dash)
(require 'treemacs)

(eval-when-compile
  (require 'treemacs-macros)
  (require 'cl-lib))

(eval-when-compile
  (cl-declaim (optimize (speed 3) (safety 0))))

(defconst treemacs-treelib-version "1.1")

(defconst treemacs--treelib-async-load-string
  (propertize " Loading …"
              'face 'treemacs-async-loading-face
              'treemacs-async-string t))

(defvar treemacs--extension-registry nil
  "Alist storage of extension instances.
The car is a symbol of an extension node's state, the cdr the instance of the
`treemacs-extension' type.")

(defvar treemacs--async-update-count (make-hash-table :size 5 :test 'equal)
  "Holds the count of nodes an async update needs to process.
The count is used as finish condition in `treemacs--async-update-part-complete'.")

(defvar treemacs--async-update-cache (make-hash-table :size 20 :test 'equal)
  "Holds to pre-computed cache for async updates.
Set by `treemacs--async-update-part-complete'.")

(cl-defstruct (treemacs-extension
               (:conc-name treemacs-extension->)
               (:constructor treemacs-extension->create!))

  ;; only for comparisons
  name

  ;; open/close
  closed-state
  open-state
  closed-icon
  open-icon

  ;; produces full list of child items to render
  children

  ;; produces a key for one item returned by children
  key

  ;; produces a text label for one item returned by children
  label

  ;; plist of additional text properties for on item returned by children
  more-properties

  ;; Struct instance of child nodes returned by children
  child-type

  ;; used for entry-point render method selection
  variadic?

  ;; special treatment for asynchronous behavior
  async?

  ;; used as a check when the extension is enabled
  entry-point?)

(define-inline treemacs--ext-symbol-to-instance (symbol)
  "Derive an extension instance from the given SYMBOL."
  (declare (side-effect-free t))
  (inline-letevals (symbol)
    (inline-quote
     (symbol-value (intern (format "treemacs-%s-extension-instance" ,symbol))))))

(defun treemacs--compare-extensions-by-name (e1 e2)
  "Compare E1 and E2 by their names."
  (declare (side-effect-free t))
  ;; take into account cells used by functions like `tremacs-define-project-extension'
  (let ((e1 (if (consp e1) (car e1) e1))
        (e2 (if (consp e2) (car e2) e2)))
    (equal (treemacs-extension->name e1)
           (treemacs-extension->name e2))))

(defmacro treemacs-extension->get (self field &rest args)
  "Access helper for the lambda fields of `treemacs-extension' instances.
Takes SELF's given FIELD and `funcall's it with ARGS."
  (let* ((field-name (substring (symbol-name field) 1))
         (fn (intern (s-lex-format "treemacs-extension->${field-name}"))))
    `(funcall (,fn ,self) ,@args)))

(cl-macrolet
    ((build-extension-addition
      (name)
      (let ((define-function-name   (intern (s-lex-format "treemacs-enable-${name}-extension")))
            (top-extension-point    (intern (s-lex-format "treemacs--${name}-top-extensions")))
            (bottom-extension-point (intern (s-lex-format "treemacs--${name}-bottom-extensions"))))
        `(progn
           (defvar ,top-extension-point nil)
           (defvar ,bottom-extension-point nil)
           (cl-defun ,define-function-name (&key extension predicate position)
             ,(s-lex-format
               "Enable a `${name}' level EXTENSION for treemacs to use.

EXTENSION is a `treemacs-extension' instance as created by
`treemacs-define-entry-node-type'

PREDICATE is a function that will be called to determine whether the extension
should be displayed. It is invoked with a single argument, which is the
project struct or directory that is being expanded.

POSITION is either `top' or `bottom', indicating whether the extension should be
rendered as the first or last element.

See also `treemacs-disable-${name}-extension'.")
             (let* ((ext-instance (treemacs--ext-symbol-to-instance extension))
                    (cell (cons ext-instance predicate)))
               (treemacs-static-assert (treemacs-extension-p ext-instance)
                 "Given argument is not a valid `treemacs-extension': %s" extension)
               (treemacs-static-assert (treemacs-extension->entry-point? ext-instance)
                 "The given extension '%s' is not an entry point" extension)
               (pcase position
                 ('top    (add-to-list ',top-extension-point cell nil #'treemacs--compare-extensions-by-name))
                 ('bottom (add-to-list ',bottom-extension-point cell nil #'treemacs--compare-extensions-by-name))
                 (other   (error "Invalid extension position value `%s'" other)))
               t)))))
     (build-extension-removal
      (name)
      (let ((remove-function-name   (intern (s-lex-format "treemacs-disable-${name}-extension")))
            (top-extension-point    (intern (s-lex-format "treemacs--${name}-top-extensions")))
            (bottom-extension-point (intern (s-lex-format "treemacs--${name}-bottom-extensions"))))
        `(progn
           (cl-defun ,remove-function-name (&key extension position)
             ,(s-lex-format
               "Remove a `${name}' EXTENSION at the given POSITION.
See also `treemacs-enable-${name}-extension'.")
             (-let [ext-instance (treemacs--ext-symbol-to-instance extension)]
               (treemacs-static-assert (treemacs-extension-p ext-instance)
                 "Given argument is not a valid `treemacs-extension': %s" extension)
               (pcase position
                 ('top
                  (setf ,top-extension-point
                        (--remove-first (treemacs--compare-extensions-by-name it ext-instance)
                                        ,top-extension-point)))
                 ('bottom
                  (setf ,bottom-extension-point
                        (--remove-first (treemacs--compare-extensions-by-name it ext-instance)
                                        ,bottom-extension-point)))
                 (other
                  (error "Invalid extension position value `%s'" other))))
             t))))
     (build-extension-application
      (name)
      (let ((apply-top-name         (intern (s-lex-format "treemacs--apply-${name}-top-extensions")))
            (apply-bottom-name      (intern (s-lex-format "treemacs--apply-${name}-bottom-extensions")))
            (top-extension-point    (intern (s-lex-format "treemacs--${name}-top-extensions")))
            (bottom-extension-point (intern (s-lex-format "treemacs--${name}-bottom-extensions"))))
        `(progn
           (defun ,apply-top-name (node data)
             ,(s-lex-format
               "Apply the top `${name}' extensions for NODE.
Also pass additional DATA to predicate function.")
             (dolist (cell ,top-extension-point)
               (let ((extension (car cell))
                     (predicate (cdr cell)))
                 (when (or (null predicate) (funcall predicate data))
                   (if (functionp extension)
                       ;; TODO(2020/05/30): old-school extensions
                       ;; to be removed eventually
                       (funcall extension node)
                     (treemacs--extension-entry-render extension node))))))

           (defun ,apply-bottom-name (node data)
             ,(s-lex-format
               "Apply the `${name}' bottom extensions for NODE.
Also pass additional DATA to predicate function.")
             (dolist (cell ,bottom-extension-point)
               (let ((extension (car cell))
                     (predicate (cdr cell)))
                 (when (or (null predicate) (funcall predicate data))
                   (if (functionp extension)
                       ;; TODO(2020/05/30): old-school extensions
                       ;; to be removed eventually
                       (funcall extension node)
                     (treemacs--extension-entry-render extension node)))))))))
     (build-top-level-extension-application
      (pos)
      (let ((name     (intern (s-lex-format "treemacs--apply-root-${pos}-extensions")))
            (variable (intern (s-lex-format "treemacs--top-level-${pos}-extensions"))))
        `(defun ,name (workspace &optional has-previous)
           ,(s-lex-format
             "Apply the ${pos} `top-level' extensions for the current WORKSPACE.
Also pass additional DATA to predicate function.")
           (let ((is-first (not has-previous)))
             (--each ,variable
               (let ((extension (car it))
                     (predicate (cdr it)))
                 (when (or (null predicate) (funcall predicate workspace))
                   (unless is-first
                     (treemacs--insert-root-separator))
                   ;; TODO(2020/05/30): old-school extensions
                   ;; to be removed eventually
                   (setf is-first (if (functionp extension)
                                      (funcall extension)
                                    (treemacs--render-extension extension))))))
             (not is-first))))))
  (build-extension-addition    "project")
  (build-extension-removal     "project")
  (build-extension-application "project")
  (build-extension-addition    "directory")
  (build-extension-removal     "directory")
  (build-extension-application "directory")
  (build-extension-addition    "top-level")
  (build-extension-removal     "top-level")
  (build-top-level-extension-application "top")
  (build-top-level-extension-application "bottom"))

(cl-defmacro treemacs-do-define-extension-type
    (name &key
          children
          more-properties
          key
          label
          open-icon
          closed-icon
          child-type
          ;; visit-action
          ret-action
          no-tab?
          variadic?
          async?
          entry-point?)

  "Base building block for extension node setup.
Not meant for direct use.  Instead one of the following macros should be
employed:

 - `treemacs-define-leaf-node-type'
 - `treemacs-define-expandable-node-type'
 - `treemacs-define-entry-node-type'
 - `treemacs-define-variadic-entry-node-type'

NAME of this node type is a symbol.  After an extension is defined the NAME
symbol can be passed to a function like `treemacs-initialize' or
`treemacs-enable-top-level-extension' to make start using it.

CHILDREN is a form to query a list of items to be rendered as children when a
node is expanded.  The node being expanded is available as a variable under the
name `btn'.  It is a `button' in the sense of the built-in button.el library
\(really just a marker to a buffer position), so its text-properties can be
extracted via `(treemacs-button-get node :property)' (see also MORE-PROPERTIES).
In addition the item (as produced by the form passed here) that was used to
create the node will also be available under the name `item'.

KEY, LABEL, OPEN-ICON, CLOSE-ICON and MORE-PROPERTIES all act on one of the
items produced by CHILDREN.  The node and the item that produced it will be
bound under the names `btn' and `item' respectively.

KEY is a form to generate a semi-unique key for a given node for one of the
items produced by CHILDREN.  Semi-unique means that nodes' keys don't all have
to be unique on their own, it is only necessary that a node's path - the list of
all node keys starting from the top level root leading to a specific node - must
be un-ambiguous.

LABEL is a form to query a node's text label (the text after the icon) for one
of the items produced by CHILDREN.  The return value should be a string.

OPEN-ICON and CLOSED-ICON are forms to determine the icons used for the node's
open and closed states.  The return value should be a string.

MORE-PROPERTIES is a form to produce a plist that will be saved as additional
text-properties in a given node.  These properties can later be accessed when
querying the node's CHILDREN (see above).

CHILD-TYPE is, unlike all the other arguments, not a form, but a quoted symbol.
It must refer to the NAME argument of a another (or the same) extension type and
determines the behaviours (LABEL etc.) used to create the children of the node
type being defined here.

RET-ACTION is the function that is called when RET is pressed on a node of this
be able to handle both a closed and open state.  If no explicit RET-ACTION type.
The function is called with a single argument - the prefix arg - and must
argument is given RET will do the same as TAB.

NO-TAB indicates that pressing TAB on this node type should do nothing.  It will
be set by `treemacs-define-leaf-node'.

VARIADIC is only relevant for entry-point nodes and indicates that the extension
will produces multiple nodes when first rendered.

ASYNC will enable an asynchronous, callback-based fetching of CHILDREN.  When it
is non-nil the function passed to children will be called with the 3rd argument
`callback'.  It should be invoked via `funcall' with the items that were
produced asynchronously.

If the asynchronous execution fails the `callback' should be called with a list
in the form \(`:async-error' error-message\).  Treemacs will take care of
cleanup and logging the error.

ENTRY-POINT indicates that the node type defined here is an entry-point for an
extension, it will be used as a type-check when enabling an extension with e.g.
`treemacs-enable-top-level-extension'."

  (declare (indent 1))

  (let* ((child-type   (cadr child-type))
         (child-name   (intern (s-lex-format "treemacs-${child-type}-extension-instance")))
         (struct-name  (intern (s-lex-format "treemacs-${name}-extension-instance")))
         (open-state   (intern (s-lex-format "treemacs-${name}-open")))
         (closed-state (intern (s-lex-format "treemacs-${name}-closed")))
         (children-fn  (if async?
                           `(lambda (&optional btn item callback) (ignore btn item callback) ,children)
                         `(lambda (&optional btn item) (ignore btn item) ,children))))
    `(progn
       (defconst ,struct-name
         (treemacs-extension->create!
          :name            ',name
          :variadic?       ,variadic?
          :async?          ,async?
          :children        ,children-fn
          :entry-point?    ,entry-point?
          :label           (lambda (&optional btn item) "" (ignore item) (ignore btn) ,label)
          :key             (lambda (&optional btn item) "" (ignore item) (ignore btn) ,key)
          :open-icon       (lambda (&optional btn item) "" (ignore item) (ignore btn) ,open-icon)
          :closed-icon     (lambda (&optional btn item) "" (ignore item) (ignore btn) ,closed-icon)
          :more-properties (lambda (&optional btn item) "" (ignore item) (ignore btn) ,more-properties)
          :child-type      (lambda ()                   "" (symbol-value ',child-name))
          :open-state      (lambda ()                   "" ',open-state)
          :closed-state    (lambda ()                   "" ',closed-state)))

       (treemacs-define-TAB-action
        ',closed-state
        ,(cond
          (no-tab?   '#'ignore)
          (variadic? '#'treemacs--expand-variadic-parent)
          (t         '#'treemacs-expand-extension-node)))
       (treemacs-define-TAB-action ',open-state   ,(if no-tab? '#'ignore '#'treemacs-collapse-extension-node))
       (treemacs-define-RET-action ',closed-state ,(or ret-action (if no-tab? '#'ignore '#'treemacs-expand-extension-node)))
       (treemacs-define-RET-action ',open-state   ,(or ret-action (if no-tab? '#'ignore '#'treemacs-collapse-extension-node)))

       (add-to-list 'treemacs--extension-registry (cons ',closed-state ,struct-name))
       (add-to-list 'treemacs--extension-registry (cons ',open-state   ,struct-name))

       (add-to-list 'treemacs--closed-node-states ',closed-state)
       (add-to-list 'treemacs--open-node-states   ',open-state)
       (add-to-list 'treemacs-valid-button-states ',closed-state)
       (add-to-list 'treemacs-valid-button-states ',open-state)

       ',struct-name)))

(cl-defmacro treemacs-define-leaf-node-type
    (name &key
          icon
          label
          key
          more-properties
          ret-action)

  "Define a type of node that is a leaf and cannot be further expanded.
The NAME, ICON, LABEL and KEY arguments are mandatory.

MORE-PROPERTIES and RET-ACTION are optional.

For a detailed description of all arguments see
`treemacs-do-define-extension-type'."

  (declare (indent 1))

  (treemacs-static-assert icon  ":icon parameter is mandatory")
  (treemacs-static-assert label ":label parameter is mandatory")
  (treemacs-static-assert key   ":key parameter is mandatory")

  `(treemacs-do-define-extension-type ,name
     :key ,key
     :label ,label
     :more-properties (nconc '(:leaf t) ,more-properties)
     :closed-icon ,icon
     :ret-action ,ret-action
     :no-tab? t
     :children (lambda () (error "Called :children of leaf node"))
     :child-type (lambda () (error "Called :child-type of leaf node"))))

(cl-defmacro treemacs-define-expandable-node-type
    (name &key
          closed-icon
          open-icon
          label
          key
          children
          child-type
          more-properties
          ret-action
          async?)

  "Define a general-purpose expandable node-type.
The NAME, CLOSED-ICON, OPEN-ICON LABEL, KEY, CHILDREN and CHILD-TYPE arguments
are mandatory.

MORE-PROPERTIES, RET-ACTION and ASYNC are optional.

For a detailed description of all arguments see
`treemacs-do-define-extension-type'."

  (declare (indent 1))

  (treemacs-static-assert closed-icon ":closed-icon parameter is mandatory")
  (treemacs-static-assert open-icon   ":open-icon parameter is mandatory")
  (treemacs-static-assert label       ":label parameter is mandatory")
  (treemacs-static-assert key         ":key parameter is mandatory")
  (treemacs-static-assert children    ":children parameter is mandatory")
  (treemacs-static-assert child-type  ":child-type parameter is mandatory")

  `(treemacs-do-define-extension-type ,name
     :closed-icon ,closed-icon
     :open-icon   ,open-icon
     :label ,label
     :key ,key
     :children ,children
     :child-type ,child-type
     :more-properties ,more-properties
     :ret-action ,ret-action
     :async? ,async?))

(cl-defmacro treemacs-define-entry-node-type
    (name &key
          key
          label
          open-icon
          closed-icon
          children
          child-type
          more-properties
          ret-action
          async?)

  "Define a node type with NAME that serves as an entry-point for an extension.

The KEY, LABEL, OPEN-ICON CLOSED-ICON, CHILDREN and CHILD-TYPE arguments are
mandatory.

MORE-PROPERTIES, RET-ACTION and ASYNC are optional.

For a detailed description of all arguments see
`treemacs-do-define-extension-type'."

  (declare (indent 1))

  (treemacs-static-assert key         ":key parameter is mandatory")
  (treemacs-static-assert label       ":label parameter is mandatory")
  (treemacs-static-assert open-icon   ":open-icon parameter is mandatory")
  (treemacs-static-assert closed-icon ":closed-icon parameter is mandatory")
  (treemacs-static-assert children    ":childen parameter is mandatory")
  (treemacs-static-assert child-type  ":child-type parameter is mandatory")

  `(treemacs-do-define-extension-type ,name
     :key ,key
     :label ,label
     :open-icon ,open-icon
     :closed-icon ,closed-icon
     :children ,children
     :child-type ,child-type
     :more-properties ,more-properties
     :async? ,async?
     :ret-action ,ret-action
     :entry-point? t))

(cl-defmacro treemacs-define-variadic-entry-node-type
    (name &key
          key
          children
          child-type)

  "Define a node type that serves as an entry-point for a variadic extension.
'Variadic' means that the extension will produce multiple nodes when it is first
rendered instead of just one (e.g. a single 'Buffer List' node vs multiple nodes
each grouping buffers by major mode).

The NAME symbol can be passed to `treemacs-initialize' to render this extension
in a buffer.

The KEY, CHILDREN and CHILD-TYPE arguments are mandatory.

For a detailed description of all arguments see
`treemacs-do-define-extension-type'."

  (declare (indent 1))

  (treemacs-static-assert key         ":key parameter is mandatory")
  (treemacs-static-assert children    ":childen parameter is mandatory")
  (treemacs-static-assert child-type  ":child-type parameter is mandatory")

  `(treemacs-do-define-extension-type ,name
     :open-icon ""
     :key ,key
     :closed-icon ""
     :children ,children
     :child-type ,child-type
     :variadic? t
     :entry-point? t))

(defun treemacs--render-extension (ext &optional expand-depth)
  "Render the entry point of the given extension EXT.

Also serves as an entry point to render an extension in an independent buffer
outside of treemacs proper.

EXPAND-DEPTH indicates the additional recursion depth.

EXT: `treemacs-extension' instance
EXPAND-DEPTH: Int"
  (when (symbolp ext)
    (setf ext (treemacs--ext-symbol-to-instance ext)))
  (if (treemacs-extension->variadic? ext)
      (treemacs--variadic-extension-entry-render ext expand-depth)
    (treemacs--singular-extension-entry-render ext)))

(defun treemacs--singular-extension-entry-render (ext)
  "Render the entry point of the given singular top level extension EXT.
Will create and insert the required strings and make a new dom entry.

EXT: `treemacs-extension' instance"
  (treemacs-with-writable-buffer
   (let* ((label (treemacs-extension->get ext :label))
          (key (treemacs-extension->get ext :key))
          (project (treemacs-project->create!
                    :name label
                    :path key
                    :path-status 'extension))
          (dom-node (treemacs-dom-node->create!
                     :key key
                     :position (point-marker))))
     (treemacs-dom-node->insert-into-dom! dom-node)
     (insert (treemacs-extension->get ext :closed-icon))
     (setf (treemacs-dom-node->position dom-node) (point-marker))
     (insert (propertize
              label
              'button '(t)
              'category 'default-button
              :custom t
              :key key
              :path key
              :depth 0
              :project project
              :state (treemacs-extension->get ext :closed-state)))))
  nil)

(defun treemacs--variadic-extension-entry-render (ext &optional expand-depth)
  "Render the entry point of the given variadic top level extension EXT.
Will create and insert the required strings and make a new dom entry.

EXPAND-DEPTH indicates the additional recursion depth.

EXT: `treemacs-extension' instance
EXPAND-DEPTH: Int"
  (save-excursion
    (treemacs-with-writable-buffer
     ;; When the extension is variadic it will be managed by a hidden top-level
     ;; node. Its depth is -1 and it is not visible, but can still be used to update
     ;; the entire extension without explicitly worrying about complex dom changes.
     (let* ((key (treemacs-extension->get ext :key nil nil))
            (path (list key))
            (pr (treemacs-project->create!
                 :name (treemacs-extension->get ext :label nil nil)
                 :path path
                 :path-status 'extension))
            (button-start (point-marker))
            (dom-node (treemacs-dom-node->create!
                       :key path
                       :position (point-marker))))
       (treemacs-dom-node->insert-into-dom! dom-node)
       (insert (propertize "Hidden node"
                           'button '(t)
                           'category 'default-button
                           'invisible t
                           'skip t
                           :custom t
                           :key key
                           :path path
                           :depth -1
                           :project pr
                           :state (treemacs-extension->get ext :closed-state)))
       (let ((marker (copy-marker (point) t)))
         (treemacs--do-expand-variadic-parent button-start ext expand-depth)
         (goto-char marker)))))
  t)

(cl-defmacro treemacs--create-node-strings
    (&key parent
          parent-path
          parent-dom-node
          more-properties
          icon
          state
          key
          depth
          label)

  "Create the strings needed to render an extension node.

PARENT: Button
PARENT-PATH: List<?>
PARENT-DOM-NODE: Dom Node Struct
MORE-PROPERTIES: Plist
ICON: String
STATE: Symbol
KEY: Any
DEPTH: Int
LABEL: String"

  (macroexp-let2* nil
      ((key key))
    `(let* ((path (append ,parent-path (list ,key)))
            (dom-node (treemacs-dom-node->create! :key path :parent parent-dom-node))
            (props ,more-properties)
            (ann (treemacs-get-annotation path)))
       (treemacs-dom-node->insert-into-dom! dom-node)
       (when ,parent-dom-node
         (treemacs-dom-node->add-child! parent-dom-node dom-node))
       (list (unless (zerop depth) prefix)
             ,icon
             (apply
              #'propertize ,label
              'button '(t)
              'category 'default-button
              'help-echo nil
              :custom t
              :state ,state
              :parent ,parent
              :depth ,depth
              :path path
              :key ,key
              :no-git t
              props)
             (and ann (treemacs-annotation->suffix-value ann))
             (when (zerop depth) (if treemacs-space-between-root-nodes "\n\n" "\n"))))))

;; render method for extensions by the old version of the api
(defun treemacs--extension-entry-render (ext parent)
  "Render the entry point of the given extension EXT under PARENT.
Will create and insert the required strings and make a new dom entry.

EXT: `treemacs-extension' instance
PARENT: Button"
  (let* ((key (treemacs-extension->get ext :key))
         (depth (1+ (treemacs-button-get parent :depth)))
         (path (list (treemacs-button-get parent :path) key))
         (parent-dom-node (treemacs-find-in-dom (treemacs-button-get parent :path)))
         (new-dom-node (treemacs-dom-node->create! :key path :parent parent-dom-node)))
    (treemacs-dom-node->insert-into-dom! new-dom-node)
    (when parent-dom-node
      (treemacs-dom-node->add-child! parent-dom-node new-dom-node))
    (insert "\n")
    (insert
     (treemacs--get-indentation depth)
     (treemacs-extension->get ext :closed-icon)
     (propertize (treemacs-extension->get ext :label)
                 'button '(t)
                 'category 'default-button
                 :custom t
                 :key key
                 :path path
                 :depth depth
                 :no-git t
                 :parent parent
                 :state (treemacs-extension->get ext :closed-state))))
  nil)

(defun treemacs-expand-extension-node (&optional arg)
  "Expand a node created with the extension api.
If a prefix ARG is provided expand recursively."
  (interactive "P")
  (let* ((btn (treemacs-node-at-point))
         (state (treemacs-button-get btn :state))
         (path (treemacs-button-get btn :path))
         (ext (alist-get state treemacs--extension-registry))
         (eol (line-end-position))
         (already-loading
          (/= eol
             (next-single-property-change
              (line-beginning-position) 'treemacs-async-string nil eol))))
    (when (null ext)
      (error "No extension is registered for state '%s'" state))
    (unless (or (treemacs-button-get btn :leaf) already-loading)
      (-let [async-cache (ht-get treemacs--async-update-cache path)]
        (treemacs-with-writable-buffer
         (cond
          (async-cache
           ;; IMPORTANT
           ;; Asynchronous updates must be directed *very* carefully.
           ;; If there is no pre-computed cache the expand happens normally with
           ;; a "Loading..." string and normal async delay.
           ;; If the cache already exists then we at first open the async nodes
           ;; as if they were normal nodes, using the cache as their items.
           ;; Then, in the background, we start an asynchronous update via
           ;; `treemacs-update-async-node'.
           ;; However this first mundane node expansion will trigger re-entry, so
           ;; every child that is re-entered might trigger its own async update,
           ;; which is bad for 2 reasons:
           ;; 1. `treemacs-update-async-node' already updates a full path
           ;; including all its children
           ;; 2. At the end of every update is a call to `treemacs-update-node'
           ;; with a new async cache, causing another round of re-entry and
           ;; potential async updates.
           ;; In short: there is strong potential for an infinite loop!
           ;;
           ;; To keep this from happening the async background update must be
           ;; suppressed for all nodes but the very first, both for re-entry and
           ;; the final update.
           ;; This is achieved by setting the `busy' flag at the first async
           ;; node, and only starting the second update if, and only if, neither
           ;; the current node, nor any of its parents, are marked as busy.
           (let* ((busy? (treemacs-button-get btn :busy))
                  (parent btn))
             (unless busy?
               (while (and (not busy?)
                           (setf parent (treemacs-button-get parent :parent)))
                 (setf busy? (treemacs-button-get parent :busy))))
             (unless busy?
               (treemacs-button-put btn :busy t))
             (treemacs--do-expand-extension-node
              btn ext async-cache arg)
             (unless busy?
               (treemacs-update-async-node path))))
          ((treemacs-extension->async? ext)
           (treemacs--do-expand-async-extension-node btn ext arg))
          (t
           (treemacs--do-expand-extension-node btn ext nil arg))))))))

(defun treemacs-collapse-extension-node (&optional arg)
  "Collapse a node created with the extension api.
If a prefix ARG is provided expand recursively."
  (interactive "P")
  (let* ((btn (treemacs-node-at-point))
         (state (treemacs-button-get btn :state))
         (ext (alist-get state treemacs--extension-registry)))
    (when (null ext)
      (error "No extension is registered for state '%s'" state))
    (treemacs--do-collapse-extension-node btn ext arg)))

(defun treemacs--do-expand-async-extension-node (btn ext &optional arg)
  "Expand an async extension node BTN for the given extension EXT.
Prefix ARG is used to set expand recursion depth.

BTN: Button
EXT: `treemacs-extension' instance
ARG: Prefix Arg"
  (interactive)
  (treemacs-block
   (treemacs-error-return-if (not (eq (treemacs-extension->get ext :closed-state)
                                      (treemacs-button-get btn :state)))
     "This function cannot expand a node of type '%s'."
     (propertize (format "%s" (treemacs-button-get btn :state))
                 'face 'font-lock-type-face))
   (save-excursion
     (treemacs-with-writable-buffer
      (goto-char (line-end-position))
      (insert treemacs--treelib-async-load-string)))
   (funcall
    (treemacs-extension->children ext)
    btn
    (treemacs-button-get btn :item)
    (lambda (items)
      (ht-set! treemacs--async-update-cache (treemacs-button-get btn :path)
               (or items 'nothing))
      (treemacs--complete-async-expand-callback btn items ext arg)))))

(defun treemacs--complete-async-expand-callback (btn items ext arg)
  "Properly expand an async node at BTN after its child ITEMS were computed.

BTN: Button
ITEMS: List<Any>
EXT: `treemacs-extension' instance
ARG: Prefix Arg"
  (treemacs-with-button-buffer btn
    (save-excursion
      (goto-char btn)
      (treemacs-with-writable-buffer
       (delete-region
        (next-single-char-property-change (point) 'treemacs-async-string)
        (line-end-position)))
      (if (eq :async-error (car items))
          (treemacs-log-err "Something went wrong in an asynchronous context: %s" (cadr items))
        (treemacs--do-expand-extension-node btn ext (or items 'nothing) arg)))
    (hl-line-highlight)))

(defun treemacs--do-expand-extension-node (btn ext &optional items arg)
  "Expand an extension node BTN for the given extension EXT.

ITEMS will override the node's normal `children' function.  This is only used
when the node is asynchronous and this call is used to complete the async
computation.

Prefix ARG is used to set expand recursion depth.

BTN: Button
EXT: `treemacs-extension' instance
ARG: Prefix Arg
ITEMS: List<Any>"
  (treemacs-block
   (treemacs-error-return-if (not (eq (treemacs-extension->get ext :closed-state)
                                      (treemacs-button-get btn :state)))
     "This function cannot expand a node of type '%s'. Current node type is %s"
     (propertize (format "%s" (treemacs-button-get btn :state))
                 'face 'font-lock-type-face)
     (propertize (format "%s" (treemacs-extension->get ext :closed-state))
                 'face 'font-lock-type-face))
   (let* ((items          (pcase items
                            (`nil
                             (treemacs-extension->get
                              ext :children btn (treemacs-button-get btn :item)))
                            (`nothing nil)
                            (_ items)))
          (depth           (1+ (treemacs-button-get btn :depth)))
          (btn-path        (treemacs-button-get btn :path))
          (parent-path     (if (listp btn-path) btn-path (list btn-path)))
          (parent-dom-node (treemacs-find-in-dom btn-path))
          (child-ext       (treemacs-extension->get ext :child-type))
          (child-state     (treemacs-extension->get child-ext :closed-state))
          (closed-icon-fn  (treemacs-extension->closed-icon child-ext))
          (label-fn        (treemacs-extension->label child-ext))
          (properties-fn   (treemacs-extension->more-properties child-ext))
          (key-fn          (treemacs-extension->key child-ext))
          (recursive       (treemacs--prefix-arg-to-recurse-depth arg)))
     (treemacs--button-open
      :button btn
      :new-state (treemacs-extension->get ext :open-state)
      :new-icon (treemacs-extension->get
                 ext :open-icon btn (treemacs-button-get btn :item))
      :immediate-insert t
      :open-action
      (treemacs--create-buttons
       :nodes items
       :depth depth
       :node-name item
       :node-action
       (treemacs--create-node-strings
        :parent btn
        :parent-path parent-path
        :parent-dom-node parent-dom-node
        :more-properties (nconc `(:item ,item) (funcall properties-fn btn item))
        :icon (funcall closed-icon-fn btn item)
        :state child-state
        :key (funcall key-fn btn item)
        :depth depth
        :label (funcall label-fn btn item)))
      :post-open-action
      (progn
        (treemacs-on-expand btn-path btn)
        (treemacs--reentry btn-path)
        (when (> recursive 0)
          (cl-decf recursive)
          (--each (treemacs-collect-child-nodes btn)
            (when (treemacs-is-node-collapsed? it)
              (goto-char (treemacs-button-start it))
              (treemacs-expand-extension-node recursive)))))))))

(defun treemacs--expand-variadic-parent (&optional arg)
  "Interactive command to expand a variadic parent.
Only required to set up `treemacs-TAB-actions-config'.

ARG: Prefix Arg"
  (interactive "P")
  (let* ((btn (treemacs-node-at-point))
         (state (treemacs-button-get btn :state))
         (ext (alist-get state treemacs--extension-registry)))
    (when (null ext)
      (error "No extension is registered for state '%s'" state))
    (treemacs-with-writable-buffer
     (treemacs--do-expand-variadic-parent btn ext arg))))

(defun treemacs--do-expand-variadic-parent (btn ext &optional expand-depth)
  "Expand the hidden parent BTN of a variadic extension instance EXT.

EXPAND-DEPTH indicates the additional recursion depth.

BTN: Button
EXT: `treemacs-extension' instance
EXPAND-DEPTH: Int"
  (let* ((items           (treemacs-extension->get ext :children))
         (parent-path     (treemacs-button-get btn :path))
         (parent-dom-node (treemacs-find-in-dom parent-path))
         (child-ext       (treemacs-extension->get ext :child-type))
         (child-state     (treemacs-extension->get child-ext :closed-state))
         (closed-icon-fn  (treemacs-extension->closed-icon child-ext))
         (label-fn        (treemacs-extension->label child-ext))
         (properties-fn   (treemacs-extension->more-properties child-ext))
         (key-fn          (treemacs-extension->key child-ext))
         (expand-depth    (treemacs--prefix-arg-to-recurse-depth expand-depth)))
    (goto-char (button-end btn))
    (insert (apply #'propertize "\n" (text-properties-at btn)))
    (treemacs--button-open
     :button btn
     :new-state (treemacs-extension->get ext :open-state)
     :immediate-insert t
     :open-action
     (treemacs--create-buttons
      :nodes items
      :depth 0
      :node-name item
      :node-action
      (treemacs--create-node-strings
       :parent nil
       :parent-path parent-path
       :parent-dom-node parent-dom-node
       :more-properties
       (nconc `(:item ,item)
              `(:project ,(treemacs-project->create!
                           :name (funcall label-fn btn item)
                           :path path
                           :path-status 'extension))
              (funcall properties-fn btn item))
       :icon (funcall closed-icon-fn btn item)
       :state child-state
       :key (funcall key-fn btn item)
       :depth depth
       :label (funcall label-fn btn item)))
     :post-open-action
     (progn
       ;; projects' positions must always be known, so in this one
       ;; case they have to be collected very manually
       (save-excursion
         (goto-char (point-min))
         (-let [btn (point)]
           (while (setf btn (next-button btn))
             (let* ((path (treemacs-button-get btn :path))
                    (dom-node (treemacs-find-in-dom path)))
               (setf (treemacs-dom-node->position dom-node) btn)))))
       (treemacs-on-expand (treemacs-button-get btn :path) btn)
       (treemacs--reentry (treemacs-button-get btn :path))
       (when (> expand-depth 0)
         (cl-decf expand-depth)
         (--each (treemacs--all-buttons-with-depth 0)
           (when (treemacs-is-node-collapsed? it)
             (goto-char (treemacs-button-start it))
             (treemacs-expand-extension-node expand-depth))))))))

(defun treemacs-update-async-node (path)
  "Update an asynchronous node at the given PATH.
The update process will asynchronously pre-compute the children for every node
currently expanded under PATH.  The results of this computation will be cached
and then used to update the UI in one go."
  (-let [items-to-update (treemacs--get-async-update-items path)]
    (ht-set! treemacs--async-update-count path (length items-to-update))
    (dolist (item items-to-update)
      (let* ((item-path (car item))
             (ext (cdr item))
             (btn (treemacs-find-node item-path))
             (item (treemacs-button-get btn :item))
             (children-fn (treemacs-extension->children ext)))
        (funcall
         children-fn btn item
         (lambda (items)
           (treemacs--async-update-part-complete
            path item-path items)))))))

(defun treemacs--get-async-update-items (path)
  "Get the items needed for an async update at the given PATH.
Every item in the returned list will consist of the node's key and its
extensions instance."
  (-let [items nil]
    (treemacs-walk-reentry-dom (treemacs-find-in-dom path)
      (lambda (dom-node)
        (let* ((key (treemacs-dom-node->key dom-node))
               (state (treemacs-button-get (treemacs-find-node key) :state))
               (ext (alist-get state treemacs--extension-registry)))
          (push (cons key ext) items))))
    items))

(defun treemacs--async-update-part-complete (top-path updated-path items)
  "Partial completion for an asynchronous update.
TOP-PATH is the path of the node the update was called for.
UPDATED-PATH is the path of one of top node's children (may also be TOP-PATH)
whose content has just been computed.
ITEMS are the new items for the UPDATED-PATH that will be cached for the next
update."
  (ht-set! treemacs--async-update-cache updated-path (or items 'nothing))
  (-let [count (cl-decf (ht-get treemacs--async-update-count top-path))]
    (when (= 0 count)
      (--when-let (treemacs-get-local-buffer)
        (with-current-buffer it
          (treemacs-with-writable-buffer
           (treemacs-update-node top-path)
           (treemacs-button-put (treemacs-find-node updated-path) :busy nil)))))))

(defun treemacs--do-collapse-extension-node (btn ext &optional __arg)
  "Collapse an extension button BTN for the given EXT.

BTN: Button
EXT: `treemacs-extensions' instance
ARG: Prefix Arg"
  (treemacs--button-close
   :button btn
   :new-state (treemacs-extension->get ext :closed-state)
   :new-icon
   (treemacs-extension->get ext :closed-icon btn (treemacs-button-get btn :item))
   :post-close-action
   (treemacs-on-collapse (treemacs-button-get btn :path))))

(cl-defmacro treemacs-initialize
    (extension
     &key
     (with-expand-depth 0)
     and-do)
  "Initialise an external buffer for use with the given EXTENSION.

EXTENSION is the same symbol that was passed as a `:key' argument
to `treemacs-define-variadic-entry-node-type'.

WITH-EXPAND-DEPTH indicates the number of nodes that should be expanded *in
addition* to the default.  If a value is given that is not a number then
treemacs will assume that *all* possible nodes should be expanded.

AND-DO can be used to set up buffer-local variables after the buffer has
switched over to `treemacs-mode'."
  (declare (indent 1))
  `(progn
     (treemacs--disable-fringe-indicator)
     (treemacs-with-writable-buffer
      (erase-buffer))
     ;; make sure the fringe indicator is enabled later, otherwise treemacs
     ;; attempts to move it right after the `treemacs-mode' call the indicator
     ;; cannot be created before either since the major-mode activation wipes
     ;; out buffer-local variables' values
     (let ((treemacs-fringe-indicator-mode nil)
           (treemacs--in-this-buffer t))
       (treemacs-mode))
     (setq-local treemacs-space-between-root-nodes nil)
     (setq-local treemacs--in-this-buffer :extension)
     ,and-do
     (treemacs--render-extension
      (let ((instance (treemacs--ext-symbol-to-instance ',extension)))
        (treemacs-static-assert
            (and instance (treemacs-extension->variadic? instance))
          "%s is not a variadic extension" ,extension)
        instance)
      (if (numberp ,with-expand-depth) ,with-expand-depth 999))
     (goto-char 1)
     (treemacs--evade-image)))

(provide 'treemacs-treelib)

;;; treemacs-treelib.el ends here
