unfoob
parent
330a15faa5
commit
6011e383e6
@ -1,26 +1,12 @@
|
|||||||
#lang debug racket/base
|
#lang debug racket/base
|
||||||
(require (for-syntax racket/base)
|
(require pollen/tag "lang-helper.rkt")
|
||||||
quadwriter/core
|
(provide #%top #%datum #%app #%top-interaction q)
|
||||||
pollen/tag
|
|
||||||
"lang-helper.rkt"
|
|
||||||
quad)
|
|
||||||
(provide (except-out (all-from-out racket/base) #%module-begin)
|
|
||||||
q)
|
|
||||||
|
|
||||||
(define q (default-tag-function 'q))
|
(define q (default-tag-function 'q))
|
||||||
|
(define (doc-proc strs) (apply q strs))
|
||||||
(define (doc-proc strs) (cons 'q strs))
|
|
||||||
(make-mb doc-proc)
|
(make-mb doc-proc)
|
||||||
|
|
||||||
(module+ reader
|
(module reader racket/base
|
||||||
(require scribble/reader syntax/strip-context "lang-helper.rkt")
|
(require "lang-helper.rkt")
|
||||||
(provide (rename-out [quadwriter-rs read-syntax]))
|
(provide read-syntax)
|
||||||
|
(define read-syntax (make-read-syntax 'quadwriter quad-at-reader)))
|
||||||
(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)))))
|
|
@ -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])))
|
|
Loading…
Reference in New Issue