starting to implement pmap-decode

main-helper.rkt

@@ -34,7 +34,7 @@
     [else #'(begin)]))
 
 
-;; here = name of current file without extensions.
+;; here = path of this file, relative to current directory. 
 ;; We want to make this identifier behave as a runtime function
 ;; This requires two steps.
 ;; First, define the underlying function as syntax-rule
@@ -46,7 +46,7 @@
                     ;; whereupon define would cause an error.
                     ;; Therefore, best to use let.
                     (let* ([ccr (current-contract-region)] ; trick for getting current module name
-                           [ccr (cond
+                           [here-path (cond
                                   ;; if contract-region is called from within submodule,
                                   ;; you get a list
                                   ;; in which case, just grab the path from the front
@@ -54,8 +54,7 @@
                                   ;; file isn't yet saved in drracket
                                   [(equal? 'pollen-lang-module ccr) 'nowhere] 
                                   [else ccr])])
-                      (match-let-values ([(_ here-name _) (split-path ccr)])
+                      (->string (find-relative-path (current-directory) here-path))))))
-                                        (->string here-name))))))
 
 (module+ test
   (check-equal? (get-here) "main-helper.rkt"))
@@ -63,7 +62,7 @@
 ; Second step: apply a separate syntax transform to the identifier itself
 ; We can't do this in one step, because if the macro goes from identifier to function definition,
 ; The macro processor will evaluate the body at compile-time, not at runtime.
