starting to implement pmap-decode

pull/9/head
Matthew Butterick 11 years ago
parent 71bac1483a
commit 595f3cb11a

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

@ -1,6 +1,8 @@
#lang racket/base #lang racket/base
(require racket/list) (require racket/list)
(require (planet mb/pollen/tools) (planet mb/pollen/main-helper)) (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) (provide (except-out (all-from-out racket/base) #%module-begin)
(rename-out [module-begin #%module-begin])) (rename-out [module-begin #%module-begin]))
@ -45,26 +47,31 @@
;; prepare the elements, and append inner-here as meta. ;; prepare the elements, and append inner-here as meta.
(define all-elements (append (define all-elements (append
(cond (cond
;; doc is probably a list, but might be a single string ;; doc is probably a list, but might be a single string
[(string? doc) (list doc)] [(string? doc) (list doc)]
[(tagged-xexpr? doc) (list doc)] ; if it's a single nx, just leave it [(tagged-xexpr? doc) (list doc)] ; if it's a single nx, just leave it
[(list? doc) doc]) ; if it's nx content, splice it in [(list? doc) doc]) ; if it's nx content, splice it in
(list `(meta "here" ,inner-here)))) ; append inner-here as meta (list `(meta "here" ,inner-here)))) ; append inner-here as meta
;; split out the metas now (in raw form) ;; split out the metas now (in raw form)
(define-values (main-raw metas-raw) (define-values (main-raw metas-raw)
(extract-tag-from-xexpr 'meta (make-tagged-xexpr 'irrelevant-tag empty all-elements))) (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. ;; Policy: here in the core lang, do as little to main as possible.
;; The point is just to set it up for further processing. ;; The point is just to set it up for further processing.
;; One of the annoyances of Scribble is its insistence on decoding. ;; One of the annoyances of Scribble is its insistence on decoding.
;; Better just to pass through the minimally processed data. ;; Better just to pass through the minimally processed data.
;; Root is treated as a function. ;; one exception: if file extension marks it as pmap, send it to the pmap decoder instead.
;; If it's not defined elsewhere, it just hits #%top and becomes a tagged-xexpr. (define main (apply (if ((get metas "here") . ends-with? . (->string POLLEN_MAP_EXT))
(define main (apply root (tagged-xexpr-elements main-raw))) pmap-decode
;; most files will go this way.
(define metas (make-meta-hash metas-raw)) ;; Root is treated as a function.
;; If it's not defined elsewhere,
;; it just hits #%top and becomes a tagged-xexpr.
root) (tagged-xexpr-elements main-raw)))
(provide main metas (provide main metas
(except-out (all-from-out 'pollen-inner) inner-here) ; everything from user (except-out (all-from-out 'pollen-inner) inner-here) ; everything from user

@ -10,6 +10,12 @@
(define pmap-file (build-path START_DIR DEFAULT_MAP)) (define pmap-file (build-path START_DIR DEFAULT_MAP))
(define pmap-main empty) (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 ;; todo: this ain't a function
(if (file-exists? pmap-file) (if (file-exists? pmap-file)
; load it, or ... ; load it, or ...
@ -47,7 +53,7 @@
[else (make-tagged-xexpr (->symbol x) (make-xexpr-attr 'parent (->string parent)))])) [else (make-tagged-xexpr (->symbol x) (make-xexpr-attr 'parent (->string parent)))]))
(module+ test (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) (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")))))))) '(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))) (add-parents nx)))
(module+ test (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) (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")))))))) '(pmap-main ((parent "")) (foo ((parent "pmap-main"))) (bar ((parent "pmap-main"))) (one ((parent "pmap-main")) (two ((parent "one")) (three ((parent "two"))))))))
@ -254,4 +260,8 @@
;; because pollen main depends on it to find the include functions ;; because pollen main depends on it to find the include functions
(define pm (parameterize ([current-directory "./tests/"]) (define pm (parameterize ([current-directory "./tests/"])
(main->pmap (dynamic-require "test-pmap.p" 'main)))) (main->pmap (dynamic-require "test-pmap.p" 'main))))
(check-equal? (previous-page (parent 'printers-and-paper pm) pm) "ligatures")) (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")

@ -199,3 +199,24 @@
(check-false ('z . in? . 'foobar)) (check-false ('z . in? . 'foobar))
(check-false ("F" . in? . #\F))) (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")))

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

@ -1,26 +1,26 @@
#lang planet mb/pollen #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 what-is-typography
where-do-the-rules-come-from} where-do-the-rules-come-from}
◊pmap-topic{type-composition ◊pmap-subtopic{type-composition
straight-and-curly-quotes straight-and-curly-quotes
one-space-between-sentences one-space-between-sentences
trademark-and-copyright-symbols trademark-and-copyright-symbols
ligatures} ligatures}
◊pmap-topic{appendix ◊pmap-subtopic{appendix
printers-and-paper printers-and-paper
how-to-make-a-pdf how-to-make-a-pdf
typewriter-habits typewriter-habits
common-accented-characters common-accented-characters
identifying-fonts identifying-fonts
bibliography bibliography
charter charter
mb-lectures-and-articles}} mb-lectures-and-articles}

@ -12,9 +12,6 @@
;; setup for test cases ;; setup for test cases
(module+ test (require rackunit)) (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 ;; helper for comparison of values

Loading…
Cancel
Save