@@ 3,7 3,7 @@ 
   (use jd.structures)
   (use jd.trees)
   (use jd.util)
-  (export jd:root jd:file-tree))
+  (export jd:root jd:file-tree jd:file-tree-with-full-paths))
 
 (select-module jd.filesystem)
 

          
@@ 17,6 17,7 @@ 
     :absolute #t :expand #t :canonicalize #t))
 
 (define jd:file-tree (cut jd:tree (jd:root)))
+(define jd:file-tree-with-full-paths (cut jd:tree-with-full-paths (jd:root)))
 
 ;;; TRANSFORM DATA FROM FILESYSTEM TO SCHEME DATA
 

          
@@ 32,6 33,17 @@ 
          (make-jd:record jd:num label 
                          (list (make-jd:record-instance type path))
                          #f #f))))))
+(define file->jd:record-with-full-path
+  ;; 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))]
+         (make-jd:record jd:num path 
+                         (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.

          
@@ 55,4 67,27 @@ 
                             root-path))]
         (make-node root-label (map map-fn jd:elts))))))
 
-
+(define jd:tree-with-full-paths
+  ;; 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-with-full-paths path)]
+                      [else => (.$ make-node 
+                                   (pa$ file->jd:record-with-full-path
+                                        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-with-full-path 
+                              root-path 'directory)
+                            root-path))]
+        (make-node root-label (map map-fn jd:elts))))))

          

@@ 172,7 172,7 @@ 
            [children1 (node-children tree1)]
            [children2 (node-children tree2)]
            [new-label (if (and (jd:record? label1) (jd:record? label2)) 
-                              (jd:record-append label2 label1) label1)]
+                          (jd:record-append label2 label1) label1)]
            [new-children (jd:fetch-info-from-second-node-list
                            children1 children2)])
       (make-node new-label new-children))))

          

@@ 4,6 4,7 @@ 
   (use jd.filesystem)
   (use jd.meta)
   (export jd:generate-zsh-completions
+          jd:generate-zsh-named-folders
           jd:full-info-tree))
 
 (select-module jd.zsh)

          
@@ 36,4 37,21 @@ 
       ""
       jd-file-tree)))
 
-
+(define jd:generate-zsh-named-folders
+  (lambda [jd-file-tree]
+    (fold-tree 
+      (lambda [fst ls] 
+        (let1 purged (filter (complement (pa$ equal? "")) (cons fst ls))
+          (string-join purged "\n")))
+      (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 "hash -d j~a='~a'" num-string rec-label))))
+      (lambda [_ _] "") 
+      ""
+      jd-file-tree)))

          

@@ 6,6 6,7 @@ 
 (add-load-path "." :relative)
 
 (use jd.zsh)
+(use jd.filesystem)
 
 
 ;(define jd:full-tree

          
@@ 19,6 20,10 @@ 
   (lambda (args)
     (let1 argv (cdr args)
       (ecase ($ string->symbol $ car argv)
-        [(--complete)
-         (format (current-output-port) "~a" (jd:generate-zsh-completions (jd:full-info-tree)))
+        [(--complete) (format #t "~a" (jd:generate-zsh-completions 
+                                        (jd:full-info-tree)))
+                      0]
+        [(--gen-named-folders) 
+         (format #t "~a" (jd:generate-zsh-named-folders
+                           (jd:file-tree-with-full-paths)))
          0]))))