Added mutable-match-element-id-transformer

This commit is contained in:
Georges Dupéron 2016-09-20 21:57:42 +02:00
parent 49de4c776a
commit a5119a7b15
4 changed files with 1187 additions and 1169 deletions

View File

@ -1,4 +1,4 @@
#lang racket/base #lang reprovide
scribble-enhanced/manual-form
(require scribble-enhanced/manual-form) scribble-enhanced/manual-scheme
(provide (all-from-out scribble-enhanced/manual-form)) scribble-enhanced/racket

View File

@ -12,7 +12,7 @@
scribble/private/qsloc scribble/private/qsloc
scribble/private/manual-utils scribble/private/manual-utils
scribble/private/manual-vars scribble/private/manual-vars
scribble/private/manual-scheme "manual-scheme.rkt"
scribble/private/manual-bind scribble/private/manual-bind
scheme/list scheme/list
syntax/parse/define syntax/parse/define

View File

@ -1,13 +1,13 @@
#lang racket/base #lang racket/base
(require "../decode.rkt" (require scribble/decode
"../struct.rkt" scribble/struct
"../scheme.rkt" "racket.rkt";; was: "../scheme.rkt"
"../search.rkt" scribble/search
"../basic.rkt" scribble/basic
(only-in "../core.rkt" style style-properties) (only-in scribble/core style style-properties)
"manual-style.rkt" scribble/private/manual-style
"manual-utils.rkt" ;; used via datum->syntax scribble/private/manual-utils ;; used via datum->syntax
"on-demand.rkt" scribble/private/on-demand
(for-syntax racket/base) (for-syntax racket/base)
(for-label racket/base)) (for-label racket/base))

View File

@ -1,10 +1,10 @@
(module racket racket/base #lang racket/base
(require "core.rkt" (require scribble/core
"basic.rkt" scribble/basic
"search.rkt" scribble/search
"private/manual-sprop.rkt" scribble/private/manual-sprop
"private/on-demand.rkt" scribble/private/on-demand
"html-properties.rkt" scribble/html-properties
file/convertible file/convertible
racket/extflonum racket/extflonum
(for-syntax racket/base)) (for-syntax racket/base))
@ -972,6 +972,21 @@
" bound as an code-typesetting element transformer") " bound as an code-typesetting element transformer")
stx)))) stx))))
(begin-for-syntax
(require mutable-match-lambda)
(define mutable-match-element-id-transformer
(make-mutable-match-lambda/infer-name))
(define (try-mutable-match-element-id-transformer . vs)
(apply (apply make-mutable-match-lambda
(append (mutable-match-lambda-procedure-procs
mutable-match-element-id-transformer)
(list (clause->proc #:match-lambda [_ #f]))))
vs))
(provide mutable-match-element-id-transformer))
(define-syntax (define-code stx) (define-syntax (define-code stx)
(syntax-case stx () (syntax-case stx ()
[(_ code typeset-code uncode d->s stx-prop) [(_ code typeset-code uncode d->s stx-prop)
@ -994,6 +1009,9 @@
(wrap-loc v #f `(,#'make-var-id ',(variable-id-sym slv)))] (wrap-loc v #f `(,#'make-var-id ',(variable-id-sym slv)))]
[(element-id-transformer? slv) [(element-id-transformer? slv)
(wrap-loc v #f ((element-id-transformer-proc slv) v))] (wrap-loc v #f ((element-id-transformer-proc slv) v))]
[(try-mutable-match-element-id-transformer v)
=> (λ (transformed)
(wrap-loc v #f transformed))]
[(syntax? v) [(syntax? v)
(let ([mk (wrap-loc (let ([mk (wrap-loc
v v
@ -1379,4 +1397,4 @@
(max 1 (- (syntax-position pairs) undelta)) (max 1 (- (syntax-position pairs) undelta))
(+ (syntax-span pairs) undelta))))] (+ (syntax-span pairs) undelta))))]
[else [else
(datum->syntax #f v (vector #f line col (+ 1 col) 1))]))) (datum->syntax #f v (vector #f line col (+ 1 col) 1))]))