d6fae303438e draft — xaltsc 8 months ago
start dividing up big file into smol ones
9 files changed, 657 insertions(+), 632 deletions(-)

A => jd/filesystem.scm
A => jd/meta.scm
A => jd/notmuch.scm
A => jd/structures.scm
A => jd/taskwarrior.scm
A => jd/trees.scm
A => jd/util.scm
A => jd/zsh.scm
M johnny.scm
A => jd/filesystem.scm +58 -0
@@ 0,0 1,58 @@ 
+(define-module jd.filesystem
+  (use file.util)
+  (use jd.structures)
+  (use jd.trees)
+  (use jd.util)
+  (export jd:root jd:file-tree))
+
+(select-module jd.filesystem)
+
+
+;;; GET DATA FROM SYSENV
+;;; We define all data as functions as they may not work on all systems
+
+(define jd:root 
+  (cut sys-normalize-pathname
+    (sys-getenv "JD_ROOT")
+    :absolute #t :expand #t :canonicalize #t))
+
+(define jd:file-tree (cut jd:tree (jd:root)))
+
+;;; TRANSFORM DATA FROM FILESYSTEM TO SCHEME DATA
+
+(define file->jd:record 
+  ;; converts a path to a jd:record
+  ;; the second optional argument 'type' guesses the type from the filesystem
+  ;; if not provided.
+  (lambda (path :optional (type (file-type path :follow-link? #t)))
+    (let [(basename (sys-basename path))]
+      (let-values [((raw-id raw-label) (string-scan basename #\- 'both))]
+        (let [(jd:num (numstring->numspec raw-id))
+              (label (path-sans-extension raw-label))]
+         (make-jd:record jd:num label 
+                         (list (make-jd:record-instance type path))
+                         #f #f))))))
+
+(define jd:tree
+  ;; converts a file tree to a JD-tree if pathnames are valid JD ids.
+  ;; the tree is a list according to the following grammar:
+  ;; T        := (label children) | Ø
+  ;; label    := jd:record
+  ;; children := list[T]
+  ;; The root is still placed at the top of the tree, only the children of the
+  ;; resulting tree follows the grammar above.
+  (let [(map-fn (lambda (path)
+                    (case (file-type path :follow-link? #t)
+                      [(directory) (jd:tree path)]
+                      [else => (.$ make-node (pa$ file->jd:record path))])))]
+    (lambda (root-path)
+      (let [(jd:elts (directory-list root-path
+                                     :add-path? #t
+                                     :children? #t
+                                     :filter johnny?))
+            (root-label (if ($ johnny? $ sys-basename root-path)
+                            (file->jd:record root-path 'directory)
+                            root-path))]
+        (make-node root-label (map map-fn jd:elts))))))
+
+

          
A => jd/meta.scm +153 -0
@@ 0,0 1,153 @@ 
+(define-module jd.meta
+  (use jd.filesystem)
+  (use jd.structures)
+  (use jd.trees)
+  (use parser.peg)
+  (export jd:meta-file-tree jd:meta-tree))
+
+(select-module jd.meta)
+
+;;;; This module defines a way to parse data from the document 00.01-index
+;;;; according to the following indent-based grammar:
+;;;; DOC := (\n*NODE)*
+;;;; NODE := NODESPEC(\n\t| DESC)*(\n\tNODE)*
+;;;; NODESPEC := JDNUM LABEL
+;;;; JDNUM := \d\d(.(\d)+)*
+;;;; LABEL = DESC := a string
+
+;;; GRAMMAR DEFINITION {{{
+
+(define jd-parser:num-unit
+  ;; parses a number unit; takes an optional parameter `root` that forces the 
+  ;; length of the number to be equal to 2 if true
+  (lambda [:optional (root #f)]
+    ($let ([d (if root ($repeat ($. #[\d]) 2)
+                ($many ($. #[\d]) 2))])
+      ($return (x->integer (list->string d))))))
+
+(define jd-parser:number
+  ;; parses a valid JD number
+  ($lift (.$ (pa$ filter (complement (pa$ eq? #f))) list) 
+         (jd-parser:num-unit #t) 
+         ($optional ($seq ($. #\.) (jd-parser:num-unit)))))
+
+(define jd-parser:node-label
+  ;; parses a label
+  ($lift list->string
+    ($seq ($many ($. #[ \t\-_])) ($many1 ($. #[^\n])))))
+
+(define jd-parser:description-line
+  ;; Parses a line of description, i.e. "| something" -> "something"
+  ($lift list->string
+    ($seq ($. #\|) ($. #\space) ($many1 ($. #[^\n])))))
+
+(define jd-parser:description
+  ;; Parses a block of description lines, where the first line is the short
+  ;; description and the remain lines make the long description.
+  ($lift (.$ (lambda [ls] (list (car ls) (string-join (cadr ls) " "))) list)
+         jd-parser:description-line
+         ($many ($try ($seq ($. #\nl) jd-parser:description-line)))))
+
+     
+(define jd-parser:node-header
+  ;; parses a node-header corresponding to NODESPEC above
+  ($lift list
+         jd-parser:number
+         jd-parser:node-label))
+
+(define jd-parser:node-list
+  ;; parses a list of nodes, usually children of a given node or top-level
+  ;; nodes.
+  ($lazy ($many ($between ($many ($. #\nl)) jd-parser:node ($many ($. #\nl))))))
+
+(define jd-parser:node-content
+  ;; parses the content of a node, that is the description thereof and its
+  ;; children.
+  ($lift list
+         ($optional jd-parser:description)
+         ($optional ($seq ($many ($. #\nl)) jd-parser:node-list))))
+
+
+(define jd-parser:node
+  ;; parses a whole node with all its attributes and children.
+  ;; Returns a jd:node with label jd:record having one jd:record-instance of
+  ;; type 'meta.
+  ($let [[node-header jd-parser:node-header]
+         [node-content ($optional ($between ($string "\nI") 
+                                   jd-parser:node-content
+                                   ($or ($try ($seq ($many ($. #\nl)) ($. #\D)))
+                                        ($eos))))]]
+    (let* [[label (cadr node-header)]
+           [numspec (car node-header)]
+           [instance (make-jd:record-instance 'meta label)]]
+      (if node-content
+          (let* [[desc-list (car node-content)]
+                 [sh-desc (and desc-list (car desc-list))]
+                 [lg-desc (and desc-list (cadr desc-list))]
+                 [children (cadr node-content)]
+                 [record (make-jd:record numspec label 
+                                         (list instance) 
+                                         sh-desc lg-desc)]]
+            ($return (make-node record children)))
+          ($return (make-node (make-jd:record numspec label (list instance) #f #f)))))))
+           
+;;; }}}
+
+;;; DECONTEXTUALISE THE GRAMMAR {{{
+;;; Instead of tabs, we track where the indentation increases or decreases by
+;;; deleting all leading whitespace and prepending an I when indentation 
+;;; increases, and a D when it decreases. This transforms the above
+;;; context-dependent grammar into an independent one.
+
+(define jd-parser:ilevel+rest
+  ;; returns the indent level based on the formula space = 1, tab = 2 together
+  ;; with the remainder of the line.
+  (lambda [line]
+    (let [(head (string-ref line 0))
+          (rest (substring line 1 (string-length line)))]
+      (case head
+        ((#\space) (receive (ident str) (jd-parser:ilevel+rest rest)
+                            (values (+ 1 ident) str)))
+        ((#\tab) (receive (ident str) (jd-parser:ilevel+rest rest)
+                          (values (+ 2 ident) str)))
+        (else (values 0 line))))))
+
+(define jd-parser:decontextualise-identation-proc
+  ;; Takes a line and the current indentation level and writes to the default
+  ;; output the decontextualised line
+  (lambda [line cur-indent]
+    (receive (ident str) (jd-parser:ilevel+rest line)
+      (let* [(diff (/ (abs (- cur-indent ident)) 2))
+             [identsymbol (case (compare cur-indent ident)
+                            [(-1) (make-string diff #\I)]
+                            [(0)  ""]
+                            [(1)  (make-string diff #\D)])]]
+        (display identsymbol)
+        (display str)
+        (newline)
+        ident))))
+
+(define jd-parser:decontextualise-identation
+  ;; deconxtualises an indented file.
+  (lambda [filepath]
+    (let1 result (with-output-to-string
+                   (cut with-input-from-file filepath
+                     (cut generator-fold 
+                       jd-parser:decontextualise-identation-proc 
+                                    0 read-line)))
+      result)))
+
+;;; }}}
+
+(define jd:meta-tree
+  (lambda []
+    (let1 meta-path (string-join (list (jd:root) 
+                                       "00-meta"
+                                       "00.01-index") "/")
+          (jd:meta-file-tree meta-path))))
+
+(define jd:meta-file-tree
+  (lambda [filepath]
+    (let1 deindented (jd-parser:decontextualise-identation 
+                      (sys-normalize-pathname filepath))
+      (make-node "index" (peg-parse-string jd-parser:node-list deindented)))))

          
A => jd/notmuch.scm +37 -0
@@ 0,0 1,37 @@ 
+(define-module jd.notmuch
+  (use jd.structures)
+  (use jd.util)
+  (use jd.trees)
+  (use gauche.process)
+  (export jd:notmuch-records jd:notmuch-tree))
+
+(select-module jd.notmuch)
+
+
+(define jd:notmuch-tags
+  (lambda []
+    (let* [(nm-cmd '("notmuch" "search"
+                     "--format=sexp" "--output=tags" "*"))
+           (nm-output-port (values-ref (open-input-process-port nm-cmd) 0))
+           (nm-tags (read nm-output-port))]
+      (filter johnny? nm-tags))))
+
+(define jd:notmuch-records
+  (lambda [] (map nm-tag->jd:record (jd:notmuch-tags))))
+
+(define nm-tag->jd:record
+  ;; converts a notmuch tag to a jd:record
+  (lambda (tag)
+    (let-values [((raw-id label) (string-scan tag #\- 'both))]
+      (let [(numspec (numstring->numspec raw-id))]
+        (make-jd:record numspec label
+                        ($ list $ make-jd:record-instance 'nm-tag tag)
+                        #f #f)))))
+
+
+(define jd:notmuch-tree
+  (lambda []
+    (let [(root       (make-node "notmuch-tags"))
+          (nm-records (jd:notmuch-records))]
+      (fold-left jd:insert-in-tree root nm-records))))
+

          
A => jd/structures.scm +101 -0
@@ 0,0 1,101 @@ 
+(define-module jd.structures
+  (use gauche.record)
+  (export-all))
+
+(select-module jd.structures)
+;;; JD-RECORDS {{{
+
+(define-record-type jd:record #t #t
+  ;; number is a numspec: list of integers representing the address
+  ;; label: convenience name for the numspec
+  ;; instances: a list of where the number is used. Must be instances of 
+  ;;            jd:record-instance.
+  ;; short-desc: a short description
+  ;; long-desc: a long description
+  number label instances short-desc long-desc)
+
+(define-record-type jd:record-instance #t #t
+  ;; type: symbol among directory, regular, nm-tag
+  ;; data: depending on the type, where to find this number
+  type data)
+
+(define jd:record-append
+  ;; adds the instances of two jd:records IF their numbers matches.
+  ;; keeps only the data from the first record
+  (lambda (jdr1 jdr2)
+    (assume (equal? (jd:record-number jdr1) (jd:record-number jdr2)))
+    (let [(num (jd:record-number jdr1))
+          (label (jd:record-label jdr1))
+          (instances (jd:record-instances jdr1))
+          (instances2 (jd:record-instances jdr2))
+          (sh-desc (jd:record-short-desc jdr1))
+          (lg-desc (jd:record-long-desc jdr1))]
+      (make-jd:record num label 
+                      (append instances instances2)
+                      sh-desc lg-desc))))
+
+(define jd:area
+  ;; returns the area of a numspec
+  (lambda (num-spec)
+    ($ * 10 $ (cut quotient <> 10) $ car num-spec)))
+
+(define jd:category
+  ;; returns the category of a numspec
+  car)
+
+(define jd:area? (lambda (numspec) (equal? numspec ($ list $ jd:area numspec))))
+(define jd:category? (lambda (numspec) (= 1 (length numspec))))
+(define jd:is-child?
+  (lambda [ns-parent ns-child]
+    (and (= 1 (length ns-parent))
+         (case (length ns-child)
+          [(1) (and (jd:area? ns-parent) 
+                    (not (= (jd:area ns-child) (car ns-child)))
+                    (= (jd:area ns-child) (car ns-parent)))]
+          [(2) (cond
+                 [(jd:area? ns-parent) (= (jd:area ns-child) (car ns-parent))]
+                 [(jd:category? ns-parent) (= (car ns-child) (car ns-parent))]
+                 [else #f])]))))
+(define jd:is-direct-child?
+  (lambda [ns-parent ns-child]
+    (and (jd:is-child? ns-parent ns-child)
+         (or (and (jd:area? ns-parent) (jd:category? ns-child))
+             (and (jd:category? ns-parent)
+                  (= 2 (length ns-child))
+                  (= (car ns-parent) (car ns-child)))))))
+
+(define jd:path
+  ;; returns a path to go to the numspec in terms of numbers.
+  (lambda (numspec)
+    (cond [(and ($ = 1 $ length numspec) 
+                ($ = 0 $ mod (car numspec) 10))
+           numspec]
+          [($ = 1 $ length numspec)
+           (list (jd:area numspec) (jd:category numspec))]
+          [else
+           (append ($ jd:path
+                    $ list
+                    $ car numspec)
+                   ($ list 
+                    $ cadr numspec))])))
+
+
+(define jd:record->string
+  ;; provides a string reprenstation for a record
+  (lambda (record :optional (verbose #f))
+    (let [(id (string-join 
+                (map (pa$ format "~2,,,'0,,@s") (jd:record-number record))
+                "."))
+          (type-string (string-join (map (lambda (inst) 
+                                          (case (jd:record-instance-type inst)
+                                               ['directory "D"]
+                                               ['regular "F"]
+                                               ['nm-tag "@"]
+                                               ['tw-project "T"]
+                                               ['meta "M"]))
+                                      (jd:record-instances record))
+                          ""))]
+      (string-join (list id (jd:record-label record) type-string 
+                         (or (jd:record-short-desc record) "")))))) 
+
+

          
A => jd/taskwarrior.scm +31 -0
@@ 0,0 1,31 @@ 
+(define-module jd.taskwarrior
+    (use jd.structures)
+    (use jd.util)
+    (use gauche.process)
+    (export jd:taskwarrior-projects jd:taskwarrior-nodes))
+
+(select-module jd.taskwarrior)
+
+(define jd:taskwarrior-projects
+  (lambda []
+    (let* [(tw-cmd '("task" "_projects"))
+           (tw-output-port (values-ref (open-input-process-port tw-cmd) 0))
+           (tw-projects (port->string-list tw-output-port))]
+      (filter johnny-tw? tw-projects))))
+
+(define tw-project->jd:record
+  ;; converts a taskwarrior project to a jd:record
+  (lambda [project]
+    (let-values [((raw-id label) (string-scan project #\_ 'both))]
+      (let* [(numspec_temp (numstring->numspec raw-id))
+             (numspec (if (and (= (length numspec_temp) 2) 
+                               (= 0 (cadr numspec_temp)))
+                          (list (car numspec_temp))
+                          numspec_temp))]
+        (make-jd:record numspec label
+                        ($ list $ make-jd:record-instance 
+                          'tw-project project)
+                        #f #f)))))
+                                    
+(define jd:taskwarrior-nodes
+  (cut map tw-project->jd:record (jd:taskwarrior-projects)))

          
A => jd/trees.scm +197 -0
@@ 0,0 1,197 @@ 
+(define-module jd.trees
+  (use gauche.record)
+  (use scheme.list)
+  (use jd.structures)
+  (export node? make-node node-label node-children leaf?
+          map-tree fold-tree
+          jd:insert-in-tree jd:fuse-trees jd:print-tree))
+ 
+(select-module jd.trees)
+
+;;; Tree/Forest/Node data structure {{{
+
+(define-record-type node -make-node #t
+  label children)
+
+(define make-node
+  (lambda (label :optional (children '()))
+    (-make-node label children)))
+
+(define leaf?
+  (lambda (node)
+    (null? (node-children node))))
+
+;;; }}}
+
+;;; Tree functions {{{
+
+(define map-tree
+  ;; works for trees defined using the node record
+  (lambda (fn tree)
+    (let [(label    (node-label tree))
+          (children (node-children tree))]
+      (make-node (fn label) (map (pa$ map-tree fn) children)))))
+
+(define fold-tree
+    ;; fn-concat (list): function that combines the node and the result from
+    ;;                   children.
+    ;; fn-node (acc node): function that transforms the node into the desired
+    ;;                     type
+    ;; fn-acc (acc node): function that takes the accumulator onto the next step
+    ;; acc : the base value for the accumulator
+    ;; tree : the tree on which to fold
+    ;; default: the default value when the tree is empty
+  (lambda (fn-concat fn-node fn-acc acc tree)
+    (let [(label (node-label tree))
+          (children (node-children tree))]
+      (fn-concat (fn-node acc label)
+                 (if (null? children) '()
+                   (map (pa$ fold-tree fn-concat 
+                                       fn-node 
+                                       fn-acc
+                                       (fn-acc acc label))
+                      children))))))
+
+;;; }}}
+
+;;; Trees whose labels are jd:records {{{
+
+(define jd:part-ordered-node-list
+  (let [(numspec>  (lambda (ns node) 
+                     (>  (compare ns
+                                  (jd:record-number (node-label node)))
+                         0)))
+        (numspec>= (lambda (ns node) 
+                     (>= (compare ns 
+                                  (jd:record-number (node-label node))) 
+                         0)))]
+    (lambda (numspec ls)
+      (let*-values [((start right) (span (pa$ numspec>  numspec) ls))
+                    ((middle end)  (span (pa$ numspec>= numspec) right))]
+        (values start middle end)))))
+
+(define jd:insert-in-tree
+     (lambda [tree record]
+       (let* [(num-rec  (jd:record-number record))
+              (label    (node-label tree))
+              (children (node-children tree))
+              (node-num (when (jd:record? label) (jd:record-number label)))]
+         (cond
+           [(equal? num-rec node-num)
+            (make-node (jd:record-append label record) children)] 
+           [(or (undefined? node-num) ; we're at the root of
+                (and (= 1 (length node-num))
+                     (jd:is-child? node-num num-rec)))
+            (let-values [((st mid end) 
+                          (jd:part-ordered-node-list num-rec children))]
+              (if (null? mid)
+                (if (or (and (undefined? node-num)
+                             (jd:area? num-rec))
+                        (and ($ not $ undefined? node-num)
+                             (jd:is-direct-child? node-num num-rec)))
+                    (make-node label
+                               (append st
+                                       (list (make-node record))
+                                       end))
+                  (let1 last (unless (null? st) (last st))
+                    (when (and (not (undefined? last))
+                               (jd:is-child? ($ jd:record-number 
+                                                $ node-label last)
+                                             num-rec))
+                      (let1 maybe-result (jd:insert-in-tree last record)
+                        (unless (undefined? maybe-result)
+                          (make-node label
+                                     (append (drop-right st 1)
+                                             `(,maybe-result)
+                                             end)))))))
+                (let1 result (jd:insert-in-tree (car mid) record)
+                     (unless (undefined? result)
+                             (make-node label 
+                                        (append st `(,result) end))))))]))))
+
+(define jd:fuse-ordered-node-list
+  ;; We assume that we're at the same level each time
+  (lambda [list1 list2]
+    (cond
+      [(null? list1) list2]
+      [(null? list2) list1]
+      [else
+        (let* [(head1 (car list1))
+               (head2 (car list2))
+               (label1 (node-label head1))
+               (label2 (node-label head2))
+               (num1 (jd:record-number label1))
+               (num2 (jd:record-number label2))]
+          (case (compare num1 num2)
+            ((-1) (cons head1 (jd:fuse-ordered-node-list (cdr list1) list2)))
+            ((1)  (cons head2 (jd:fuse-ordered-node-list list1 
+                                                         (cdr list2))))
+            ((0)  (cons (jd:fuse-trees head1 head2)
+                        (jd:fuse-ordered-node-list (cdr list1)
+                                                   (cdr list2))))))])))
+
+              
+(define jd:fuse-trees
+  (lambda [tree1 tree2]
+    (let* [(label1 (node-label tree1))
+           (label2 (node-label tree2))
+           (children1 (node-children tree1))
+           (children2 (node-children tree2))
+           (new-children (jd:fuse-ordered-node-list children1 children2))
+           (new-label (if (and (jd:record? label1) (jd:record? label2))
+                        (jd:record-append label1 label2)
+                        label1))]
+      (make-node new-label new-children))))
+
+(define -node-numspec (lambda (node) (jd:record-number (label node))))
+(define jd:get-closest
+  ; gives a list (pointer) the closest to the given numspec.
+  ; pushable.
+  (lambda [num-spec tree]
+    (let [(label    (node-label tree))
+          (children (node-children tree))]
+      (if (null? children) tree
+          (let [(remainder (drop-until 
+                            (lambda (node)
+                              (let* [(label   (node-label node))
+                                     (n-index (-node-numspec label))]
+                                  (or (list>=? n-index num-spec)
+                                      ; general case
+                                      (and (jd:category? n-index)
+                                           (or (= (jd:area num-spec) 
+                                                  (jd:area n-index)
+                                                  (car n-index))
+                                               ; top level case
+                                               (= (car n-index) 
+                                                  (car num-spec)))))))
+                                               ; second-level case
+                            children))]
+           (if (null? remainder)
+               (values remainder #f)
+               (let* [(head       (car remainder))
+                      (head-label (node-label head))
+                      (head-index (-node-numspec head-label))
+                      (comp       (compare num-spec head-index))]
+                  (cond
+                    [(= 0 comp) (values head #t)]
+                    [(equal? ($ list $ jd:area num-spec) head-index)
+                     (jd:get-closest num-spec (node-children head))]
+                    [(equal? ($ list $ jd:category num-spec) head-index)
+                     (jd:get-closest num-spec (node-children head))]
+                    [else (values remainder #f)]))))))))
+
+(define jd:print-tree
+  ;; returns a formatted string representing a jd:tree
+  (lambda (tree :optional (verbose #f))
+    (fold-tree 
+      (lambda [first ls] 
+        (string-join (cons first ls) "\n"))
+      (lambda (acc label)
+        (string-append acc (if (string? label) label 
+                             (jd:record->string label verbose))))
+      (lambda (acc node)
+        (string-append "  " acc))
+      "" 
+      tree))) 
+      
+

          
A => jd/util.scm +39 -0
@@ 0,0 1,39 @@ 
+(define-module jd.util
+  (use scheme.regex)
+  (use scheme.list)
+  (export drop-until list>=? johnny? johnny-tw? numstring->numspec))
+  
+
+(select-module jd.util)
+
+;;; LIST FUNCTIONS {{{
+
+(define drop-until (lambda (pred list) (drop-while (complement pred) list)))
+
+(define list>=? (lambda (ns1 ns2) (> (compare ns1 ns2) -1)))
+
+;;; }}}
+
+;;; JD CONVENIENCE FUNCTIONS {{{
+
+(define mk-johnny-regexp
+  ;; makes a regexp matching a valid JD identifier, with `sep` as the separator
+  ;; between the number and the label
+  (let1 lr-regexp (map regexp->string (list #/\d{2}(\.\d+)*/ #/.+/))
+    (lambda [sep]
+      ($ string->regexp $ string-join lr-regexp sep))))
+
+(define johnny?
+  ;; true if the provided string is a valid JD identifier
+  (pa$ regexp-matches?  (mk-johnny-regexp "-")))
+
+(define johnny-tw?
+  ;; special format for taskwarrior JD identifiers
+  (pa$ regexp-matches? (mk-johnny-regexp "_")))
+
+(define numstring->numspec
+  ;; converts a string "YY.XX" to a list of numbers (YY XX)
+  (lambda (numstring)
+    ($ map string->number $ string-split numstring #\.)))
+
+;;; }}}

          
A => jd/zsh.scm +32 -0
@@ 0,0 1,32 @@ 
+(define-module jd.zsh
+  (use jd.trees)
+  (use jd.structures)
+  (export jd:generate-zsh-completions))
+
+(select-module jd.zsh)
+
+
+(define num-format
+  (lambda [numspec]
+    (string-join (map (pa$ format "~2,,,'0,,@s") numspec) ".")))
+
+(define jd:generate-zsh-completions
+  (lambda [jd-file-tree]
+    (fold-tree 
+      (lambda [fst ls] 
+        (let1 purged (filter (complement (pa$ equal? "")) (cons fst ls))
+          (string-join purged " ")))
+      (lambda [_ record]
+        (if (or ($ not $ jd:record? record) 
+                ($ not $ any (pa$ eq? 'directory) 
+                             (map jd:record-instance-type
+                                  (jd:record-instances record))))
+            ""
+          (let [(num-string ($ num-format $ jd:record-number record))
+                (rec-label  (jd:record-label record))]
+            (format "~a:~a" num-string rec-label))))
+      (lambda [_ _] "") 
+      ""
+      jd-file-tree)))
+
+

          
M johnny.scm +9 -632
@@ 1,647 1,24 @@ 
-#!/bin/env gauche
+#!/bin/env -S gauche -I.
 ;;;; johnny.scm
 ;;;; Module to deal with Johnny.Decimal related operations.
 ;;;; Copyright xaltsc 2021
 
-(use file.util)
-(use scheme.regex)
-(use scheme.list)
-(use gauche.record)
 (use gauche.process)
-(use parser.peg)
-
-(define drop-until (lambda (pred list) (drop-while (.$ not pred) list)))
-(define list>=? (lambda (ns1 ns2) (> (compare ns1 ns2) -1)))
-
-;;; Tree functions {{{
-
-(define old-map-tree
-  ;; recursively maps a function into a tree obeying a grammar similar to the 
-  ;; one defined for the function jd:tree.
-  (lambda (function tree)
-    (map (lambda (elt) (if (list? elt) (map-tree function elt) (function elt)))
-         tree)))
-
-(define map-tree
-  ;; works for trees defined using the node record
-  (lambda (fn tree)
-    (let [(label    (node-label tree))
-          (children (node-children tree))]
-      (make-node (fn label) (map (pa$ map-tree fn) children)))))
-
-(define old-fold-tree
-  (lambda (fn-concat fn-node fn-acc acc tree default)
-    ;; fn-concat (list): function that combines the node and the result from
-    ;;                   children.
-    ;; fn-node (acc node): function that transforms the node into the desired
-    ;;                     type
-    ;; fn-acc (acc node): function that takes the accumulator onto the next step
-    ;; acc : the base value for the accumulator
-    ;; tree : the tree on which to fold
-    ;; default: the default value when the tree is empty
-    (if (null? tree) default
-      (fn-concat 
-        (let [(node (car tree))]
-          (apply list (fn-node acc node) 
-                (map (cut fold-tree 
-                          fn-concat 
-                          fn-node
-                          fn-acc 
-                          (fn-acc acc node)
-                          <>
-                          default) 
-                     (cadr tree)))))))) 
-
-(define fold-tree
-  (lambda (fn-concat fn-node fn-acc acc tree)
-    (let [(label (node-label tree))
-          (children (node-children tree))]
-      (fn-concat (fn-node acc label)
-                 (if (null? children) '()
-                   (map (pa$ fold-tree fn-concat 
-                                       fn-node 
-                                       fn-acc
-                                       (fn-acc acc label))
-                      children))))))
-
-(define-record-type node -make-node #t
-  label children)
-
-(define make-node
-  (lambda (label :optional (children '()))
-    (-make-node label children)))
-
-(define leaf?
-  (lambda (node)
-    (null? (node-children node))))
-
-;;; }}}
-
-;;; JD CONVENIENCE FUNCTIONS {{{
-
-(define johnny?
-  ;; true if the provided string is a valid JD identifier
-  (pa$ regexp-matches?  #/\d{2}(\.\d+)*-.+/))
-
-(define tw:johnny?
-  ;; special format for taskwarrior JD identifiers
-  (pa$ regexp-matches? #/\d{2}(\.\d+)*_.+/))
-
-(define numstring->numspec
-  ;; converts a string "YY.XX" to a list of numbers (YY XX)
-  (lambda (numstring)
-    ($ map string->number $ string-split numstring #\.)))
-
-(define jd:print-tree
-  ;; returns a formatted string representing a jd:tree
-  (lambda (tree :optional (verbose #f))
-    (fold-tree 
-      (lambda [first ls] 
-        (string-join (cons first ls) "\n"))
-      (lambda (acc label)
-        (string-append acc (if (string? label) label 
-                             (jd:record->string label verbose))))
-      (lambda (acc node)
-        (string-append "  " acc))
-      "" 
-      tree))) 
-      
-
-;;; }}}
-
-;;; JD-RECORDS {{{
-
-(define-record-type jd:record #t #t
-  ;; number is a numspec: list of integers representing the address
-  ;; label: convenience name for the numspec
-  ;; instances: a list of where the number is used. Must be instances of 
-  ;;            jd:record-instance.
-  ;; short-desc: a short description
-  ;; long-desc: a long description
-  number label instances short-desc long-desc)
-
-(define-record-type jd:record-instance #t #t
-  ;; type: symbol among directory, regular, nm-tag
-  ;; data: depending on the type, where to find this number
-  type data)
-
-(define jd:record-append
-  ;; adds the instances of two jd:records IF their numbers matches.
-  ;; keeps only the data from the first record
-  (lambda (jdr1 jdr2)
-    (assume (equal? (jd:record-number jdr1) (jd:record-number jdr2)))
-    (let [(num (jd:record-number jdr1))
-          (label (jd:record-label jdr1))
-          (instances (jd:record-instances jdr1))
-          (instances2 (jd:record-instances jdr2))
-          (sh-desc (jd:record-short-desc jdr1))
-          (lg-desc (jd:record-long-desc jdr1))]
-      (make-jd:record num label 
-                      (append instances instances2)
-                      sh-desc lg-desc))))
-
-(define jd:area
-  ;; returns the area of a numspec
-  (lambda (num-spec)
-    ($ * 10 $ (cut quotient <> 10) $ car num-spec)))
-
-(define jd:category
-  ;; returns the category of a numspec
-  (lambda (num-spec)
-    (car num-spec)))
-
-(define jd:area? (lambda (numspec) (equal? numspec ($ list $ jd:area numspec))))
-(define jd:category? (lambda (numspec) (= 1 (length numspec))))
-(define jd:is-child?
-  (lambda [ns-parent ns-child]
-    (and (= 1 (length ns-parent))
-         (case (length ns-child)
-          [(1) (and (jd:area? ns-parent) 
-                    (not (= (jd:area ns-child) (car ns-child)))
-                    (= (jd:area ns-child) (car ns-parent)))]
-          [(2) (cond
-                 [(jd:area? ns-parent) (= (jd:area ns-child) (car ns-parent))]
-                 [(jd:category? ns-parent) (= (car ns-child) (car ns-parent))]
-                 [else #f])]))))
-(define jd:is-direct-child?
-  (lambda [ns-parent ns-child]
-    (and (jd:is-child? ns-parent ns-child)
-         (or (and (jd:area? ns-parent) (jd:category? ns-child))
-             (and (jd:category? ns-parent)
-                  (= 2 (length ns-child))
-                  (= (car ns-parent) (car ns-child)))))))
-
-(define jd:path
-  ;; returns a path to go to the numspec in terms of numbers.
-  (lambda (numspec)
-    (cond [(and ($ = 1 $ length numspec) 
-                ($ = 0 $ mod (car numspec) 10))
-           numspec]
-          [($ = 1 $ length numspec)
-           (list (jd:area numspec) (jd:category numspec))]
-          [else
-           (append ($ jd:path
-                    $ list
-                    $ car numspec)
-                   ($ list 
-                    $ cadr numspec))])))
-
-
-(define jd:record->string
-  ;; provides a string reprenstation for a record
-  (lambda (record :optional (verbose #f))
-    (let [(id (string-join 
-                (map (pa$ format "~2,,,'0,,@s") (jd:record-number record))
-                "."))
-          (type-string (string-join (map (lambda (inst) 
-                                          (case (jd:record-instance-type inst)
-                                               ['directory "D"]
-                                               ['regular "F"]
-                                               ['nm-tag "@"]
-                                               ['tw-project "T"]
-                                               ['meta "M"]))
-                                      (jd:record-instances record))
-                          ""))]
-      (string-join (list id (jd:record-label record) type-string 
-                         (or (jd:record-short-desc record) "")))))) 
-
-(define -node-numspec (lambda (node) (jd:record-number (label node))))
-(define jd:get-closest
-  ; gives a list (pointer) the closest to the given numspec.
-  ; pushable.
-  (lambda [num-spec tree]
-    (let [(label    (node-label tree))
-          (children (node-children tree))]
-      (if (null? children) tree
-          (let [(remainder (drop-until 
-                            (lambda (node)
-                              (let* [(label   (node-label node))
-                                     (n-index (-node-numspec label))]
-                                  (or (list>=? n-index num-spec)
-                                      ; general case
-                                      (and (jd:category? n-index)
-                                           (or (= (jd:area num-spec) 
-                                                  (jd:area n-index)
-                                                  (car n-index))
-                                               ; top level case
-                                               (= (car n-index) 
-                                                  (car num-spec)))))))
-                                               ; second-level case
-                            children))]
-           (if (null? remainder)
-               (values remainder #f)
-               (let* [(head       (car remainder))
-                      (head-label (node-label head))
-                      (head-index (-node-numspec head-label))
-                      (comp       (compare num-spec head-index))]
-                  (cond
-                    [(= 0 comp) (values head #t)]
-                    [(equal? ($ list $ jd:area num-spec) head-index)
-                     (jd:get-closest num-spec (node-children head))]
-                    [(equal? ($ list $ jd:category num-spec) head-index)
-                     (jd:get-closest num-spec (node-children head))]
-                    [else (values remainder #f)]))))))))
-
-;;; }}}
-
-;;; INTERACTION BETWEEN DATA AND JD-OBJECTS
-
-(define file->jd:record 
-  ;; converts a path to a jd:record
-  ;; the second optional argument 'type' guesses the type from the filesystem
-  ;; if not provided.
-  (lambda (path :optional (type (file-type path :follow-link? #t)))
-    (let [(basename (sys-basename path))]
-      (let-values [((raw-id raw-label) (string-scan basename #\- 'both))]
-        (let [(jd:num (numstring->numspec raw-id))
-              (label (path-sans-extension raw-label))]
-         (make-jd:record jd:num label 
-                         (list (make-jd:record-instance type path))
-                         #f #f))))))
-
-(define nm-tag->jd:record
-  ;; converts a notmuch tag to a jd:record
-  (lambda (tag)
-    (let-values [((raw-id label) (string-scan tag #\- 'both))]
-      (let [(numspec (numstring->numspec raw-id))]
-        (make-jd:record numspec label
-                        ($ list $ make-jd:record-instance 'nm-tag tag)
-                        #f #f)))))
-
-(define tw-project->jd:record
-  ;; converts a taskwarrior project to a jd:record
-  (lambda [project]
-    (let-values [((raw-id label) (string-scan project #\_ 'both))]
-      (let* [(numspec_temp (numstring->numspec raw-id))
-             (numspec (if (and (= (length numspec_temp) 2) 
-                               (= 0 (cadr numspec_temp)))
-                          (list (car numspec_temp))
-                          numspec_temp))]
-        (make-jd:record numspec label
-                        ($ list $ make-jd:record-instance 
-                          'tw-project project)
-                        #f #f)))))
-                                    
+(use jd.zsh)
+(use jd.filesystem)
 
 
-;(define label car)
-;(define children cadr)
-
-(define old-jd:tree
-  ;; converts a file tree to a JD-tree if pathnames are valid JD ids.
-  ;; the tree is a list according to the following grammar:
-  ;; T        := (label children) | Ø
-  ;; label    := jd:record
-  ;; children := list[T]
-  ;; The root is still placed at the top of the tree, only the children of the
-  ;; resulting tree follows the grammar above.
-  (lambda (root)
-    (let [(jd:elts (directory-list root 
-                                   :add-path? #t
-                                   :children? #t 
-                                   :filter johnny?))
-          (root-record (if (johnny? (sys-basename root))
-                         (file->jd:record root 'directory)
-                         root))]
-      (if (null? jd:elts) (list root-record '())
-          (list root-record
-                (map (lambda (path)
-                       (let [(filetype (file-type path :follow-link? #t))]
-                         (cond [(eq? filetype 'regular) 
-                                (list (file->jd:record path 'regular) '())]
-                               [(eq? filetype 'directory) 
-                                (jd:tree path)]))) 
-                  jd:elts))))))
-(define jd:tree
-  (let [(map-fn (lambda (path)
-                    (case (file-type path :follow-link? #t)
-                      [(directory) (jd:tree path)]
-                      [else => (.$ make-node (pa$ file->jd:record path))])))]
-    (lambda (root-path)
-      (let [(jd:elts (directory-list root-path
-                                     :add-path? #t
-                                     :children? #t
-                                     :filter johnny?))
-            (root-label (if ($ johnny? $ sys-basename root-path)
-                            (file->jd:record root-path 'directory)
-                            root-path))]
-        (make-node root-label (map map-fn jd:elts))))))
-
-;;; DATA FROM SYSTEM {{{
-
-(define jd:root 
-  (sys-normalize-pathname
-    (sys-getenv "JD_ROOT")
-    :absolute #t :expand #t :canonicalize #t))
-
-(define jd:docs (jd:tree jd:root))
-
-(define jd:notmuch-tags
-  (let* [(nm-cmd '("notmuch" "search"
-                   "--format=sexp" "--output=tags" "*"))
-         (nm-output-port (values-ref (open-input-process-port nm-cmd) 0))
-         (nm-tags (read nm-output-port))]
-    (filter johnny? nm-tags)))
-
-(define jd:taskwarrior-projects
-  (let* [(tw-cmd '("task" "_projects"))
-         (tw-output-port (values-ref (open-input-process-port tw-cmd) 0))
-         (tw-projects (port->string-list tw-output-port))]
-    (filter tw:johnny? tw-projects)))
-
-
-;;; }}}
-
-(define jd:part-ordered-node-list
-  (let [(numspec>  (lambda (ns node) 
-                     (>  (compare ns
-                                  (jd:record-number (node-label node)))
-                         0)))
-        (numspec>= (lambda (ns node) 
-                     (>= (compare ns 
-                                  (jd:record-number (node-label node))) 
-                         0)))]
-    (lambda (numspec ls)
-      (let*-values [((start right) (span (pa$ numspec>  numspec) ls))
-                    ((middle end)  (span (pa$ numspec>= numspec) right))]
-        (values start middle end)))))
-
-(define jd:old-insert-in-tree
-  ;; insert a record in a tree
-  ;; if it isn't possible (most like for reasons of uncompatible depth),
-  ;; returns undefined.
-  ;; This function allocates a new list in most cases.
-  (lambda (tree record)
-    (let [(num (jd:record-number record))]
-      (let*-values [((start middle end) (jd:part-tree num tree))
-                    ((last-start ns-mid)
-                     (values (unless (null? start) 
-                               (last start))
-                             (unless (null? middle)
-                               ($ jd:record-number $ label $ car middle))))]
-        (cond 
-          [(undefined? ns-mid)
-           ;; In this case, we figure whether the record should be inserted in
-           ;; the middle or in the children of the last record of the start
-           ;; list.
-           (if (undefined? last-start)
-             ;; trivial case, but need to check depth
-             (cond [(null? end) `((,record ()))]
-                   ;; the tree is empty
-                   [(= ($ length $ jd:record-number record)
-                       ($ length $ jd:record-number $ label $ car end))
-                    ;; check record is of the right depth
-                    (cons `((,record ())) end)])
-             (let* [(ls-num ($ jd:record-number $ label last-start))
-                    (ls-cat (car ls-num))]
-                (cond
-                  [(= (length ls-num) (length num) 2) 
-                   ;; the depths agree
-                   (append start (list `(,record ()) end))]
-                  [(= (length ls-num) (length num) 1) 
-                   ;; the depths agree
-                   (if (= ls-cat (jd:area num))
-                     (let1 inside-tree (jd:insert-in-tree
-                                         (children last-start)
-                                         record)
-                       (unless (undefined? inside-tree)
-                         (append (drop-right start 1) 
-                                 `((,(label last-start) ,inside-tree))
-                                 end)))
-                     (append start (list `(,record ()) end)))]
-                  [(and (= (length ls-num) 1) (= (length num) 2)
-                        (or (= ls-cat (jd:area num))
-                            (= ls-cat (jd:category num)))
-                   ;; the record should be a descendent of the last element of
-                   ;; start
-                    (let1 inside-tree (jd:insert-in-tree 
-                                       (children last-start)
-                                       record)
-                      (unless (undefined? inside-tree)
-                        (append (drop-right start 1) 
-                                `((,(label last-start) ,inside-tree))
-                                end))))])))]
-          [(equal? num ns-mid)
-           ;; in this case, the record is another instance of an already
-           ;; existing record.
-           (append start 
-                   (list 
-                       `(,(jd:record-append ($ label $ car middle) record) ()))
-                   end)]
-          [else (undefined)])))))
+;(define jd:full-tree
+;  (let* [(tw-records (map tw-project->jd:record jd:taskwarrior-projects))
+;         (fused0      (jd:fuse-trees jd:docs jd:notmuch-tree))
+;         (fused       (jd:fuse-trees jd:index-tree fused0))
+;     (fold-left jd:insert-in-tree fused tw-records))
 
-(define jd:insert-in-tree
-     (lambda [tree record]
-       (let* [(num-rec  (jd:record-number record))
-              (label    (node-label tree))
-              (children (node-children tree))
-              (node-num (when (jd:record? label) (jd:record-number label)))]
-         (cond
-           [(equal? num-rec node-num)
-            (make-node (jd:record-append label record) children)] 
-           [(or (undefined? node-num) ; we're at the root of
-                (and (= 1 (length node-num))
-                     (jd:is-child? node-num num-rec)))
-            (let-values [((st mid end) 
-                          (jd:part-ordered-node-list num-rec children))]
-              (if (null? mid)
-                (if (or (and (undefined? node-num)
-                             (jd:area? num-rec))
-                        (and ($ not $ undefined? node-num)
-                             (jd:is-direct-child? node-num num-rec)))
-                    (make-node label
-                               (append st
-                                       (list (make-node record))
-                                       end))
-                  (let1 last (unless (null? st) (last st))
-                    (when (and (not (undefined? last))
-                               (jd:is-child? ($ jd:record-number 
-                                                $ node-label last)
-                                             num-rec))
-                      (let1 maybe-result (jd:insert-in-tree last record)
-                        (unless (undefined? maybe-result)
-                          (make-node label
-                                     (append (drop-right st 1)
-                                             `(,maybe-result)
-                                             end)))))))
-                (let1 result (jd:insert-in-tree (car mid) record)
-                     (unless (undefined? result)
-                             (make-node label 
-                                        (append st `(,result) end))))))]))))
-(define jd:notmuch-tree
-  (let [(root       (make-node "notmuch-tags"))
-        (nm-records (map nm-tag->jd:record jd:notmuch-tags))]
-    (fold-left jd:insert-in-tree root nm-records)))
-
-
-(define jd:fuse-ordered-node-list
-  ;; We assume that we're at the same level each time
-  (lambda [list1 list2]
-    (cond
-      [(null? list1) list2]
-      [(null? list2) list1]
-      [else
-        (let* [(head1 (car list1))
-               (head2 (car list2))
-               (label1 (node-label head1))
-               (label2 (node-label head2))
-               (num1 (jd:record-number label1))
-               (num2 (jd:record-number label2))]
-          (case (compare num1 num2)
-            ((-1) (cons head1 (jd:fuse-ordered-node-list (cdr list1) list2)))
-            ((1)  (cons head2 (jd:fuse-ordered-node-list list1 
-                                                         (cdr list2))))
-            ((0)  (cons (jd:fuse-trees head1 head2)
-                        (jd:fuse-ordered-node-list (cdr list1)
-                                                   (cdr list2))))))])))
-
-              
-(define jd:fuse-trees
-  (lambda [tree1 tree2]
-    (let* [(label1 (node-label tree1))
-           (label2 (node-label tree2))
-           (children1 (node-children tree1))
-           (children2 (node-children tree2))
-           (new-children (jd:fuse-ordered-node-list children1 children2))
-           (new-label (if (and (jd:record? label1) (jd:record? label2))
-                        (jd:record-append label1 label2)
-                        label1))]
-      (make-node new-label new-children))))
-
-(define jd:generate-zsh-completions
-  (let [(num-format
-          (lambda [numspec]
-            (string-join (map (pa$ format "~2,,,'0,,@s") numspec) ".")))]
-    (lambda []
-      (fold-tree 
-        (lambda [fst ls] 
-          (let1 purged (filter (complement (pa$ equal? "")) (cons fst ls))
-            (string-join purged " ")))
-        (lambda [_ record]
-          (if (or ($ not $ jd:record? record) 
-                  ($ not $ any (pa$ eq? 'directory) 
-                               (map jd:record-instance-type
-                                    (jd:record-instances record))))
-              ""
-            (let [(num-string ($ num-format $ jd:record-number record))
-                  (rec-label  (jd:record-label record))]
-              (format "~a:~a" num-string rec-label))))
-        (lambda [_ _] "") 
-        ""
-        jd:docs))))
-
-;;; Parsing the document 00.00
-(define jd-parser:num-unit
-  (lambda [:optional (root #f)]
-    ($let ([d (if root ($repeat ($. #[\d]) 2)
-                ($many ($. #[\d]) 2))])
-      ($return (x->integer (list->string d))))))
-
-(define jd-parser:number
-  ($lift (.$ (pa$ filter (complement (pa$ eq? #f))) list) 
-         (jd-parser:num-unit #t) 
-         ($optional ($seq ($. #\.) (jd-parser:num-unit)))))
-
-(define jd-parser:node-label
-  ($lift list->string
-    ($seq ($many ($. #[ \t\-_])) ($many1 ($. #[^\n])))))
-
-(define jd-parser:description-line
-  ($lift list->string
-    ($seq ($. #\|) ($. #\space) ($many1 ($. #[^\n])))))
-
-(define jd-parser:description
-  ($lift (.$ (lambda [ls] (list (car ls) (string-join (cadr ls) " "))) list)
-         jd-parser:description-line
-         ($many ($try ($seq ($. #\nl) jd-parser:description-line)))))
-
-     
-(define jd-parser:node-header
-  ($lift list
-         jd-parser:number
-         jd-parser:node-label))
-
-(define jd-parser:node-list
-  ($lazy ($many ($between ($many ($. #\nl)) jd-parser:node ($many ($. #\nl))))))
-
-(define jd-parser:node-content
-  ($lift list
-         ($optional jd-parser:description)
-         ($optional ($seq ($many ($. #\nl)) jd-parser:node-list))))
-
-
-(define jd-parser:node
-  ($let [[node-header jd-parser:node-header]
-         [node-content ($optional ($between ($string "\nI") 
-                                   jd-parser:node-content
-                                   ($or ($try ($seq ($many ($. #\nl)) ($. #\D)))
-                                        ($eos))))]]
-    (let* [[label (cadr node-header)]
-           [numspec (car node-header)]
-           [instance (make-jd:record-instance 'meta label)]]
-      (if node-content
-          (let* [[desc-list (car node-content)]
-                 [sh-desc (and desc-list (car desc-list))]
-                 [lg-desc (and desc-list (cadr desc-list))]
-                 [children (cadr node-content)]
-                 [record (make-jd:record numspec label 
-                                         (list instance) 
-                                         sh-desc lg-desc)]]
-            ($return (make-node record children)))
-          ($return (make-node (make-jd:record numspec label (list instance) #f #f)))))))
-           
-(define jd-parser:ilevel+rest
-  (lambda [line]
-    (let [(head (string-ref line 0))
-          (rest (substring line 1 (string-length line)))]
-      (case head
-        ((#\space) (receive (ident str) (jd-parser:ilevel+rest rest)
-                            (values (+ 1 ident) str)))
-        ((#\tab) (receive (ident str) (jd-parser:ilevel+rest rest)
-                          (values (+ 2 ident) str)))
-        (else (values 0 line))))))
-
-(define jd-parser:decontextualise-identation-proc
-  (lambda [line cur-indent]
-    (receive (ident str) (jd-parser:ilevel+rest line)
-      (let* [(diff (/ (abs (- cur-indent ident)) 2))
-             [identsymbol (case (compare cur-indent ident)
-                            [(-1) (make-string diff #\I)]
-                            [(0)  ""]
-                            [(1)  (make-string diff #\D)])]]
-        (display identsymbol)
-        (display str)
-        (newline)
-        ident))))
-
-(define jd-parser:decontextualise-identation
-  (lambda [filepath]
-    (let1 result (with-output-to-string
-                   (cut with-input-from-file filepath
-                     (cut generator-fold 
-                       jd-parser:decontextualise-identation-proc 
-                                    0 read-line)))
-      result)))
-
-(define jd:index-tree
-  (let1 deindented (jd-parser:decontextualise-identation 
-                      (sys-normalize-pathname 
-                        (string-join (list jd:root 
-                                           "00-meta"
-                                           "00.01-index") "/")))
-    (make-node "index" (peg-parse-string jd-parser:node-list deindented))))
-
-
-(define jd:full-tree
-  (let* [(tw-records (map tw-project->jd:record jd:taskwarrior-projects))
-         (fused0      (jd:fuse-trees jd:docs jd:notmuch-tree))
-         (fused       (jd:fuse-trees jd:index-tree fused0))]
-     (fold-left jd:insert-in-tree fused tw-records)))
 ;;; MAIN FUNC
 (define main
   (lambda (args)
     (let1 argv (cdr args)
       (ecase ($ string->symbol $ car argv)
         [(--complete)
-         (format (current-output-port) "~a" (jd:generate-zsh-completions))
+         (format (current-output-port) "~a" (jd:generate-zsh-completions (jd:file-tree)))
          0]))))