-(define-syntax here (λ (stx) (datum->syntax stx '(get-here))))
+(define-syntax here (λ(stx) (datum->syntax stx '(get-here))))
 
 (module+ test
   (check-equal? here "main-helper.rkt"))

main.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require racket/list)
 (require (planet mb/pollen/tools) (planet mb/pollen/main-helper))
+(require (only-in (planet mb/pollen/pmap) pmap-decode))
+(require (only-in (planet mb/pollen/world) POLLEN_MAP_EXT))
 (provide (except-out (all-from-out racket/base) #%module-begin)
          (rename-out [module-begin #%module-begin]))
 
@@ -56,15 +58,20 @@
    (define-values (main-raw metas-raw) 
      (extract-tag-from-xexpr 'meta (make-tagged-xexpr 'irrelevant-tag empty all-elements)))
    
+   (define metas (make-meta-hash metas-raw))
+   
    ;; Policy: here in the core lang, do as little to main as possible.
    ;; The point is just to set it up for further processing.
    ;; One of the annoyances of Scribble is its insistence on decoding.
    ;; Better just to pass through the minimally processed data.
+   ;; one exception: if file extension marks it as pmap, send it to the pmap decoder instead.
+   (define main (apply (if ((get metas "here") . ends-with? . (->string POLLEN_MAP_EXT))
+                           pmap-decode
+                           ;; most files will go this way.
                            ;; Root is treated as a function. 
-   ;; If it's not defined elsewhere, it just hits #%top and becomes a tagged-xexpr.
+                           ;; If it's not defined elsewhere, 
-   (define main (apply root (tagged-xexpr-elements main-raw)))
+                           ;; it just hits #%top and becomes a tagged-xexpr.
-   
+                           root) (tagged-xexpr-elements main-raw)))
-   (define metas (make-meta-hash metas-raw))
    
    (provide main metas
             (except-out (all-from-out 'pollen-inner) inner-here) ; everything from user 

pmap.rkt

@@ -10,6 +10,12 @@
 (define pmap-file (build-path START_DIR DEFAULT_MAP))
 (define pmap-main empty)
 
+; make these independent of local includes
+(define (pmap-subtopic topic . subtopics)
+  (make-tagged-xexpr (->symbol topic) empty (filter-not whitespace? subtopics)))
+
+
+
 ;; todo: this ain't a function
 (if (file-exists? pmap-file)
     ; load it, or ...
@@ -47,7 +53,7 @@
     [else (make-tagged-xexpr (->symbol x) (make-xexpr-attr 'parent (->string parent)))]))
 
 (module+ test
-  (define test-pmap-main `(pmap-main "foo" "bar" ,(pmap-topic "one" (pmap-topic "two" "three"))))
+  (define test-pmap-main `(pmap-main "foo" "bar" ,(pmap-subtopic "one" (pmap-subtopic "two" "three"))))
   (check-equal? (add-parents test-pmap-main) 
                 '(pmap-main ((parent "")) (foo ((parent "pmap-main"))) (bar ((parent "pmap-main"))) (one ((parent "pmap-main")) (two ((parent "one")) (three ((parent "two"))))))))
 
@@ -70,7 +76,7 @@
     (add-parents nx)))
 
 (module+ test
-  (define mt-pmap `(pmap-main "foo" "bar" ,(pmap-topic "one" (pmap-topic "two" "three")) (meta "foo" "bar")))
+  (define mt-pmap `(pmap-main "foo" "bar" ,(pmap-subtopic "one" (pmap-subtopic "two" "three")) (meta "foo" "bar")))
   (check-equal? (main->pmap mt-pmap) 
                 '(pmap-main ((parent "")) (foo ((parent "pmap-main"))) (bar ((parent "pmap-main"))) (one ((parent "pmap-main")) (two ((parent "one")) (three ((parent "two"))))))))
 
@@ -255,3 +261,7 @@
   (define pm (parameterize ([current-directory "./tests/"])
                (main->pmap (dynamic-require "test-pmap.p" 'main))))
   (check-equal? (previous-page (parent 'printers-and-paper pm) pm) "ligatures"))
+
+(define/contract (pmap-decode . elements)
+  (() #:rest xexpr-elements? . ->* . any/c)
+  "hello, this is pmap-decode")

readability.rkt

@@ -199,3 +199,24 @@
   (check-false ('z . in? . 'foobar))
   (check-false ("F" . in? . #\F)))
 
+
+;; python-style string testers
+(define/contract (starts-with? str starter)
+  (string? string? . -> . boolean?)
+  (and (<= (len starter) (len str)) (equal? (get str 0 (len starter)) starter)))
+
+(module+ test
+  (check-true ("foobar" . starts-with? . "foo"))
+  (check-true ("foobar" . starts-with? . "f"))
+  (check-true ("foobar" . starts-with? . "foobar"))
+  (check-false ("foobar" . starts-with? . "bar")))
+
+(define/contract (ends-with? str ender)
+  (string? string? . -> . boolean?)
+  (and (<= (len ender) (len str)) (equal? (get str (- (len str) (len ender)) 'end) ender)))
+
+(module+ test
+  (check-true ("foobar" . ends-with? . "bar"))
+  (check-true ("foobar" . ends-with? . "r"))
+  (check-true ("foobar" . ends-with? . "foobar"))
+  (check-false ("foobar" . ends-with? . "foo")))

tests/subdir/in-a-subdir.p

@@ -0,0 +1,3 @@
+#lang planet mb/pollen
+
+I'm in a subdirectory.

tests/test.pmap

@@ -1,21 +1,21 @@
 #lang planet mb/pollen
 
-◊pmap-topic{index
+index
-    typography-in-ten-minutes
+typography-in-ten-minutes
-    summary-of-key-rules
+summary-of-key-rules
-    foreword
+foreword
-    introduction
+introduction
-    how-to-use
+how-to-use
-    how-to-pay-for-this-book
+how-to-pay-for-this-book
-    ◊pmap-topic{why-typography-matters
+◊pmap-subtopic{why-typography-matters
                what-is-typography
                where-do-the-rules-come-from}
-    ◊pmap-topic{type-composition
+◊pmap-subtopic{type-composition
                straight-and-curly-quotes
                one-space-between-sentences
                trademark-and-copyright-symbols
                ligatures}
-    ◊pmap-topic{appendix
+◊pmap-subtopic{appendix
                printers-and-paper
                how-to-make-a-pdf
                typewriter-habits
@@ -23,4 +23,4 @@
                identifying-fonts
                bibliography
                charter
-        mb-lectures-and-articles}}
+               mb-lectures-and-articles}

tools.rkt

@@ -12,9 +12,6 @@
 ;; setup for test cases
 (module+ test (require rackunit))
 
-; make these independent of local includes
-(define (pmap-topic topic . subtopics)
-  (make-tagged-xexpr (->symbol topic) empty (filter-not whitespace? subtopics)))
 
 
 ;; helper for comparison of values