suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make cat%' into a macro so ~a' etc get a proper name.

Browse Source
This commit is contained in:
Eli Barzilay 2013-02-24 04:36:20 -05:00
parent 7d2aa88f3d
commit cae6b53178
1 changed files with 36 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
collects/racket/format.rkt
View File

@ -133,8 +133,12 @@
;; ---------------------------------------- ;; ----------------------------------------
(define ((%cat who fmt [default-sep " "] [default-limit-marker "..."]) (define-syntax %cat
#:width [width #f] (syntax-rules ()
[(%cat who fmt) (%cat who fmt " ")]
[(%cat who fmt default-sep) (%cat who fmt default-sep "...")]
[(%cat who fmt default-sep default-limit-marker)
(let ([who (λ (#:width [width #f]
#:max-width [limit (or width +inf.0)] #:max-width [limit (or width +inf.0)]
#:limit-marker [limit-marker default-limit-marker] #:limit-marker [limit-marker default-limit-marker]
#:min-width [pad-to (or width 0)] #:min-width [pad-to (or width 0)]
@ -144,29 +148,29 @@
#:left-pad-string [left-padding padding] #:left-pad-string [left-padding padding]
#:separator [sep default-sep] #:separator [sep default-sep]
. s) . s)
(do-checks who limit limit-marker pad-to) (do-checks 'who limit limit-marker pad-to)
(%pad (%limit (if (and (pair? s) (null? (cdr s))) (%pad (%limit #:limit limit #:limit-marker limit-marker
(if (and (pair? s) (null? (cdr s)))
(fmt (car s)) (fmt (car s))
(apply string-append (apply string-append
(let ([s (map fmt s)]) (let ([s (map fmt s)])
(if (equal? sep "") (if (equal? sep "")
s s
(add-between s sep))))) (add-between s sep))))))
#:limit limit
#:limit-marker limit-marker)
#:pad-to pad-to #:pad-to pad-to
#:align align #:align align
#:left-padding left-padding #:left-padding left-padding
#:right-padding right-padding)) #:right-padding right-padding))])
who)]))
(define ~a (%cat '~a (lambda (v) (if (string? v) v (format "~a" v))) "" "")) (define ~a (%cat ~a (λ (v) (if (string? v) v (format "~a" v))) "" ""))
(define ~s (%cat '~s (lambda (v) (format "~s" v)))) (define ~s (%cat ~s (λ (v) (format "~s" v))))
(define ~v (%cat '~v (lambda (v) (format "~v" v)))) (define ~v (%cat ~v (λ (v) (format "~v" v))))
(define ~e (%cat '~e (lambda (v) (format "~e" v)))) (define ~e (%cat ~e (λ (v) (format "~e" v))))
(define ~.a (%cat '~.a (lambda (v) (format "~.a" v)) "" "")) (define ~.a (%cat ~.a (λ (v) (format "~.a" v)) "" ""))
(define ~.s (%cat '~.s (lambda (v) (format "~.s" v)))) (define ~.s (%cat ~.s (λ (v) (format "~.s" v))))
(define ~.v (%cat '~.v (lambda (v) (format "~.v" v)))) (define ~.v (%cat ~.v (λ (v) (format "~.v" v))))
;; ---- ;; ----