add indenting to ptree display

server-extras/poldash.css

@@ -86,10 +86,16 @@ th a:hover {
     color: #bbb;
 }
 
-a:active {
+a:active, span.indented-link-text:active {
     text-decoration: underline;
 }
 
+a.indented-link:active {
+    /* don't want to underline leading nbsps */
+    text-decoration: none;
+}
+
+
 
 tt {
     font-family: "Source Code Pro", "Menlo", "Consolas", monospace;

server-routes.rkt

@@ -153,10 +153,10 @@
                                               (take (cdr dirs) (add1 i))))))
     `(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink (world:current-default-pagetree)))) ,(->string dir))) dirs dirlinks) "/"))))
   
-  (define (make-path-row filename source)
+  (define (make-path-row filename source indent-level)
     `(tr ,@(map make-link-cell 
                 (append (list                          
-                         (cond ; main cell
+                         (let ([main-cell (cond ; main cell
                                             [(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard
                                              (cons (format "~a/~a" filename (world:current-default-pagetree)) (format "~a/" filename))]
                                             [(and source (equal? (get-ext source) "scrbl")) ; scribble source
@@ -178,7 +178,10 @@
                                                 
                                                 (cons #f `(a ((href ,filename)) ,(->string source-minus-ext) (span ((class "file-ext")) "." ,source-first-ext ,extra-row-string)))])]
                                             [else ; other non-source file
-                            (cons filename filename)])
+                                             (cons filename filename)])])
+                           (define link-tx (cdr main-cell))
+                           ;; indent link text by depth in pagetree
+                           (cons (car main-cell) `(,(get-tag link-tx) ,(cons '(class "indented-link") (get-attrs link-tx)) ,(make-string (* 2 indent-level) #\u00A0) (span ((class "indented-link-text")) ,@(get-elements link-tx)))))
                          
                          (cond ; 'in' cell
                            [source  (cons (format "in/~a" source) "in")]
@@ -192,10 +195,17 @@
   
   (define (ineligible-path? x) (member x (world:current-paths-excluded-from-dashboard)))
   
-  (define project-paths 
-    (filter-not ineligible-path? (map ->path (pagetree->list 
-                                              (with-handlers ([exn:fail:contract? (λ _ (directory->pagetree dashboard-dir))])
-                                                (cached-require (->path dashboard-ptree) (world:current-main-export)))))))
+  (define directory-pagetree (with-handlers ([exn:fail:contract? (λ _ (directory->pagetree dashboard-dir))])
+                               (cached-require (->path dashboard-ptree) (world:current-main-export))))
+  
+  (define project-paths (filter-not ineligible-path? (map ->path (pagetree->list directory-pagetree))))
+  
+  (define (directory-pagetree-depth node)
+    (let loop ([node node][depth 0])
+      (define pn (parent node directory-pagetree))
+      (if pn
+          (loop pn (add1 depth))
+          depth)))
   
   (body-wrapper #:title (format "~a" dashboard-dir)
                 `(table 
@@ -221,8 +231,9 @@
                              (define unique-path-source-pairs (reverse reversed-unique-path-source-pairs))
                              (define filenames (map (compose1 ->string car) unique-path-source-pairs))
                              (define sources (map cdr unique-path-source-pairs))
+                             (define indent-levels (map directory-pagetree-depth filenames))
                              (parameterize ([current-directory dashboard-dir])
-                               (map make-path-row filenames sources))]
+                               (map make-path-row filenames sources indent-levels))]
                             [else (list '(tr (td ((class "no-files")) "No files yet in this directory") (td) (td)))])))))
 
 (define route-dashboard (route-wrapper dashboard))