| commit | author | age | ||
| 5cb5f7 | 1 | ;ELC |
| C | 2 | ;;; Compiled |
| 3 | ;;; in Emacs version 26.1 | |
| 4 | ;;; with all optimizations. | |
| 5 | ||
| 6 | ;;; This file uses dynamic docstrings, first added in Emacs 19.29. | |
| 7 | ||
| 8 | ;;; This file does not contain utf-8 non-ASCII characters, | |
| 9 | ;;; and so can be loaded in Emacs versions earlier than 23. | |
| 10 | ||
| 11 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 12 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 13 | ||
| 14 | ||
| 15 | (require 'map) | |
| 16 | #@296 Using INNER and OUTER, traverse FORM, an arbitrary data structure. | |
| 17 | INNER and OUTER are functions. Apply INNER to each element of | |
| 18 | FORM, building up a data structure of the same type, then apply | |
| 19 | OUTER to the result. Recognize cons, lists, alists, vectors and | |
| 20 | hash tables. | |
| 21 | ||
| 22 | (fn INNER OUTER FORM) | |
| 23 | (defalias 'treepy-walk #[771 "\211<\203 \211A\203 \211A:\204 @!A!B!\207\211<\203( \300\"!\207\301!\2039 \302\303\300\"\"!\207\304!\203R \305\306\307\310\311\303 !\312\"\313\314%\"!\207!\207" [mapcar vectorp apply vector hash-table-p map-apply make-byte-code 514 "\300B!\207" vconcat [] 5 "\n\n(fn K V)"] 11 (#$ . 424)]) | |
| 24 | #@209 Perform a depth-first, post-order traversal of F applied to FORM. | |
| 25 | Call F on each sub-form, use F's return value in place of the | |
| 26 | original. Recognize cons, lists, alists, vectors and | |
| 27 | hash tables. | |
| 28 | ||
| 29 | (fn F FORM) | |
| 30 | (defalias 'treepy-postwalk #[514 "\300\301\302\"#\207" [treepy-walk apply-partially treepy-postwalk] 6 (#$ . 1070)]) | |
| 31 | #@103 Perform a depth-first, pre-order traversal of F applied to FORM. | |
| 32 | Like `treepy-postwalk'. | |
| 33 | ||
| 34 | (fn F FORM) | |
| 35 | (defalias 'treepy-prewalk #[514 "\300\301\302\"\303!#\207" [treepy-walk apply-partially treepy-prewalk identity] 7 (#$ . 1405)]) | |
| 36 | #@112 Demonstrate the behavior of `treepy-postwalk' for FORM. | |
| 37 | Return a list of each form as it is walked. | |
| 38 | ||
| 39 | (fn FORM) | |
| 40 | (defalias 'treepy-postwalk-demo #[257 "\300C\301\302\303\304\305\306!\307\"\310\311%\"\210\312\242!\207" [nil treepy-postwalk make-byte-code 257 "\300\300\242B\240\210\207" vconcat vector [] 4 "\n\n(fn X)" reverse] 9 (#$ . 1646)]) | |
| 41 | #@111 Demonstrate the behavior of `treepy-prewalk' for FORM. | |
| 42 | Return a list of each form as it is walked. | |
| 43 | ||
| 44 | (fn FORM) | |
| 45 | (defalias 'treepy-prewalk-demo #[257 "\300C\301\302\303\304\305\306!\307\"\310\311%\"\210\312\242!\207" [nil treepy-prewalk make-byte-code 257 "\300\300\242B\240\210\207" vconcat vector [] 4 "\n\n(fn X)" reverse] 9 (#$ . 2000)]) | |
| 46 | #@284 Use SMAP to transform FORM by doing replacing operations. | |
| 47 | Recursively replace in FORM keys in SMAP with their values. Does | |
| 48 | replacement at the leaves of the tree first. The optional TESTFN | |
| 49 | parameter is the function to be used by `map-contains-key'. | |
| 50 | ||
| 51 | (fn SMAP FORM &optional TESTFN) | |
| 52 | (defalias 'treepy-postwalk-replace #[770 "\300\301\302\303\304\305\"\306\"\307\310%\"\207" [treepy-postwalk make-byte-code 257 "\302\300\301#\203 \303\300\"\207\207" vconcat vector [map-contains-key map-elt] 5 "\n\n(fn X)"] 11 (#$ . 2351)]) | |
| 53 | #@282 Use SMAP to transform FORM by doing replacing operations. | |
| 54 | Recursively replace in FORM keys in SMAP with their values. Does | |
| 55 | replacement at the root of the tree first. The optional TESTFN | |
| 56 | parameter is the function to be used by `map-contains-key'. | |
| 57 | ||
| 58 | (fn SMAP FORM &optional TESTFN) | |
| 59 | (defalias 'treepy-prewalk-replace #[770 "\300\301\302\303\304\305\"\306\"\307\310%\"\207" [treepy-prewalk make-byte-code 257 "\302\300\301#\203 \303\300\"\207\207" vconcat vector [map-contains-key map-elt] 5 "\n\n(fn X)"] 11 (#$ . 2890)]) | |
| 60 | #@112 Return context for this LOC. | |
| 61 | If KEY is given, only return this key's value in context. | |
| 62 | ||
| 63 | (fn LOC &optional KEY) | |
| 64 | (defalias 'treepy--context #[513 "@A\211\203 \203 \300\"\202 \211\207" [map-elt] 6 (#$ . 3425)]) | |
| 65 | #@60 Assoc in CONTEXT a key K with a value V. | |
| 66 | ||
| 67 | (fn CONTEXT K V) | |
| 68 | (defalias 'treepy--context-assoc-1 #[771 "\300\"\203 \301\302\303\304\305\306\"\307\"\310\311%\"\207BB\207" [map-contains-key mapcar make-byte-code 257 "\211@\300\232\203 \300\301B\207\207" vconcat vector [] 3 "\n\n(fn ENTRY)"] 11 (#$ . 3646)]) | |
| 69 | #@73 Immutable map association in CONTEXT using KVS. | |
| 70 | ||
| 71 | (fn CONTEXT &rest KVS) | |
| 72 | (defalias 'treepy--context-assoc #[385 "\300\301\302\303\"#\207" [seq-reduce #[514 "\300\301\"\300\302\"\211\303#\266\202\207" [seq--elt-safe 1 0 treepy--context-assoc-1] 10 "\n\n(fn CONTEXT KV)"] seq-partition 2] 7 (#$ . 3968)]) | |
| 73 | #@130 Return meta information for this LOC. | |
| 74 | If KEY is given, only return this key's value in meta | |
| 75 | information. | |
| 76 | ||
| 77 | (fn LOC &optional KEY) | |
| 78 | (defalias 'treepy--meta #[513 "A\203 \300\"\202 \211\207" [map-elt] 6 (#$ . 4286)]) | |
| 79 | #@53 Bind OBJ with some META information. | |
| 80 | ||
| 81 | (fn OBJ META) | |
| 82 | (defalias 'treepy--with-meta #[514 "B\207" [] 4 (#$ . 4511)]) | |
| 83 | #@164 Return a joining of LEFT-CHILDREN and RIGHT-CHILDREN. | |
| 84 | Reverses LEFT-CHILDREN so that they are correctly ordered as in | |
| 85 | the tree. | |
| 86 | ||
| 87 | (fn LEFT-CHILDREN RIGHT-CHILDREN) | |
| 88 | (defalias 'treepy--join-children #[514 "\300\301!\"\207" [append reverse] 5 (#$ . 4634)]) | |
| 89 | #@98 Create a lexical context using LOC VARS. | |
| 90 | Execute BODY in this context. | |
| 91 | ||
| 92 | (fn LOC VARS &rest BODY) | |
| 93 | (defalias 'treepy--with-loc '(macro . #[642 "\300\301\302\303\304\305!\306\"\307\310%\"\311BB\207" [mapcar make-byte-code 257 "\301\302\"\203 \303\304\300DD\207\301\305\"\203 \306\307\300DD\207\211\307\300\310\311\312\313!P!DED\207" vconcat vector [memql 'node node treepy-node 'context context treepy--context quote intern ":" symbol-name] 9 "\n\n(fn V)" let*] 10 (#$ . 4895)])) | |
| 94 | (byte-code "\300\301\302\303#\300\207" [function-put treepy--with-loc lisp-indent-function defun] 4) | |
| 95 | #@415 Create a new zipper structure. | |
| 96 | ||
| 97 | BRANCHP is a function that, given a node, returns t if it can | |
| 98 | have children, even if it currently doesn't. | |
| 99 | ||
| 100 | CHILDREN is a function that, given a branch node, returns a seq | |
| 101 | of its children. | |
| 102 | ||
| 103 | MAKE-NODE is a function that, given an existing node and a seq of | |
| 104 | children, returns a new branch node with the supplied children. | |
| 105 | ||
| 106 | ROOT is the root node. | |
| 107 | ||
| 108 | (fn BRANCHP CHILDREN MAKE-NODE ROOT) | |
| 109 | (defalias 'treepy-zipper #[1028 "\300\301B\302B\303B\304BE\"\207" [treepy--with-meta nil :branchp :children :make-node] 10 (#$ . 5491)]) | |
| 110 | #@65 Return a zipper for nested lists, given a ROOT list. | |
| 111 | ||
| 112 | (fn ROOT) | |
| 113 | (defalias 'treepy-list-zip #[257 "\300\301\302\303$\207" [#[514 "\207" [] 3 "\n\n(fn _ CHILDREN)"] treepy-zipper listp identity] 7 (#$ . 6055)]) | |
| 114 | #@69 Return a zipper for nested vectors, given a ROOT vector. | |
| 115 | ||
| 116 | (fn ROOT) | |
| 117 | (defalias 'treepy-vector-zip #[257 "\300\301\302\303$\207" [#[514 "\300\301\"\207" [apply vector] 5 "\n\n(fn _ CHILDREN)"] #[257 "\300\301\"\207" [seq-into list] 4 "\n\n(fn CS)"] treepy-zipper vectorp] 8 (#$ . 6272)]) | |
| 118 | #@35 Return the node at LOC. | |
| 119 | ||
| 120 | (fn LOC) | |
| 121 | (defalias 'treepy-node #[257 "\211@@\207" [] 2 (#$ . 6570)]) | |
| 122 | #@52 Return t if the node at LOC is a branch. | |
| 123 | ||
| 124 | (fn LOC) | |
| 125 | (defalias 'treepy-branch-p #[257 "\300\301\"\302!!\207" [treepy--meta :branchp treepy-node] 4 (#$ . 6671)]) | |
| 126 | #@78 Return a children list of the node at LOC, which must be a branch. | |
| 127 | ||
| 128 | (fn LOC) | |
| 129 | (defalias 'treepy-children #[257 "\300!\203 \301\302\"\303!!\207\304\305!\207" [treepy-branch-p treepy--meta :children treepy-node error "Called children on a leaf node"] 4 (#$ . 6838)]) | |
| 130 | #@175 Return a new branch node. | |
| 131 | Given an existing LOC, NODE and new CHILDREN, creates a new LOC | |
| 132 | with them. The LOC is only used to supply the constructor. | |
| 133 | ||
| 134 | (fn LOC NODE CHILDREN) | |
| 135 | (defalias 'treepy-make-node #[771 "\300\301\"\"\207" [treepy--meta :make-node] 6 (#$ . 7113)]) | |
| 136 | #@60 Return a list of nodes leading to the given LOC. | |
| 137 | ||
| 138 | (fn LOC) | |
| 139 | (defalias 'treepy-path #[257 "\300\301\302\"!\207" [reverse treepy--context :pnodes] 5 (#$ . 7391)]) | |
| 140 | #@59 Return a list of the left siblings of this LOC. | |
| 141 | ||
| 142 | (fn LOC) | |
| 143 | (defalias 'treepy-lefts #[257 "\300\301\302\"!\207" [reverse treepy--context :l] 5 (#$ . 7558)]) | |
| 144 | #@60 Return a list of the right siblings of this LOC. | |
| 145 | ||
| 146 | (fn LOC) | |
| 147 | (defalias 'treepy-rights #[257 "\300\301\"\207" [treepy--context :r] 4 (#$ . 7720)]) | |
| 148 | #@93 Return the loc of the leftmost child of the node at this LOC. | |
| 149 | nil if no children. | |
| 150 | ||
| 151 | (fn LOC) | |
| 152 | (defalias 'treepy-down #[257 "\300!\205O \301!\302!\303!\303\304\"\305\306\"\307\310\"\211\205G \311\312C\304 \2034 \n B\2027 \nCB\313\nB\314B\257\315 !\"\266\202\266\202\266\203\262\207" [treepy-branch-p treepy-children treepy-node treepy--context :pnodes seq-drop 1 seq--elt-safe 0 treepy--with-meta :l :ppath :r treepy--meta] 16 (#$ . 7871)]) | |
| 153 | #@84 Return the loc of the parent of the node at this LOC. | |
| 154 | nil if at the top. | |
| 155 | ||
| 156 | (fn LOC) | |
| 157 | (defalias 'treepy-up #[257 "\300!\301\302\"\301\303\"\301\304\"\301\305\"\301\306\"\205K @\307\203@ \310 \311\fB\"#\205< \312\304\313#B\202D B\314\n!\"\262\207" [treepy-node treepy--context :pnodes :ppath :changed\? :l :r treepy--with-meta treepy-make-node treepy--join-children treepy--context-assoc t treepy--meta] 16 (#$ . 8336)]) | |
| 158 | #@102 Zip from LOC all the way up and return the root node. | |
| 159 | Reflect any alterations to the tree. | |
| 160 | ||
| 161 | (fn LOC) | |
| 162 | (defalias 'treepy-root #[257 "\300!\301\232\203\f \302!\207\211\303!\211\262\203 \211\262\202 \302!\207" [treepy--context :end treepy-node treepy-up] 4 (#$ . 8786)]) | |
| 163 | #@112 Return the loc of the right sibling of the node at this LOC. | |
| 164 | nil if there's no more right sibilings. | |
| 165 | ||
| 166 | (fn LOC) | |
| 167 | (defalias 'treepy-right #[257 "\300!\301!\301\302\"\301\303\"\211<\203 \211\202 \211\304B\305\306\"\307\310\"\211\205B \205B \311\312\n\302 \fB\303%B\313\f!\"\266\202\266\202\262\207" [treepy-node treepy--context :l :r nil seq-drop 1 seq--elt-safe 0 treepy--with-meta treepy--context-assoc treepy--meta] 18 (#$ . 9068)]) | |
| 168 | #@131 Return the loc of the rightmost sibling of the node at this LOC. | |
| 169 | If LOC is already the rightmost sibiling, return self. | |
| 170 | ||
| 171 | (fn LOC) | |
| 172 | (defalias 'treepy-rightmost #[257 "\300!\301!\301\302\"\301\303\"\2035 \211\2035 \304\305!@\306\302\307\n\310 !B\"\303\311%B\312!\"\2026 \207" [treepy-node treepy--context :l :r treepy--with-meta last treepy--context-assoc treepy--join-children butlast nil treepy--meta] 15 (#$ . 9527)]) | |
| 173 | #@102 Return the loc of the left sibling of the node at this LOC. | |
| 174 | nil if no more left sibilings. | |
| 175 | ||
| 176 | (fn LOC) | |
| 177 | (defalias 'treepy-left #[257 "\300!\301!\301\302\"\301\303\"\2058 \2058 \304\305\"\306\307\"\211\310\311 \302\303\fB%B\312 !\"\266\202\266\202\207" [treepy-node treepy--context :l :r seq-drop 1 seq--elt-safe 0 treepy--with-meta treepy--context-assoc treepy--meta] 18 (#$ . 9966)]) | |
| 178 | #@129 Return the loc of the leftmost sibling of the node at this LOC. | |
| 179 | If LOC is already the leftmost sibiling, return self. | |
| 180 | ||
| 181 | (fn LOC) | |
| 182 | (defalias 'treepy-leftmost #[257 "\300!\301!\301\302\"\301\303\"\2035 \2035 \304\305!@\306\302\307\303\310\311\n!\f\nB\"%B\312!\"\2026 \207" [treepy-node treepy--context :l :r treepy--with-meta last treepy--context-assoc [] treepy--join-children butlast treepy--meta] 16 (#$ . 10371)]) | |
| 183 | #@83 Return the leftmost descendant of the given LOC. | |
| 184 | (ie, down repeatedly). | |
| 185 | ||
| 186 | (fn LOC) | |
| 187 | (defalias 'treepy-leftmost-descendant #[257 "\300!\203 \301!\262\202 \207" [treepy-branch-p treepy-down] 3 (#$ . 10805)]) | |
| 188 | #@113 Insert as the left sibiling of this LOC'S node the ITEM. | |
| 189 | Return same loc with sibilings updated. | |
| 190 | ||
| 191 | (fn LOC ITEM) | |
| 192 | (defalias 'treepy-insert-left #[514 "\300!\301!\301\302\"\204 \303\304!\202' \305\306\302B\307\310%B\311!\"\207" [treepy-node treepy--context :l error "Insert at top" treepy--with-meta treepy--context-assoc :changed\? t treepy--meta] 13 (#$ . 11021)]) | |
| 193 | #@113 Insert as the right sibling of this LOC's node the ITEM. | |
| 194 | Return same loc with sibilings updated. | |
| 195 | ||
| 196 | (fn LOC ITEM) | |
| 197 | (defalias 'treepy-insert-right #[514 "\300!\301!\301\302\"\204 \303\304!\202' \305\306\302B\307\310%B\311!\"\207" [treepy-node treepy--context :r error "Insert at top" treepy--with-meta treepy--context-assoc :changed\? t treepy--meta] 13 (#$ . 11405)]) | |
| 198 | #@82 Replace the node in this LOC with the given NODE, without moving. | |
| 199 | ||
| 200 | (fn LOC NODE) | |
| 201 | (defalias 'treepy-replace #[514 "\300!\301\302\303\304#B\305!\"\207" [treepy--context treepy--with-meta treepy--context-assoc :changed\? t treepy--meta] 9 (#$ . 11789)]) | |
| 202 | #@86 Replace the node at this LOC with the value of (F node ARGS). | |
| 203 | ||
| 204 | (fn LOC F &rest ARGS) | |
| 205 | (defalias 'treepy-edit #[642 "\300\301\302!#\"\207" [treepy-replace apply treepy-node] 9 (#$ . 12050)]) | |
| 206 | #@113 Insert as the leftmost child of this LOC's node the ITEM. | |
| 207 | Return same loc with children updated. | |
| 208 | ||
| 209 | (fn LOC ITEM) | |
| 210 | (defalias 'treepy-insert-child #[514 "\300\301\302!\303!B#\"\207" [treepy-replace treepy-make-node treepy-node treepy-children] 10 (#$ . 12251)]) | |
| 211 | #@114 Insert as the rightmost child of this LOC'S node the ITEM. | |
| 212 | Return same loc with children updated. | |
| 213 | ||
| 214 | (fn LOC ITEM) | |
| 215 | (defalias 'treepy-append-child #[514 "\300\301\302!\303\304!C\"#\"\207" [treepy-replace treepy-make-node treepy-node append treepy-children] 10 (#$ . 12523)]) | |
| 216 | #@101 Remove the node at LOC. | |
| 217 | Return the loc that would have preceded it in a depth-first | |
| 218 | walk. | |
| 219 | ||
| 220 | (fn LOC) | |
| 221 | (defalias 'treepy-remove #[257 "\300!\300\301\"\300\302\"\300\303\"\300\304\"\204 \305\306!\202n G\307V\203U \310@\311\303A\312\313%B\314!\"\315\316!\205A \317!\211\262\203O \320!\262\2028 \266\202\202n \310\321@#\205h \311\312\313#B\314!\"\207" [treepy--context :pnodes :ppath :l :r error "Remove at top" 0 treepy--with-meta treepy--context-assoc :changed\? t treepy--meta nil treepy-branch-p treepy-children treepy-rightmost treepy-make-node] 14 (#$ . 12810)]) | |
| 222 | #@194 Move to the next LOC in the hierarchy, depth-first in preorder. | |
| 223 | When reaching the end, returns a distinguished loc detectable via | |
| 224 | `treepy-end-p'. If already at the end, stays there. | |
| 225 | ||
| 226 | (fn LOC) | |
| 227 | (defalias 'treepy--preorder-next #[257 "\300!\301\232\203 \207\211\302!\203 \303!\206D \304!\206D \211\305\306!\2037 \304\306!!\211\262\2047 \306!\262\202 \211\206B \307!\301B\305B\266\202\207" [treepy--context :end treepy-branch-p treepy-down treepy-right nil treepy-up treepy-node] 7 (#$ . 13411)]) | |
| 228 | #@195 Move to the next LOC in the hierarchy, depth-first in postorder. | |
| 229 | When reaching the end, returns a distinguished loc detectable via | |
| 230 | `treepy-end-p'. If already at the end, stays there. | |
| 231 | ||
| 232 | (fn LOC) | |
| 233 | (defalias 'treepy--postorder-next #[257 "\300!\301\232\203 \207\302!\204 \303!\301B\304B\207\305!\211\205! \306!\262\206) \302!\207" [treepy--context :end treepy-up treepy-node nil treepy-right treepy-leftmost-descendant] 4 (#$ . 13925)]) | |
| 234 | #@184 Move to the next LOC in the hierarchy, depth-first. | |
| 235 | Use ORDER if given. Possible values for ORDER are `:preorder' and | |
| 236 | `:postorder', defaults to the former. | |
| 237 | ||
| 238 | (fn LOC &optional ORDER) | |
| 239 | (defalias 'treepy-next #[513 "\211\206 \300\301\302\"\203 \303!\202\" \301\304\"\203 \305!\202\" \306\307!\207" [:preorder memql ':preorder treepy--preorder-next ':postorder treepy--postorder-next error "Unrecognized order"] 6 (#$ . 14374)]) | |
| 240 | #@113 Move to the previous LOC in the hierarchy, depth-first preorder. | |
| 241 | If already at the root, returns nil. | |
| 242 | ||
| 243 | (fn LOC) | |
| 244 | (defalias 'treepy--preorder-prev #[257 "\300!\301\203# \302!\205 \303!\211\262\203 \304!\262\202 \202& \305!\207" [treepy-left nil treepy-branch-p treepy-children treepy-rightmost treepy-up] 5 (#$ . 14813)]) | |
| 245 | #@114 Move to the previous LOC in the hierarchy, depth-first postorder. | |
| 246 | If already at the root, returns nil. | |
| 247 | ||
| 248 | (fn LOC) | |
| 249 | (defalias 'treepy--postorder-prev #[257 "\300!\203\f \301\302!!\207\303!\204 \304!\262\202\f \303!\207" [treepy-branch-p treepy-rightmost treepy-down treepy-left treepy-up] 4 (#$ . 15152)]) | |
| 250 | #@188 Move to the previous LOC in the hierarchy, depth-first. | |
| 251 | Use ORDER if given. Possible values for ORDER are `:preorder' and `:postorder', | |
| 252 | defaults to the former. | |
| 253 | ||
| 254 | (fn LOC &optional ORDER) | |
| 255 | (defalias 'treepy-prev #[513 "\211\206 \300\301\302\"\203 \303!\202\" \301\304\"\203 \305!\202\" \306\307!\207" [:preorder memql ':preorder treepy--preorder-prev ':postorder treepy--postorder-prev error "Unrecognized order"] 6 (#$ . 15469)]) | |
| 256 | #@69 Return t if LOC represents the end of a depth-first walk. | |
| 257 | ||
| 258 | (fn LOC) | |
| 259 | (defalias 'treepy-end-p #[257 "\300!\301\232\207" [treepy--context :end] 3 (#$ . 15911)]) | |
| 260 | (provide 'treepy) | |
