/ nx.el
nx.el
1 ;;; nx.el --- Description -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2024 Benjamin Andresen 4 ;; 5 ;; Author: Benjamin Andresen <b@lambda.icu> 6 ;; Maintainer: Benjamin Andresen <b@lambda.icu> 7 ;; Created: August 20, 2024 8 ;; Modified: August 20, 2024 9 ;; Version: 0.0.1 10 ;; Keywords: abbrev bib c calendar comm convenience data docs emulations extensions faces files frames games hardware help hypermedia i18n internal languages lisp local maint mail matching mouse multimedia news outlines processes terminals tex tools unix vc wp 11 ;; Homepage: https://github.com/bennyandresen/nx 12 ;; Package-Requires: ((emacs "27.1")) 13 ;; 14 ;; This file is not part of GNU Emacs. 15 ;; 16 ;;; Commentary: 17 18 ;; This module provides a lightweight, flexible tree structure implementation 19 ;; for Emacs Lisp, primarily designed for building interactive, hierarchical 20 ;; user interfaces. 21 ;; 22 ;; The main concept is the 'nx node', which represents a single element in 23 ;; the tree. Each node has a type, properties, and can contain child nodes. 24 ;; This structure allows for efficient creation, manipulation, and rendering 25 ;; of complex, nested data structures. 26 ;; 27 ;; Key features: 28 ;; - Simple node creation with `nx-node` (aliased to `nx`) 29 ;; - Efficient tree diffing and patching 30 ;; - Utilities for traversing and manipulating the tree structure 31 ;; - Integration with hash-tables for flexible property storage 32 ;; 33 ;; This module is designed to be used as a foundation for building more 34 ;; complex UI components or data representations in Emacs Lisp applications. 35 36 ;;; Code: 37 (require 'ht) 38 (require 'dash) 39 (require 'dash-x) 40 (require 'cl-extra) 41 42 (defun nx-node (type &optional props children) 43 "Create a node with TYPE, optional PROPS and CHILDREN. 44 If :_nx/id is present in PROPS, it will be used as the node's ID 45 instead of an autogenerated one." 46 (let* ((contains-nxid? (lambda (props) (and (ht? props) (ht-contains? props :_nx/id)))) 47 (id (if (funcall contains-nxid? props) 48 (ht-get props :_nx/id) 49 (intern (symbol-name (gensym "nx-")))))) 50 (when (funcall contains-nxid? props) 51 (ht-remove props :_nx/id)) 52 (ht (:id id) 53 (:type type) 54 (:props (or props (ht))) 55 (:children children)))) 56 57 (defalias 'nx 'nx-node) 58 59 (-comment 60 (nx-node :foo) 61 (nx-node :foo (ht (:_nx/id 1))) 62 63 ) 64 65 (defun nx-type (node) 66 "Get the type of NODE." 67 (ht-get node :type)) 68 69 (defun nx-props (node) 70 "Get the properties of NODE." 71 (ht-copy (ht-get node :props))) 72 73 (defun nx-children (node) 74 "Get the children of NODE." 75 (ht-get node :children)) 76 77 (-tests 78 (nx :foo) 79 ) 80 81 (defun nx--node-equal (node1 node2) 82 "Deeply compare NODE1 and NODE2 for equality." 83 (and (eq (nx-type node1) (nx-type node2)) 84 (ht-equal? (nx-props node1) (nx-props node2)) 85 (let ((children1 (nx-children node1)) 86 (children2 (nx-children node2))) 87 (and (eq (length children1) (length children2)) 88 (cl-every #'nx--node-equal children1 children2))))) 89 90 (-comment 91 (nx--node-equal (nx :root (ht) (list 92 (nx :bar (ht)) 93 (nx :foo (ht (:bar t))))) 94 (nx :root (ht) (list 95 (nx :bar (ht)) 96 (nx :foo (ht (:bar t)))))) 97 ) 98 99 (defun nx--diff-children (old-children new-children parent-id) 100 "Compare OLD-CHILDREN and NEW-CHILDREN under PARENT-ID, returning list of changes." 101 (let ((changes nil) 102 (old-by-id (ht)) 103 (new-by-id (ht))) 104 105 ;; Index children by ID for faster lookup 106 (dolist (child old-children) 107 (ht-set! old-by-id (nx-id child) child)) 108 (dolist (child new-children) 109 (ht-set! new-by-id (nx-id child) child)) 110 111 ;; Find removed children 112 (dolist (old-child old-children) 113 (let ((id (nx-id old-child))) 114 (unless (ht-get new-by-id id) 115 (push (ht (:op :remove) 116 (:ref-id id)) 117 changes)))) 118 119 ;; Find new and modified children 120 (dolist (new-child new-children) 121 (let* ((id (nx-id new-child)) 122 (old-child (ht-get old-by-id id))) 123 (if old-child 124 ;; Child exists - check for modifications 125 (setq changes (append (nx--diff-nodes old-child new-child parent-id) 126 changes)) 127 ;; New child - check for next existing sibling 128 (let ((next-sibling (cl-find-if (lambda (node) 129 (gethash (nx-id node) old-by-id)) 130 (cdr (member new-child new-children))))) 131 (if next-sibling 132 (push (ht (:op :insert-before) 133 (:parent-id parent-id) 134 (:ref-id (nx-id next-sibling)) 135 (:node new-child)) 136 changes) 137 (push (ht (:op :insert-last) 138 (:parent-id parent-id) 139 (:node new-child)) 140 changes)))))) 141 142 (nreverse changes))) 143 144 (defun nx-diff-trees (old-tree new-tree) 145 "Compare OLD-TREE and NEW-TREE, returning a list of change operations." 146 (nx--diff-nodes old-tree new-tree nil)) 147 148 (defun nx--diff-nodes (old-node new-node parent-id) 149 "Compare OLD-NODE and NEW-NODE under PARENT-ID, returning a list of change operations." 150 (cond 151 ;; Nodes are identical 152 ((nx--node-equal old-node new-node) 153 nil) 154 ;; Node is new 155 ((null old-node) 156 (list (ht (:op :insert-last) 157 (:parent-id parent-id) 158 (:node new-node)))) 159 ;; Node is removed 160 ((null new-node) 161 (list (ht (:op :remove) 162 (:ref-id (nx-id old-node))))) 163 ;; Node type changed 164 ((not (eq (ht-get old-node :type) (ht-get new-node :type))) 165 (list (ht (:op :replace) 166 (:ref-id (nx-id old-node)) 167 (:node new-node)))) 168 ;; Properties changed 169 ((not (ht-equal? (ht-get old-node :props) (ht-get new-node :props))) 170 (append 171 (list (ht (:op :update-props) 172 (:ref-id (nx-id old-node)) 173 (:new-props (nx-props new-node)))) 174 (nx--diff-children 175 (ht-get old-node :children) 176 (ht-get new-node :children) 177 (ht-get old-node :id)))) 178 ;; Compare children 179 (t 180 (nx--diff-children 181 (ht-get old-node :children) 182 (ht-get new-node :children) 183 (ht-get old-node :id))))) 184 185 (defun nx-copy (node) 186 "Create a deep copy of NODE, preserving IDs." 187 (let* ((old-props (ht-get node :props)) 188 (new-props (ht-copy old-props)) 189 (new-children (mapcar #'nx-copy (ht-get node :children)))) 190 (when (ht-get node :id) 191 (ht-set! new-props :_nx/id (ht-get node :id))) 192 (nx (ht-get node :type) new-props new-children))) 193 194 195 (defun nx-type (node) 196 "Get the type of NODE." 197 (ht-get node :type)) 198 199 (defun nx-props (node) 200 "Get the properties of NODE." 201 (ht-copy (ht-get node :props))) 202 203 (defun nx-children (node) 204 "Get the children of NODE." 205 (ht-get node :children)) 206 207 (defun nx-id (node) 208 "Get the internal id of NODE." 209 (ht-get node :id)) 210 211 (defun nx? (obj) 212 "Check if OBJ is a valid nx node. 213 Returns t if OBJ is a valid nx node, nil otherwise." 214 (and (hash-table-p obj) 215 (keywordp (ht-get obj :type)) 216 (hash-table-p (ht-get obj :props)) 217 (or (null (ht-get obj :children)) 218 (and (listp (ht-get obj :children)) 219 (cl-every #'nx? (ht-get obj :children)))))) 220 221 (defun nx?-strict (obj) 222 "Strictly check if OBJ is a valid nx node. 223 Throws an error with a descriptive message if OBJ is not a valid nx node. 224 Returns t if OBJ is a valid nx node." 225 (cond 226 ((not (hash-table-p obj)) 227 (error "Not a hash table: %S" obj)) 228 ((not (keywordp (ht-get obj :type))) 229 (error "Invalid or missing :type: %S" (ht-get obj :type))) 230 ((not (hash-table-p (ht-get obj :props))) 231 (error "Invalid or missing :props: %S" (ht-get obj :props))) 232 ((not (or (null (ht-get obj :children)) 233 (and (listp (ht-get obj :children)) 234 (cl-every #'nx?-strict (ht-get obj :children))))) 235 (error "Invalid :children: %S" (ht-get obj :children))) 236 (t t))) 237 238 (defun nx--build-node-map (tree) 239 "Build a hash table mapping node IDs to nodes in TREE." 240 (let ((node-map (ht))) 241 (nx--traverse-tree tree (lambda (node) 242 (ht-set! node-map (ht-get node :id) node))) 243 node-map)) 244 245 (defun nx--traverse-tree (node fn) 246 "Traverse the tree starting at NODE, calling FN on each node." 247 (funcall fn node) 248 (dolist (child (ht-get node :children)) 249 (nx--traverse-tree child fn))) 250 251 (defun nx--find-parent (tree node) 252 "Find the parent of NODE in TREE." 253 (nx--find-parent-helper tree node nil)) 254 255 (defun nx--find-parent-helper (current-node target-node parent) 256 "Helper function for nx--find-parent." 257 (if (eq current-node target-node) 258 parent 259 (catch 'found 260 (dolist (child (ht-get current-node :children)) 261 (let ((result (nx--find-parent-helper child target-node current-node))) 262 (when result 263 (throw 'found result)))) 264 nil))) 265 266 (defun nx-apply-diff (tree diff-ops) 267 "Apply DIFF-OPS to a copy of TREE and return the resulting new tree. 268 WARNING: Uses unsafe hash-set! operations to achieve its goal." 269 (let* ((new-tree (nx-copy tree)) 270 (node-map (nx--build-node-map new-tree))) 271 (dolist (op diff-ops) 272 (-let [(&hash :op op-type 273 :parent-id parent-id 274 :node node 275 :node-id node-id 276 :ref-id ref-id 277 :new-props new-props) 278 op] 279 (pcase op-type 280 (:insert-last 281 (let ((parent (ht-get node-map parent-id))) 282 (when parent 283 (let ((new-children (append (ht-get parent :children) (list (nx-copy node))))) 284 (ht-set! parent :children new-children) 285 (nx--add-to-node-map node-map (nx-copy node)))))) 286 287 (:insert-before 288 (let ((parent (ht-get node-map parent-id))) 289 (when parent 290 (let* ((children (ht-get parent :children)) 291 (sibling-pos (cl-position-if 292 (lambda (node) 293 (equal (nx-id node) ref-id)) 294 children)) 295 (new-children (if sibling-pos 296 (append (cl-subseq children 0 sibling-pos) 297 (list (nx-copy node)) 298 (cl-subseq children sibling-pos)) 299 (append children (list (nx-copy node)))))) 300 (ht-set! parent :children new-children) 301 (nx--add-to-node-map node-map (nx-copy node)))))) 302 303 (:remove 304 (let* ((node (ht-get node-map ref-id)) 305 (parent (nx--find-parent new-tree node))) 306 (when parent 307 (let ((new-children (remove node (ht-get parent :children)))) 308 (ht-set! parent :children new-children))))) 309 310 (:update-props 311 (let ((node (ht-get node-map ref-id))) 312 (when node 313 (ht-set! node :props new-props)))) 314 315 (:replace 316 (let* ((old-node (ht-get node-map ref-id)) 317 (parent (nx--find-parent new-tree old-node))) 318 (when parent 319 (let ((new-children (mapcar (lambda (child) 320 (if (equal (nx-id child) ref-id) 321 (nx-copy node) 322 child)) 323 (ht-get parent :children)))) 324 (ht-set! parent :children new-children) 325 (nx--add-to-node-map node-map (nx-copy node))))))))) 326 new-tree)) 327 328 (defun nx--add-to-node-map (node-map node) 329 "Add NODE and its children to NODE-MAP." 330 (ht-set! node-map (ht-get node :id) node) 331 (dolist (child (ht-get node :children)) 332 (nx--add-to-node-map node-map child))) 333 334 (-comment 335 ;; create an initial tree 336 (setq initial-tree 337 (nx :root (ht (:_nx/id 'root)) 338 (list (nx :child (ht (:_nx/id 'child1) (:prop "old-value")) 339 (list (nx :grandchild (ht (:_nx/id 'grandchild))))) 340 (nx :child (ht (:_nx/id 'child2))) 341 (nx :child (ht (:_nx/id 'child4)))))) 342 (jujutsu-dev--display-in-buffer initial-tree) 343 344 ;; single addition of a :child ('child3) works 345 (setq modified-tree 346 (nx :root (ht (:_nx/id 'root)) 347 (list (nx :child (ht (:_nx/id 'child1) (:prop "new-value")) 348 (list (nx :grandchild (ht (:_nx/id 'grandchild))))) 349 (nx :child (ht (:_nx/id 'child2))) 350 (nx :child (ht (:_nx/id 'child3))) 351 (nx :child (ht (:_nx/id 'child4)))))) 352 353 ;; generate diff operations 354 (setq diff-ops (nx-diff-trees initial-tree modified-tree)) 355 (jujutsu-dev-dump-tree diff-ops "*jj diff ops*") 356 357 ;; Apply the diff to the initial tree 358 (setq result-tree (nx-apply-diff initial-tree diff-ops)) 359 (jujutsu-dev-dump-tree result-tree "*jj results*") 360 361 (setq modified-tree2 362 (nx :root (ht (:_nx/id 'root)) 363 (list (nx :child (ht (:_nx/id 'child1) (:prop "new-value")) 364 (list (nx :grandchild (ht (:_nx/id 'grandchild))))) 365 (nx :child (ht (:_nx/id 'child3))) 366 (nx :child (ht (:_nx/id 'child4)))))) 367 368 (setq diff-ops2 (nx-diff-trees initial-tree modified-tree2)) 369 (jujutsu-dev-dump-tree diff-ops2 "*jj diff ops*") 370 (setq result-tree2 (nx-apply-diff initial-tree diff-ops2)) 371 (jujutsu-dev-dump-tree result-tree2 "*jj results*") 372 373 ) 374 375 (defun nx-buffer-apply-diff (buffer state-and-ops render-fn) 376 "Apply DIFF-OPS to BUFFER using RENDER-FN to render nodes. 377 RENDER-FN should take a node and return a string representation." 378 (-let* [((&hash :diff-ops diff-ops 379 :state state) 380 state-and-ops) 381 (node-map (nx--build-node-map state))] 382 (with-current-buffer buffer 383 (save-excursion 384 (-comment 385 (jujutsu-dev-dump-display (ht 386 (:length-dops (length diff-ops)) 387 (:nmap node-map) 388 (:dops diff-ops)))) 389 390 (dolist (op diff-ops) 391 (-let [(&hash :op op-type 392 :parent-id parent-id 393 :node new-node 394 :ref-id ref-id 395 :new-props new-props) 396 op] 397 ;; TODO: I need to grab the state and find the actual nx-node in that state based on the node-id, ref-id, etc. 398 (pcase op-type 399 ;; confirmed to work for the simple case 400 ;; XXX: harvest potential children 401 (:remove (nx--buffer-delete-region buffer ref-id)) 402 403 ;; not yet confirmed 404 ;; XXX: harvest potential children 405 (:replace (nx--buffer-replace-region buffer ref-id new-node render-fn)) 406 407 ;; functionally :update does the same as :replace 408 ;; confirmed to work for the simple case 409 ;; XXX: harvest potential children 410 (:update-props (nx--buffer-replace-region buffer ref-id (ht-merge (ht-get node-map ref-id) (ht (:props new-props))) render-fn)) 411 412 ;; confirmed to work 413 (:insert-last (nx--buffer-insert-last buffer (ht-get node-map parent-id) new-node render-fn)) 414 415 ;; confirmed to work 416 (:insert-before (nx--buffer-insert-before buffer ref-id new-node render-fn))))))))) 417 418 (defun nx--buffer-get-point-id-boundaries (buffer &optional pos) 419 "Get boundaries of nx/id property at POS or (point) in BUFFER. 420 Returns hash table with :nx/id, :beg, and :end if position has nx/id property." 421 (with-current-buffer buffer 422 (let* ((pos (or pos (point))) 423 (id (get-text-property pos 'nx/id))) 424 (when id 425 (let* ((beg (previous-single-property-change (1+ pos) 'nx/id nil (point-min))) 426 (beg (if (equal id (get-text-property beg 'nx/id)) 427 beg 428 (or (next-single-property-change beg 'nx/id) 429 (point-min)))) 430 (end (or (next-single-property-change pos 'nx/id) 431 (point-max)))) 432 (ht (:nx/id id) (:beg beg) (:end end))))))) 433 434 (defun nx--buffer-find-id-position (buffer id) 435 "Find position in BUFFER where text property `nx/id' equals ID." 436 (with-current-buffer buffer 437 (save-excursion 438 (goto-char (point-min)) 439 (let ((pos (text-property-search-forward 'nx/id id t))) 440 (when pos 441 (prop-match-beginning pos)))))) 442 443 (defun nx--buffer-delete-region (buffer id) 444 "Delete the region in BUFFER corresponding to node with ID." 445 (with-current-buffer buffer 446 (let ((inhibit-read-only t)) 447 (when-let* ((pos (nx--buffer-find-id-position buffer id)) 448 (bounds (nx--buffer-get-point-id-boundaries buffer pos))) 449 (delete-region (ht-get bounds :beg) (ht-get bounds :end)))))) 450 451 (defun nx--buffer-replace-region (buffer id new-node render-fn) 452 "Replace region for `nx/id' ID in BUFFER with rendered NEW-NODE using RENDER-FN." 453 (with-current-buffer buffer 454 (let ((inhibit-read-only t)) 455 (when-let* ((pos (nx--buffer-find-id-position buffer id)) 456 (bounds (nx--buffer-get-point-id-boundaries buffer pos))) 457 (delete-region (ht-get bounds :beg) (ht-get bounds :end)) 458 (goto-char (ht-get bounds :beg)) 459 (nx--buffer-insert-node new-node render-fn))))) 460 461 (defun nx--buffer-id-map (buffer) 462 "Build hash table mapping nx/id values to their buffer positions in BUFFER." 463 (with-current-buffer buffer 464 (let ((id-map (make-hash-table :test 'equal)) 465 (pos (point-min))) 466 (while (< pos (point-max)) 467 (when-let* ((id (get-text-property pos 'nx/id)) 468 (end (next-property-change pos))) 469 (puthash id (vector pos end) id-map) 470 (setq pos end)) 471 (setq pos (1+ pos))) 472 id-map))) 473 474 (defun nx--buffer-insert-last (buffer parent node render-fn) 475 "Insert rendered NODE at end of PARENT region in BUFFER using RENDER-FN." 476 (with-current-buffer buffer 477 (let* ((inhibit-read-only t) 478 (buf-map (nx--buffer-id-map (current-buffer))) 479 (parent-id (nx-id parent)) 480 (node-id (nx-id node)) 481 (ids-to-search (-concat (list parent-id) 482 (->> parent nx-children (-map #'nx-id) nreverse)))) 483 ;; XXX: if the node is already present, skip search and replace 484 (if (ht-get buf-map node-id) 485 (nx--buffer-replace-region buffer node-id node render-fn)) 486 (catch 'found 487 (dolist (id ids-to-search) 488 (when-let* ((pos-bounds (ht-get buf-map id)) 489 (beg (aref pos-bounds 0)) 490 (end (aref pos-bounds 1))) 491 (goto-char end) 492 (nx--buffer-insert-node node render-fn) 493 (throw 'found t))) 494 ;; If no positions found, append to buffer end 495 (goto-char (point-max)) 496 (nx--buffer-insert-node node render-fn))))) 497 498 (defun nx--buffer-insert-before (buffer ref-id node render-fn) 499 "Insert rendered NODE before REF-ID in BUFFER using RENDER-FN." 500 (with-current-buffer buffer 501 (let ((inhibit-read-only t)) 502 (when-let* ((pos (nx--buffer-find-id-position buffer ref-id)) 503 (bounds (nx--buffer-get-point-id-boundaries buffer pos))) 504 (goto-char (ht-get bounds :beg)) 505 (nx--buffer-insert-node node render-fn))))) 506 507 (defun nx--buffer-insert-node (node render-fn) 508 "Insert NODE into current buffer using RENDER-FN. " 509 ;; TODO: validate that the inserted text has a `nx/id' text property on every 510 ;; char of the string 511 (insert (funcall render-fn node ""))) 512 513 (provide 'nx) 514 ;;; nx.el ends here