cleaner

quad/quadwriter/lang-helper.rkt

@@ -0,0 +1,44 @@
+#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 (rename-out [mb #%module-begin]))
+    (define-syntax (mb 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])))

quad/quadwriter/main.rkt

@@ -2,26 +2,21 @@
 (require (for-syntax racket/base)
          quadwriter/core
          pollen/tag
+         "lang-helper.rkt"
          quad)
 (provide (except-out (all-from-out racket/base) #%module-begin)
-         (rename-out [mb #%module-begin])
          q)
 
 (define q (default-tag-function 'q))
 
-(define-syntax-rule (mb PDF-PATH . EXPRS)
-  (#%module-begin
-     (run (cons 'q (list . EXPRS)) PDF-PATH)))
+(define (doc-proc strs) (cons 'q strs))
+(make-mb doc-proc)
 
 (module+ reader
-  (require scribble/reader syntax/strip-context)
+  (require scribble/reader syntax/strip-context "lang-helper.rkt")
   (provide (rename-out [quadwriter-rs read-syntax]))
   
   (define (quadwriter-rs path-string p)
-    (define quad-at-reader (make-at-reader
-                            #:syntax? #t 
-                            #:inside? #t
-                            #:command-char #\◊))
     (define stxs (quad-at-reader path-string p))
     (strip-context
      (with-syntax ([STXS stxs]

quad/quadwriter/markdown.rkt

@@ -1,14 +1,11 @@
 #lang debug racket/base
-(require (for-syntax racket/base)
+(require (for-syntax)
          racket/list
          racket/match
          quadwriter/core
          "tags.rkt"
-         "font.rkt"
-         "reader-helper.rkt"
-         "param.rkt")
-(provide (except-out (all-defined-out) mb)
-         (rename-out [mb #%module-begin])
+         "lang-helper.rkt")
+(provide (all-defined-out)
          #%app #%datum #%top-interaction
          (all-from-out "tags.rkt"))
 
@@ -20,38 +17,29 @@
 (define ndash "–")
 (define mdash "—")
 
-(define-syntax (mb stx)
-  (syntax-case stx ()
-    [(_ PATH-STRING . STRS)
-     (with-syntax ([DOC (datum->syntax #'PATH-STRING 'doc)])
-       #'(#%module-begin
-          ;; stick an nbsp in the strings so we have one printing char
-          (define strs (match (list . STRS)
-                         [(? null?) '(" ")]
-                         [strs strs]))
-          (define DOC (root null (add-between strs (list pbr)
-                                              #:before-first (list pbr)
-                                              #:after-last (list pbr)
-                                              #:splice? #true)))
-          (provide DOC)
-          (module+ main
-            (render-pdf DOC (path-string->pdf-path 'PATH-STRING)))))]))
+(define (doc-proc exprs)
+  (define strs (match exprs
+                 [(? null?) '(" ")]
+                 [strs strs]))
+  (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)
-           "reader-helper.rkt")
+           "lang-helper.rkt")
   (provide (rename-out [rs read-syntax]))
  
   (define (rs path-string p)
-    (define stxs (quad-at-reader path-string p))
-    (define parsed-stxs
-      (datum->syntax stxs
-                     (xexpr->parse-tree
-                      (parse-markdown (apply string-append (syntax->datum stxs))))))
+    (define pt (xexpr->parse-tree (parse-markdown (port->string p))))
     (strip-context
      (with-syntax ([PATH-STRING path-string]
-                   [PARSED-STXS parsed-stxs])
+                   [PT pt])
        #'(module _ quadwriter/markdown
            PATH-STRING
-           . PARSED-STXS)))))
+           . PT)))))

quad/quadwriter/reader-helper.rkt

@@ -1,9 +1,25 @@
 #lang debug racket/base
-(require racket/match
+(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