diff --git a/quad/quadwriter/lang-helper.rkt b/quad/quadwriter/lang-helper.rkt new file mode 100644 index 00000000..ea6b6504 --- /dev/null +++ b/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]))) \ No newline at end of file diff --git a/quad/quadwriter/main.rkt b/quad/quadwriter/main.rkt index c9e24e1a..f62cdce3 100644 --- a/quad/quadwriter/main.rkt +++ b/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] diff --git a/quad/quadwriter/markdown.rkt b/quad/quadwriter/markdown.rkt index 56c4787d..7429385a 100644 --- a/quad/quadwriter/markdown.rkt +++ b/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))))) \ No newline at end of file + . PT))))) \ No newline at end of file diff --git a/quad/quadwriter/reader-helper.rkt b/quad/quadwriter/reader-helper.rkt index 1c6c6f79..8ea5f0f1 100644 --- a/quad/quadwriter/reader-helper.rkt +++ b/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