xeals/origami.el
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactor and introduce on-change

Browse Source
This commit is contained in:
Greg Sexton 2014-03-17 20:23:57 +00:00
parent 30442bbbb1
commit 7cc09a5acd
1 changed files with 43 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
origami.el
View File

@ -65,42 +65,37 @@ used to nil out data. This mutates the node."
(defun origami-fold-open-toggle (node) (defun origami-fold-open-toggle (node)
(origami-fold-open-set node (not (origami-fold-open-p node)))) (origami-fold-open-set node (not (origami-fold-open-p node))))
(defun origami-fold-shallow-equal (a b) (defun origami-fold-range-equal (a b)
(and (equal (origami-fold-beg a) (origami-fold-beg b)) (and (equal (origami-fold-beg a) (origami-fold-beg b))
(equal (origami-fold-end a) (origami-fold-end b)) (equal (origami-fold-end a) (origami-fold-end b))))
(equal (origami-fold-open-p a) (origami-fold-open-p b))))
(defun origami-fold-diff (old new on-add on-remove) (defun origami-fold-state-equal (a b)
(equal (origami-fold-open-p a) (origami-fold-open-p b)))
(defun origami-fold-diff (old new on-add on-remove on-change)
"Diff the two structures calling ON-ADD for nodes that have "Diff the two structures calling ON-ADD for nodes that have
been added and ON-REMOVE for nodes that have been removed." been added and ON-REMOVE for nodes that have been removed."
(cl-labels ((pair-off (old-children new-children) (cl-labels ((diff-children (old-children new-children)
(let ((old (car old-children)) (let ((old (car old-children))
(new (car new-children))) (new (car new-children)))
(cond ((null old) (-map (lambda (n) (cons nil n)) new-children)) (cond ((null old) (-each new-children on-add))
((null new) (-map (lambda (n) (cons n nil)) old-children)) ((null new) (-each old-children on-remove))
((and (null old) (null new)) '()) ((and (null old) (null new)) nil)
((origami-fold-shallow-equal old new) (cons (cons old new) ((origami-fold-range-equal old new)
(pair-off (cdr old-children) (origami-fold-diff old new on-add on-remove on-change)
(cdr new-children)))) (diff-children (cdr old-children) (cdr new-children)))
((<= (origami-fold-beg old) ((<= (origami-fold-beg old) (origami-fold-beg new))
(origami-fold-beg new)) (cons (cons old nil) (funcall on-remove old)
(pair-off (cdr old-children) (diff-children (cdr old-children) new-children))
new-children))) (t (funcall on-add new)
(t (cons (cons nil new) (diff-children old-children (cdr new-children)))))))
(pair-off old-children (unless (origami-fold-range-equal old new)
(cdr new-children))))))) (error "Precondition invalid: old must have the same range as new."))
(handle-pair (pair) (unless (origami-fold-state-equal old new)
(let ((old (car pair)) (funcall on-change old new))
(new (cdr pair))) (diff-children (origami-fold-children old)
(cond ((and old new) (origami-fold-diff old new on-add on-remove)) (origami-fold-children new))))
(old (funcall on-remove old))
(new (funcall on-add new))
t (error "Illegal pairing.")))))
(unless (origami-fold-shallow-equal old new)
(error "Precondition invalid: old must be shallow-equal to new."))
(-each (pair-off (origami-fold-children old)
(origami-fold-children new))
(lambda (pair) (handle-pair pair)))))
(defun origami-fold-postorder-each (node f) (defun origami-fold-postorder-each (node f)
(-each (origami-fold-children node) f) (-each (origami-fold-children node) f)
@ -108,7 +103,7 @@ been added and ON-REMOVE for nodes that have been removed."
;;; overlay manipulation ;;; overlay manipulation
(defun origami-create-fold-overlay (beg end buffer text) (defun origami-create-overlay (beg end buffer text)
(let ((ov (make-overlay beg end buffer))) (let ((ov (make-overlay beg end buffer)))
(overlay-put ov 'invisible 'origami) (overlay-put ov 'invisible 'origami)
;; TODO: make this customizable ;; TODO: make this customizable
@ -116,21 +111,31 @@ been added and ON-REMOVE for nodes that have been removed."
(overlay-put ov 'face 'font-lock-comment-delimiter-face) (overlay-put ov 'face 'font-lock-comment-delimiter-face)
ov)) ov))
(defun origami-create-overlay-from-fold-fn (buffer) (defun origami-create-overlay-for-node (node buffer)
(let ((overlay (origami-create-overlay (origami-fold-beg node)
(origami-fold-end node) buffer "...")))
(origami-fold-data node overlay)))
(defun origami-create-overlay-from-fold-tree-fn (buffer)
(lambda (node) (lambda (node)
(origami-fold-postorder-each (origami-fold-postorder-each
node (lambda (n) node (lambda (n)
(let ((overlay (origami-create-fold-overlay (origami-fold-beg n) (when (not (origami-fold-open n))
(origami-fold-end n) buffer "..."))) (origami-create-overlay-for-node n buffer))))))
(origami-fold-data n overlay))))))
(defun origami-delete-overlay-from-fold-fn (buffer) (defun origami-delete-overlay-from-fold-tree-fn (buffer)
(lambda (node) (lambda (node)
(origami-fold-postorder-each (origami-fold-postorder-each
node (lambda (node) node (lambda (node)
(-when-let (ov (origami-fold-data node)) (-when-let (ov (origami-fold-data node))
(delete-overlay ov)))))) (delete-overlay ov))))))
(defun origami-change-overlay-from-fold-node-fn (buffer)
(lambda (old new)
(if (origami-fold-open-p new)
(delete-overlay (origami-fold-data old))
(origami-create-overlay-for-node new buffer))))
(defun origami-remove-all-overlays (buffer) (defun origami-remove-all-overlays (buffer)
;; TODO: ;; TODO:
) )