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

checkpoint new GUI toolbox docs

Browse Source 
svn: r7109

original commit: c7c3d60b1666fcd4b1dba547bb7c64e7d61447ac
This commit is contained in:
Matthew Flatt 2007-08-17 16:19:31 +00:00
parent 96172c025d
commit 6d55647707
2 changed files with 35 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/scribble/html-render.ss
View File

@ -314,6 +314,16 @@
[else (error 'html-render "unrecognized style symbol: ~e" style)])]
[(string? style)
`((span ([class ,style]) ,@(super render-element e part ht)))]
[(and (pair? style)
(eq? (car style) 'show-color))
`((font ((style ,(format "background-color: ~a"
(apply string-append "#"
(map (lambda (v) (let ([s (format "0~x" v)])
(substring s (- (string-length s) 2))))
(cdr style))))))
(tt nbsp nbsp nbsp nbsp nbsp))
nbsp
,@(super render-element e part ht))]
[(target-url? style)
(if (current-no-links)
(super render-element e part ht)

36
collects/scribble/manual.ss
View File

@ -480,6 +480,20 @@
(define max-proto-width 65)
(define (name-this-object type-sym)
(to-element
(string->symbol
(regexp-replace
#rx"(%|<%>|-mixin)$"
(format "_a~a-~s"
(if (member
(string-ref (symbol->string type-sym) 0)
'(#\a #\e #\i #\o #\u))
"n"
"")
type-sym)
""))))
(define (*defproc mode within-id
stx-ids prototypes arg-contractss result-contracts content-thunk)
(let ([spacer (hspace 1)]
@ -564,17 +578,7 @@
(make-element #f
(list (scheme send)
(hspace 1)
(to-element (string->symbol
(regexp-replace
#rx"(%|<%>|-mixin)$"
(format "a~a-~s"
(if (member
(string-ref (symbol->string (syntax-e within-id)) 0)
'(#\a #\e #\i #\o #\u))
"n"
"")
(syntax-e within-id))
"")))
(name-this-object (syntax-e within-id))
(hspace 1)
(if first?
(let* ([mname (car prototype)]
@ -1225,6 +1229,7 @@
defmethod*
methspec
methimpl
this-obj
include-class)
(define-syntax-parameter current-class #f)
@ -1417,5 +1422,14 @@
(syntax-rules ()
[(_ body ...) (make-spec (lambda () (list (italic "Specification:") body ...)))]))
(define (*this-obj cname)
(name-this-object cname))
(define-syntax (this-obj stx)
(syntax-case stx ()
[(_)
(with-syntax ([cname (syntax-parameter-value #'current-class)])
#'(*this-obj 'cname))]))
;; ----------------------------------------
)