Moved examples for hyper-literate's added/removed/dimmed highlighting facility to the hyper-literate library.
This commit is contained in:
Georges Dupéron
parent
b7d00485ad
commit
63e1a77ef1
|
|
@ -1,228 +0,0 @@
|
|||
#lang hyper-literate #:♦ (dotlambda/unhygienic . type-expander/lang)
|
||||
|
||||
♦title{testttt}
|
||||
|
||||
♦(require (for-syntax syntax/parse
|
||||
(rename-in racket/base [... …]))
|
||||
scribble/core
|
||||
scribble/html-properties)
|
||||
♦(elem
|
||||
#:style (style "dim"
|
||||
(list (css-addition
|
||||
#"
|
||||
.dim > *:not(.undim) {
|
||||
style: \"brightness(150%) contrast(50%) opacity(0.7)\";
|
||||
background: rgba(255, 255, 255, 0.36);
|
||||
}
|
||||
|
||||
.undim {
|
||||
style: initial;
|
||||
background: none;
|
||||
}")
|
||||
|
||||
(js-addition
|
||||
#"
|
||||
(function(f) {
|
||||
// A 'simple' onLoad function
|
||||
if (window.document.readyState == 'complete') {
|
||||
f();
|
||||
} else if (window.document.addEventListener) {
|
||||
window.document.addEventListener('DOMContentLoaded', f, false);
|
||||
} else if (window.attachEvent) {
|
||||
window.attachEvent('onreadystatechange', function() {
|
||||
if (window.document.readyState == 'complete') {
|
||||
f();
|
||||
}
|
||||
});
|
||||
} else {
|
||||
var oldLoad = window.onload;
|
||||
if (typeof(oldLoad) == 'function') {
|
||||
window.onload = function() {
|
||||
try {
|
||||
oldLoad();
|
||||
} finally {
|
||||
f();
|
||||
}
|
||||
};
|
||||
} else {
|
||||
window.onload = f;
|
||||
}
|
||||
}
|
||||
})(function() {
|
||||
for (var starti = 0; starti < dims.length; starti++) {
|
||||
(function (){
|
||||
var start = dims.item(starti);
|
||||
while (!start.classList.contains('SCodeFlow')){
|
||||
start = start.parentNode;
|
||||
if (start == document) {
|
||||
return; // abort for this node
|
||||
}
|
||||
}
|
||||
var loopfn = function(mode, e) {
|
||||
var chs = e.childNodes;
|
||||
for (var chi = 0; chi < chs.length; chi++) {
|
||||
var ch = chs.item(chi);
|
||||
if (ch.classList !== undefined) {
|
||||
if (ch.classList.contains('dim')) {
|
||||
mode = 'dim';
|
||||
continue;
|
||||
} else if (ch.classList.contains('undim')) {
|
||||
mode = 'undim';
|
||||
continue;
|
||||
} else {
|
||||
ch.classList.add('el-' + mode);
|
||||
mode = loopfn(mode, ch);
|
||||
}
|
||||
}
|
||||
}
|
||||
return mode;
|
||||
}
|
||||
loopfn('undim', start);
|
||||
})();
|
||||
}
|
||||
});
|
||||
"))))
|
||||
|
||||
♦chunk[<a>
|
||||
(define x 1)]
|
||||
|
||||
♦(define-syntax-rule (patch-<a> new-name pat new)
|
||||
(begin
|
||||
(define-syntax (do-it stx)
|
||||
(syntax-parse #'(define x 1)
|
||||
[pat #`(chunk new-name new)]))
|
||||
(do-it)))
|
||||
|
||||
♦patch-<a>[<a2>
|
||||
(def n v)
|
||||
(def n (+ v 2))]
|
||||
|
||||
|
||||
♦(begin-for-syntax
|
||||
#;(define-splicing-syntax-class dim (pattern {~seq}))
|
||||
#;(define-splicing-syntax-class undim (pattern {~seq}))
|
||||
|
||||
(define (dim-elt last-known)
|
||||
(datum->syntax #'here
|
||||
(syntax->datum #'#,(elem #:style "dim"))
|
||||
last-known))
|
||||
(define (undim-elt last-known)
|
||||
(datum->syntax #'here
|
||||
(syntax->datum #'#,(elem #:style "undim"))
|
||||
last-known))
|
||||
|
||||
(define-syntax-class pat
|
||||
#:attributes (xpat xres)
|
||||
(pattern {~literal :dim}
|
||||
#:with xpat #'{~seq}
|
||||
#:with xres #'#,(dim-elt))
|
||||
(pattern {~literal :undim}
|
||||
#:with xpat #'{~seq}
|
||||
#:with xres #'#,(undim-elt))
|
||||
(pattern {~literal …}
|
||||
#:with xpat #'(… …)
|
||||
#:with xres #'xpat)
|
||||
(pattern x:id
|
||||
#:with (xpat) (generate-temporaries #'(x))
|
||||
#:with _ (begin (displayln (list #'x #'xpat)) 0)
|
||||
#:with xres #'xpat)
|
||||
(pattern (p:pat …)
|
||||
#:with (whole) (generate-temporaries #'(whole))
|
||||
#:with xpat #'{~and whole (p.xpat …)}
|
||||
#:with xres #'#,(quasisyntax/loc #'whole (p.xres …)))))
|
||||
|
||||
♦(define-syntax (hlite stx)
|
||||
(define (stx-or-first b)
|
||||
(if (syntax? b)
|
||||
b
|
||||
(car b)))
|
||||
(syntax-case stx ()
|
||||
[(self name guide1 . body)
|
||||
(and (identifier? #'self)
|
||||
(identifier? #'name))
|
||||
(let loop ([guide #'(_ _ . guide1)]
|
||||
[body (datum->syntax
|
||||
stx
|
||||
`(,(datum->syntax #'here 'chunk #'self)
|
||||
,#'name
|
||||
. ,(syntax-e #'body))
|
||||
stx)])
|
||||
(cond
|
||||
[(and (identifier? guide)
|
||||
(free-identifier=? guide (quote-syntax …)))
|
||||
(raise-syntax-error 'hlite
|
||||
"ellipses are not supported (yet)"
|
||||
guide)]
|
||||
[(and (identifier? guide)
|
||||
(free-identifier=? guide #':dim))
|
||||
(dim-elt (stx-or-first body))]
|
||||
[(and (identifier? guide)
|
||||
(free-identifier=? guide #':undim))
|
||||
(undim-elt (stx-or-first body))]
|
||||
[(identifier? guide)
|
||||
body]
|
||||
[(syntax? guide)
|
||||
;; TODO: probably not the best course of action (we're
|
||||
;; loosing some of the stx-list vs stx-pair information
|
||||
;; here).
|
||||
(loop (syntax-e guide) body)]
|
||||
;; TODO: check that this never lets "body" be something else
|
||||
;; than a syntax object or a list starting with a syntax
|
||||
;; object.
|
||||
[(and (pair? guide)
|
||||
(identifier? (car guide))
|
||||
(or (free-identifier=? (car guide) #':dim)
|
||||
(free-identifier=? (car guide) #':undim)))
|
||||
(cons (loop (car guide) body)
|
||||
(loop (cdr guide) body))]
|
||||
[(syntax? body)
|
||||
(datum->syntax body
|
||||
(loop guide (syntax-e body))
|
||||
body
|
||||
body)]
|
||||
[(pair? guide)
|
||||
(unless (pair? body)
|
||||
(raise-syntax-error
|
||||
'hlite
|
||||
(format
|
||||
"expected a pair, as indicated by the pattern ~a"
|
||||
(syntax->datum (datum->syntax #f guide)))
|
||||
body
|
||||
#f))
|
||||
(cons (loop (car guide) (car body))
|
||||
(loop (cdr guide) (cdr body)))]
|
||||
[else
|
||||
body]))])
|
||||
|
||||
;; Old implementation. Does not get the srclocs right for the escaped parts.
|
||||
#;(syntax-parser
|
||||
[(self name :pat . body)
|
||||
(displayln this-syntax)
|
||||
(local-require racket/pretty)
|
||||
(define result
|
||||
#`(begin
|
||||
#,#'(define-syntax do-it
|
||||
(syntax-parser
|
||||
[(self2 . xpat)
|
||||
#:with chk (syntax/loc #'self2 chunk)
|
||||
(displayln (quasisyntax/loc this-syntax
|
||||
(chk name . xres)))
|
||||
#`(elem #:style "highlightable"
|
||||
#,(quasisyntax/loc this-syntax
|
||||
(chk name . xres)))]))
|
||||
#,(quasisyntax/loc this-syntax
|
||||
(#,(syntax/loc #'self do-it) . body))))
|
||||
(pretty-print (syntax->datum result))
|
||||
result]))
|
||||
|
||||
♦hlite[<c> {:dim _ :undim _}
|
||||
a b]
|
||||
|
||||
♦hlite[<c> {:dim (def args :undim _ :dim _ _) a}
|
||||
(define (x v)
|
||||
(+ 1 1)
|
||||
(2 2 2) 3)
|
||||
42]
|
||||
|
||||
♦chunk[<*>
|
||||
<a>]
|
||||
|
|
@ -1,72 +0,0 @@
|
|||
#lang hyper-literate #:♦ racket/base
|
||||
♦;(dotlambda/unhygienic . racket/base)
|
||||
|
||||
♦title{testttt}
|
||||
|
||||
♦require[hyper-literate/diff1]
|
||||
♦(init)
|
||||
|
||||
We define the function foo as follows:
|
||||
|
||||
♦chunk[<foo>
|
||||
(define (foo v)
|
||||
(+ 1 v))]
|
||||
|
||||
However, due to implementation details, we need to add ♦racket[π] to this
|
||||
value:
|
||||
|
||||
♦hlite[|<foo'>| {/ (def args (_ _ + _ / . _))}
|
||||
(define (foo v)
|
||||
(+ 1 π . v))]
|
||||
|
||||
In order to optimise the sum of ♦racket[1] and ♦racket[π], we extract the
|
||||
computation to a global helper constant:
|
||||
|
||||
|
||||
♦hlite[|<foo''>| {+ _ _ / (def args '(+ a - b + c d . e) (_ - _ _ + _ / _)) = _}
|
||||
(define π 3.1414592653589793)
|
||||
(define one-pus-π (+ 1 π))
|
||||
(define (foo v)
|
||||
'(a b c d . e)
|
||||
(+ 1 π one-pus-π v))0]
|
||||
|
||||
♦hlite[|<www>| (/ (quote (+ a - b + c d . e))
|
||||
(quote (+ a - b + c d . e))
|
||||
(= quote (+ a - b + c d . e))
|
||||
(quote (quote (+ a - b + c d . e))))
|
||||
'(a b c d . e)
|
||||
(quote (a b c d . e))
|
||||
(quote (a b c d . e))
|
||||
''(a b c d . e)]
|
||||
|
||||
The whole program is therefore:
|
||||
|
||||
♦hlite[|<aaa>| {- a + b = c / d}
|
||||
1 2 3 4]
|
||||
|
||||
♦hlite[<bbb> {- (+ a - b = c)}
|
||||
(x y z)]
|
||||
|
||||
♦hlite[<ccc> {(z - (+ a - b / . c))}
|
||||
(0 (x y . z))]
|
||||
|
||||
♦hlite[<ddd> {(z - ((+ a a - b b / . c)))}
|
||||
(0 ((x x y yy . z)))]
|
||||
|
||||
♦hlite[<eee> {(z - ((+ a a - b b / . c)))}
|
||||
(0 ((x x y yy
|
||||
. z)))]
|
||||
|
||||
♦chunk[<*>
|
||||
(require rackunit)
|
||||
|<foo''>|
|
||||
(check-= (foo 42) (+ 42 1 3.1414592653589793) 0.1)
|
||||
(check-equal? (list <www>)
|
||||
'((a c d . e)
|
||||
(a c d . e)
|
||||
(a c d . e)
|
||||
(quote (a c d . e))))
|
||||
(check-equal? '(<aaa>) '(2 3 4))
|
||||
(check-equal? '(0 <bbb> 1) '(0 x z 1))
|
||||
(check-equal? '<ccc> '(0 x . z))
|
||||
(check-equal? '<ddd> '(0 x . z))]
|
||||
Loading…
Reference in New Issue
Block a user