From a8a0eb8a285a76ce47acec77d6d487548c3659df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Mon, 22 May 2017 04:25:23 +0200 Subject: [PATCH] Found quick&dirty way to embed the result of (init) whenever hlite is used. Added removed-but-with-another-style modes -/ -= -+ --- diff1.rkt | 34 ++++++++++++++++++++++---------- scribblings/diff1-example.hl.rkt | 13 ------------ 2 files changed, 24 insertions(+), 23 deletions(-) diff --git a/diff1.rkt b/diff1.rkt index 23aaf9e6..069e1bce 100644 --- a/diff1.rkt +++ b/diff1.rkt @@ -1,7 +1,6 @@ #lang at-exp racket/base -(provide hlite - init) +(provide hlite) (require hyper-literate (for-syntax syntax/parse @@ -106,6 +105,9 @@ [(and (identifier? g) (free-identifier=? g #'=)) '=] [(and (identifier? g) (free-identifier=? g #'-)) '-] [(and (identifier? g) (free-identifier=? g #'+)) '+] + [(and (identifier? g) (free-identifier=? g #'-/)) '-/] + [(and (identifier? g) (free-identifier=? g #'-=)) '-=] + [(and (identifier? g) (free-identifier=? g #'-+)) '-+] [(identifier? g) '_] [(syntax? g) (simplify-guide (syntax-e g))] [(pair? g) (cons (simplify-guide (car g)) @@ -116,7 +118,10 @@ [(/) "HyperLiterateDim"] [(=) "HyperLiterateNormal"] [(-) "HyperLiterateRemove"] - [(+) "HyperLiterateAdd"])) + [(+) "HyperLiterateAdd"] + [(-/) "HyperLiterateDim"] + [(-=) "HyperLiterateNormal"] + [(-+) "HyperLiterateAdd"])) (define simplified-guide (simplify-guide #'guide1)) (define (syntax-e? v) (if (syntax? v) (syntax-e v) v)) @@ -125,7 +130,7 @@ [guide simplified-guide] [body #'body]) (match guide - [(cons (and new-mode (or '/ '= '- '+)) rest-guide) + [(cons (and new-mode (or '/ '= '- '+ '-/ '-= '-+)) rest-guide) (loop new-mode rest-guide body)] [(list car-guide rest-guide) #:when (and (pair? (syntax-e? body)) @@ -168,7 +173,7 @@ [acc '()]) (cond [(and (pair? guide) - (memq (car guide) '(/ = - +))) + (memq (car guide) '(/ = - + -/ -= -+))) (if first-iteration? (loop (car guide) (cdr guide) body) ;; produce: @@ -224,7 +229,7 @@ (raise-syntax-error 'hlite ;; TODO: thread the syntax version of body, so that - ;; we can highligh the error. + ;; we can highlight the error. "Expected non-null body, but found null" stx)) ;; produce: @@ -261,13 +266,21 @@ (build-source-location-list (update-source-location body #:span 0)))] ['() + (unless (stx-null? body) + (raise-syntax-error + 'hlite + ;; TODO: thread the syntax version of body, so that + ;; we can highlight the error. + (format "Expected null body, but found non-null ~a" + (syntax->datum body)) + stx)) body]))) (define new-executable-code (let loop ([mode '=] [guide simplified-guide] [body #'body]) (match guide - [(cons (and new-mode (or '/ '= '- '+)) rest-guide) + [(cons (and new-mode (or '/ '= '- '+ '-/ '-= '-+)) rest-guide) (loop new-mode rest-guide body)] [(cons car-guide rest-guide) (define (do-append-last-acc last-acc acc) @@ -296,7 +309,7 @@ [last-acc '()]) (cond [(and (pair? guide) - (memq (car guide) '(/ = - +))) + (memq (car guide) '(/ = - + -/ -= -+))) (if (or first-iteration? (eq? (car guide) mode)) (loop (car guide) (cdr guide) body) @@ -313,7 +326,7 @@ ;; accumulate the first element of body, if mode is not '- ;; which means that the element should be removed. (cond - [(and (eq? mode '-) + [(and (memq mode '(- -/ -= -+)) (or (pair? (car body)) (and (syntax? (car body)) (pair? (syntax-e (car body)))))) @@ -323,7 +336,7 @@ (cdr body) (do-append-last-acc last-acc acc) r))] - [(eq? mode '-) + [(memq mode '(- -/ -= -+)) (loop2 #f (cdr guide) (cdr body) @@ -361,6 +374,7 @@ ;(displayln new-body) ;(show-stx new-body) #`(begin + (init) #,(datum->syntax stx `(,(datum->syntax #'here 'chunk #'self) diff --git a/scribblings/diff1-example.hl.rkt b/scribblings/diff1-example.hl.rkt index 44b4bbbc..b98d8c9d 100644 --- a/scribblings/diff1-example.hl.rkt +++ b/scribblings/diff1-example.hl.rkt @@ -7,17 +7,6 @@ Highly experimental. Contains bugs, API may change in the future. -♦defproc[(init) any/c]{ - - For now, the ♦racket[init] function must be called somewhere in documents - which use ♦racketmodname[hyper-literate/diff1]. It produces helper values - which must be inserted in the scribble document. Simply adding this to the - document should be enough: - - ♦codeblock|{ - #lang hyper-literate #:♦ racket/base - ♦(init)}|} - ♦defform[(hlite name pat . body)]{ Like ♦racket[chunk], but highlights parts of the ♦racket[body] according to @@ -53,7 +42,6 @@ Highly experimental. Contains bugs, API may change in the future. It produces the result shown below:} ♦require[hyper-literate/diff1] -♦(init) ♦hlite[ {/ (def args (_ - _ + _ / . _))} (define (foo v) @@ -65,7 +53,6 @@ You can look at the source code of this document to see how this example is done. ♦require[hyper-literate/diff1] -♦(init) We define the function foo as follows: