unfoob

quad/quadwriter/core.rkt

@@ -98,8 +98,7 @@
     (fill doc stroke-color)  
     (restore doc)))
 
-(define dumb-hardcoded-line-height 16)
-(define q:line (q #:size (pt 0 dumb-hardcoded-line-height)
+(define q:line (q #:size (pt 0 default-line-height)
                   #:inner 'sw
                   #:out 'sw
                   #:printable #true
@@ -107,7 +106,7 @@
 
 (struct line-spacer quad () #:transparent)
 (define q:line-spacer (q #:type line-spacer
-                         #:size (pt 0 (* dumb-hardcoded-line-height 0.6))
+                         #:size (pt 0 (* default-line-height 0.6))
                          #:out 'sw
                          #:printable (λ (q sig) (not (memq sig '(start end))))
                          #:draw-start (if (draw-debug-line?) draw-debug void)))
@@ -235,7 +234,7 @@
 
 (define (hr-draw dq doc)
   (match-define (list left top) (quad-origin dq))
-  (match-define (list right bottom)(size dq))
+  (match-define (list right bottom) (size dq))
   (save doc)
   (translate doc left (+ top (/ bottom 2)))
   (move-to doc 0 0)

quad/quadwriter/font.rkt

@@ -9,6 +9,7 @@
 (define-runtime-path default-font-face "fonts/source-serif/SourceSerifPro-Regular.otf")
 (define default-font-family "source-serif")
 (define default-font-size 12)
+(define default-line-height 16)
 
 (define font-paths (make-hash))
 

quad/quadwriter/lang-helper.rkt

@@ -1,11 +1,21 @@
 #lang debug racket/base
 (require (for-syntax racket/base)
          racket/match
+         syntax/strip-context
          scribble/reader
          quadwriter/core
          txexpr)
 (provide (all-defined-out))
 
+(define ((make-read-syntax expander-mod pt-proc) path-string p)
+  (strip-context
+   (with-syntax ([PATH-STRING path-string]
+                 [PT (pt-proc path-string p)]
+                 [EXPANDER-MOD expander-mod])
+     #'(module _ EXPANDER-MOD
+         PATH-STRING
+         . PT))))
+
 (define-syntax-rule (make-mb DOC-PROC)
   (begin
     (provide (rename-out [mb #%module-begin]))
@@ -41,4 +51,4 @@
     (match x
       [(txexpr tag attrs elems) (list* tag (cons 'attr-list attrs) (map loop elems))]
       [(? list? xs) (map loop xs)]
-      [_ x])))
+      [_ x])))

quad/quadwriter/main.rkt

@@ -1,26 +1,12 @@
 #lang debug racket/base
-(require (for-syntax racket/base)
-         quadwriter/core
-         pollen/tag
-         "lang-helper.rkt"
-         quad)
-(provide (except-out (all-from-out racket/base) #%module-begin)
-         q)
+(require pollen/tag "lang-helper.rkt")
+(provide #%top #%datum #%app #%top-interaction q)
 
 (define q (default-tag-function 'q))
-
-(define (doc-proc strs) (cons 'q strs))
+(define (doc-proc strs) (apply q strs))
 (make-mb doc-proc)
 
-(module+ reader
-  (require scribble/reader syntax/strip-context "lang-helper.rkt")
-  (provide (rename-out [quadwriter-rs read-syntax]))
-  
-  (define (quadwriter-rs path-string p)
-    (define stxs (quad-at-reader path-string p))
-    (strip-context
-     (with-syntax ([STXS stxs]
-                   [PDF-PATH (path-replace-extension path-string #".pdf")])
-       #'(module _ quadwriter/main
-           PDF-PATH
-           . STXS)))))
+(module reader racket/base
+  (require "lang-helper.rkt")
+  (provide read-syntax)
+  (define read-syntax (make-read-syntax 'quadwriter quad-at-reader)))

quad/quadwriter/markdown.rkt

@@ -1,12 +1,11 @@
 #lang debug racket/base
-(require (for-syntax)
-         racket/list
+(require racket/list
          racket/match
          quadwriter/core
          "tags.rkt"
          "lang-helper.rkt")
 (provide (all-defined-out)
-         #%app #%datum #%top-interaction
+         #%app #%top #%datum #%top-interaction
          (all-from-out "tags.rkt"))
 
 (define rsquo "’")
@@ -19,27 +18,17 @@
 
 (define (doc-proc exprs)
   (define strs (match exprs
-                 [(? null?) '(" ")]
+                 [(? null?) '(" ")] ; single nonbreaking space, so something prints
                  [strs strs]))
+  ;; markdown parser returns list of paragraphs
   (root null (add-between strs (list pbr)
                           #:before-first (list pbr)
                           #:after-last (list pbr)
                           #:splice? #true)))
-
 (make-mb doc-proc)
 
 (module reader racket/base
-  (require syntax/strip-context
-           racket/port
-           (only-in markdown parse-markdown)
-           "lang-helper.rkt")
-  (provide (rename-out [rs read-syntax]))
- 
-  (define (rs path-string p)
-    (define pt (xexpr->parse-tree (parse-markdown (port->string p))))
-    (strip-context
-     (with-syntax ([PATH-STRING path-string]
-                   [PT pt])
-       #'(module _ quadwriter/markdown
-           PATH-STRING
-           . PT)))))
+  (require racket/port markdown "lang-helper.rkt")
+  (provide read-syntax)
+  (define read-syntax (make-read-syntax 'quadwriter/markdown
+                       (λ (path-string p) (xexpr->parse-tree (parse-markdown (port->string p)))))))

quad/quadwriter/reader-helper.rkt

@@ -1,44 +0,0 @@
-#lang debug racket/base
-(require (for-syntax racket/base)
-         racket/match
-         scribble/reader
-         quadwriter/core
-         txexpr)
-(provide (all-defined-out))
-
-(define-syntax-rule (make-mb DOC-PROC)
-  (begin
-    (provide #%module-begin)
-    (define-syntax (#%module-begin stx)
-      (syntax-case stx ()
-        [(_ PATH-STRING . EXPRS)
-         (with-syntax ([DOC (datum->syntax #'PATH-STRING 'doc)])
-           #'(#%module-begin
-              ;; stick an nbsp in the strings so we have one printing char
-              (define DOC (DOC-PROC (list . EXPRS)))
-              (provide DOC)
-              (module+ main
-                (render-pdf DOC (path-string->pdf-path 'PATH-STRING)))))]))))
-
-(define (path-string->pdf-path path-string)
-  (match (format "~a" path-string)
-    ;; weird test but sometimes DrRacket calls the unsaved file
-    ;; 'unsaved-editor and sometimes "unsaved editor"
-    [(regexp #rx"unsaved.editor")
-     (build-path (find-system-path 'desk-dir) "untitled.pdf")]
-    [_ (path-replace-extension path-string #".pdf")]))
-
-(define quad-at-reader (make-at-reader
-                        #:syntax? #t 
-                        #:inside? #t
-                        #:command-char #\◊))
-
-(define (xexpr->parse-tree x)
-  ;; an ordinary txexpr can't serve as a parse tree because of the attrs list fails when passed to #%app.
-  ;; so stick an `attr-list` identifier on it which can hook into the expander.
-  ;; sort of SXML-ish.
-  (let loop ([x x])
-    (match x
-      [(txexpr tag attrs elems) (list* tag (cons 'attr-list attrs) (map loop elems))]
-      [(? list? xs) (map loop xs)]
-      [_ x])))