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

sync to trunk

Browse Source 
svn: r14627
This commit is contained in:
Sam Tobin-Hochstadt 2009-04-27 18:29:42 +00:00
commit 17602816ad
27 changed files with 253 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/framework/private/main.ss
View File

@ -58,6 +58,7 @@
("cond" 0)
("field" 0)
("provide/contract" 0)
("match" 1)
("new" 1)
("case" 1)
("syntax-rules" 1)

2
collects/mred/private/wxme/editor-canvas.ss
View File

@ -204,7 +204,7 @@
'(transparent)
'(no-autoclear))
(keep-style style 'control-border)
(keep-style style 'combo-side)
(keep-style style 'combo)
(keep-style style 'resize-corner))
name
gl-config)

14
collects/mred/private/wxme/text.ss
View File

@ -1700,9 +1700,7 @@
(set! write-locked? #t)
(if (not (can-delete? start (- end start)))
(begin
(set! write-locked? #f)
(set! flow-locked? #f))
(set! write-locked? #f)
(begin
(on-delete start (- end start))
@ -1917,11 +1915,11 @@
[([(make-alts exact-nonnegative-integer? (symbol-in start)) start]
[(make-alts exact-nonnegative-integer? (symbol-in back)) [end 'back]]
[any? [scroll-ok? #t]])
(do-delete (if (symbol? start) startpos start) end scroll-ok?)]
(do-delete (if (symbol? start) startpos start) end #t scroll-ok?)]
(method-name 'text% 'delete)))
(def/public (erase)
(do-delete 0 len #t))
(do-delete 0 len #t #t))
(def/override (clear)
(delete startpos endpos #t))
@ -4187,16 +4185,16 @@
(let ([at-start? (eq? (mline-snip line) snip1)]
[at-end? (eq? (mline-last-snip line) snip2)]
[wl? write-locked?]
[fl flow-locked?])
[fl? flow-locked?])
(set! read-locked? #t)
(set! write-locked? #t)
(set! flow-locked? #t)
(set-snip-flags! snip2 (add-flag (snip->flags snip2) CAN-SPLIT))
(let ([naya (send snip2 merge-with snip1)])
(set! read-locked? #t)
(set! read-locked? #f)
(set! write-locked? wl?)
(set! flow-locked? wl?)
(set! flow-locked? fl?)
(if naya
(begin

87
collects/scribble/base-render.ss
View File

@ -109,6 +109,22 @@
(and (pair? p)
(mobile-root? (car p))))
;; ----------------------------------------
(define/public (fresh-tag-collect-context? d ci)
#f)
(define/public (fresh-tag-resolve-context? d ri)
#f)
(define/public (fresh-tag-render-context? d ri)
#f)
(define/private (extend-prefix d fresh?)
(cond
[fresh? null]
[(part-tag-prefix d)
(cons (part-tag-prefix d) (current-tag-prefixes))]
[else (current-tag-prefixes)]))
;; ----------------------------------------
;; marshal info
@ -174,26 +190,28 @@
(make-collected-info number
parent
(collect-info-ht p-ci)))
(when (part-title-content d)
(collect-content (part-title-content d) p-ci))
(collect-part-tags d p-ci number)
(collect-content (part-to-collect d) p-ci)
(collect-flow (part-flow d) p-ci)
(let loop ([parts (part-parts d)]
[pos 1])
(unless (null? parts)
(let ([s (car parts)])
(collect-part s d p-ci
(cons (if (or (unnumbered-part? s)
(part-style? s 'unnumbered))
#f
pos)
number))
(loop (cdr parts)
(if (or (unnumbered-part? s)
(part-style? s 'unnumbered))
pos
(add1 pos))))))
(parameterize ([current-tag-prefixes
(extend-prefix d (fresh-tag-collect-context? d p-ci))])
(when (part-title-content d)
(collect-content (part-title-content d) p-ci))
(collect-part-tags d p-ci number)
(collect-content (part-to-collect d) p-ci)
(collect-flow (part-flow d) p-ci)
(let loop ([parts (part-parts d)]
[pos 1])
(unless (null? parts)
(let ([s (car parts)])
(collect-part s d p-ci
(cons (if (or (unnumbered-part? s)
(part-style? s 'unnumbered))
#f
pos)
number))
(loop (cdr parts)
(if (or (unnumbered-part? s)
(part-style? s 'unnumbered))
pos
(add1 pos)))))))
(let ([prefix (part-tag-prefix d)])
(for ([(k v) (collect-info-ht p-ci)])
(when (cadr k)
@ -216,9 +234,12 @@
(define/public (collect-part-tags d ci number)
(for ([t (part-tags d)])
(hash-set! (collect-info-ht ci)
(generate-tag t ci)
(list (or (part-title-content d) '("???")) number))))
(let ([t (generate-tag t ci)])
(hash-set! (collect-info-ht ci)
t
(list (or (part-title-content d) '("???"))
number
(add-current-tag-prefix t))))))
(define/public (collect-content c ci)
(for ([i c]) (collect-element i ci)))
@ -263,7 +284,8 @@
(for ([e (element-content i)]) (collect-element e ci))))))
(define/public (collect-target-element i ci)
(collect-put! ci (generate-tag (target-element-tag i) ci) (list i)))
(let ([t (generate-tag (target-element-tag i) ci)])
(collect-put! ci t (list i (add-current-tag-prefix t)))))
(define/public (collect-index-element i ci)
(collect-put! ci
@ -284,11 +306,13 @@
(map (lambda (d) (resolve-part d ri)) ds))
(define/public (resolve-part d ri)
(when (part-title-content d)
(resolve-content (part-title-content d) d ri))
(resolve-flow (part-flow d) d ri)
(for ([p (part-parts d)])
(resolve-part p ri)))
(parameterize ([current-tag-prefixes
(extend-prefix d (fresh-tag-resolve-context? d ri))])
(when (part-title-content d)
(resolve-content (part-title-content d) d ri))
(resolve-flow (part-flow d) d ri)
(for ([p (part-parts d)])
(resolve-part p ri))))
(define/public (resolve-content c d ri)
(for ([i c])
@ -373,6 +397,11 @@
(render-part d ri))
(define/public (render-part d ri)
(parameterize ([current-tag-prefixes
(extend-prefix d (fresh-tag-render-context? d ri))])
(render-part-content d ri)))
(define/public (render-part-content d ri)
(list
(when (part-title-content d)
(render-content (part-title-content d) d ri))

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

@ -230,6 +230,7 @@
(class %
(inherit render-content
render-block
render-part
collect-part
install-file
get-dest-directory
@ -295,6 +296,13 @@
(define/public (current-part-whole-page? d)
(eq? d (current-top-part)))
(define/override (fresh-tag-collect-context? d ci)
(current-part-whole-page? d))
(define/override (fresh-tag-resolve-context? d ri)
(part-whole-page? d ri))
(define/override (fresh-tag-render-context? d ri)
(part-whole-page? d ri))
(define/override (collect-part-tags d ci number)
(for ([t (part-tags d)])
(let ([key (generate-tag t ci)])
@ -303,7 +311,7 @@
(path->relative (current-output-file)))
(or (part-title-content d) '("???"))
(current-part-whole-page? d)
key)))))
(add-current-tag-prefix key))))))
(define/override (collect-target-element i ci)
(let ([key (generate-tag (target-element-tag i) ci)])
@ -320,7 +328,7 @@
(if (redirect-target-element? i)
(make-literal-anchor
(redirect-target-element-alt-anchor i))
key)))))
(add-current-tag-prefix key))))))
(define (dest-path dest)
(if (vector? dest) ; temporary
@ -556,10 +564,11 @@
,(format
"#~a"
(anchor-name
(tag-key (if (part? p)
(car (part-tags p))
(target-element-tag p))
ri)))]
(add-current-tag-prefix
(tag-key (if (part? p)
(car (part-tags p))
(target-element-tag p))
ri))))]
[class
,(cond
[(part? p) "tocsubseclink"]
@ -795,13 +804,15 @@
d
ri))))))
(define/override (render-part d ri)
(define/override (render-part-content d ri)
(let ([number (collected-info-number (part-collected-info d ri))])
`(,@(cond
[(and (not (part-title-content d)) (null? number)) null]
[(part-style? d 'hidden)
(map (lambda (t)
`(a ((name ,(format "~a" (anchor-name (tag-key t ri)))))))
`(a ((name ,(format "~a" (anchor-name
(add-current-tag-prefix
(tag-key t ri))))))))
(part-tags d))]
[else `((,(case (length number)
[(0) 'h2]
@ -811,7 +822,8 @@
,@(format-number number '((tt nbsp)))
,@(map (lambda (t)
`(a ([name ,(format "~a" (anchor-name
(tag-key t ri)))])))
(add-current-tag-prefix
(tag-key t ri))))])))
(part-tags d))
,@(if (part-title-content d)
(render-content (part-title-content d) d ri)
@ -875,8 +887,9 @@
;; (commented) hack in scribble-common.js)
`(noscript ,@(render-plain-element e part ri))))]
[(target-element? e)
`((a ([name ,(format "~a" (anchor-name (tag-key (target-element-tag e)
ri)))]))
`((a ([name ,(format "~a" (anchor-name (add-current-tag-prefix
(tag-key (target-element-tag e)
ri))))]))
,@(render-plain-element e part ri))]
[(and (link-element? e) (not (current-no-links)))
(parameterize ([current-no-links #t])

12
collects/scribble/latex-render.ss
View File

@ -6,6 +6,7 @@
scheme/port
scheme/path
scheme/string
scheme/list
setup/main-collects)
(provide render-mixin)
@ -33,6 +34,7 @@
(inherit render-block
render-content
render-part
install-file
format-number
extract-part-style-files)
@ -69,7 +71,7 @@
(render-part d ri)
(printf "\n\n\\postDoc\n\\end{document}\n")))
(define/override (render-part d ri)
(define/override (render-part-content d ri)
(let ([number (collected-info-number (part-collected-info d ri))])
(when (and (part-title-content d) (pair? number))
(when (part-style? d 'index)
@ -96,7 +98,7 @@
(printf "}")
(when (part-style? d 'index) (printf "\n\n")))
(for ([t (part-tags d)])
(printf "\\label{t:~a}\n\n" (t-encode (tag-key t ri))))
(printf "\\label{t:~a}\n\n" (t-encode (add-current-tag-prefix (tag-key t ri)))))
(render-flow (part-flow d) d ri #f)
(for ([sec (part-parts d)]) (render-part sec ri))
(when (part-style? d 'index) (printf "\\onecolumn\n\n"))
@ -139,7 +141,7 @@
(link-element? e))])
(when (target-element? e)
(printf "\\label{t:~a}"
(t-encode (tag-key (target-element-tag e) ri))))
(t-encode (add-current-tag-prefix (tag-key (target-element-tag e) ri)))))
(when part-label?
(printf "\\SecRef{")
(render-content
@ -216,7 +218,9 @@
(show-link-page-numbers)
(not (done-link-page-numbers)))
(printf ", \\pageref{t:~a}"
(t-encode (tag-key (link-element-tag e) ri))))
(t-encode
(let ([v (resolve-get part ri (link-element-tag e))])
(and v (last v))))))
null))
(define/private (t-encode s)

12
collects/scribble/private/manual-style.ss
View File

@ -2,6 +2,7 @@
(require "../decode.ss"
"../struct.ss"
"../basic.ss"
"manual-utils.ss"
scheme/list
scheme/string)
@ -175,14 +176,11 @@
(define (elemref #:underline? [u? #t] t . body)
(make-link-element (if u? #f "plainlink") (decode-content body) `(elem ,t)))
(define (doc-prefix doc s)
(if doc (list (module-path-prefix->string doc) s) s))
(define (secref s #:underline? [u? #t] #:doc [doc #f])
(make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc s))))
(define (seclink tag #:underline? [u? #t] #:doc [doc #f] . s)
(define (secref s #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f])
(make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc prefix s))))
(define (seclink tag #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f] . s)
(make-link-element (if u? #f "plainlink") (decode-content s)
`(part ,(doc-prefix doc tag))))
`(part ,(doc-prefix doc prefix tag))))
(define (other-manual #:underline? [u? #t] doc)
(secref #:doc doc #:underline? u? "top"))

14
collects/scribble/private/manual-tech.ss
View File

@ -7,19 +7,19 @@
(provide deftech tech techlink)
(define (*tech make-elem style doc s)
(define (*tech make-elem style doc prefix s)
(let* ([c (decode-content s)]
[s (string-foldcase (content->string c))]
[s (regexp-replace #rx"ies$" s "y")]
[s (regexp-replace #rx"s$" s "")]
[s (regexp-replace* #px"[-\\s]+" s " ")])
(make-elem style c (list 'tech (doc-prefix doc s)))))
(make-elem style c (list 'tech (doc-prefix doc prefix s)))))
(define (deftech #:style? [style? #t] . s)
(let* ([e (if style?
(apply defterm s)
(make-element #f (decode-content s)))]
[t (*tech make-target-element #f #f (list e))])
[t (*tech make-target-element #f #f #f (list e))])
(make-index-element #f
(list t)
(target-element-tag t)
@ -27,14 +27,14 @@
(list e)
'tech)))
(define (tech #:doc [doc #f] . s)
(define (tech #:doc [doc #f] #:tag-prefixes [prefix #f] . s)
(*tech (lambda (style c tag)
(make-link-element
style
(list (make-element "techinside" c))
tag))
"techoutside"
doc s))
doc prefix s))
(define (techlink #:doc [doc #f] . s)
(*tech make-link-element #f doc s))
(define (techlink #:doc [doc #f] #:tag-prefixes [prefix #f] . s)
(*tech make-link-element #f doc prefix s))

12
collects/scribble/private/manual-utils.ss
View File

@ -12,8 +12,16 @@
(define spacer (hspace 1))
(define (doc-prefix doc s)
(if doc (list (module-path-prefix->string doc) s) s))
(define doc-prefix
(case-lambda
[(doc s)
(if doc
(list (module-path-prefix->string doc) s)
s)]
[(doc prefix s)
(doc-prefix doc (if prefix
(append prefix (list s))
s))]))
(define (to-flow e)
(make-flow (list (make-omitable-paragraph (list e)))))

20
collects/scribble/scheme.ss
View File

@ -606,8 +606,24 @@
(typeset c #t pfx1 pfx sfx #t))
(begin-for-syntax
(define-struct variable-id (sym) #:omit-define-syntaxes)
(define-struct element-id-transformer (proc) #:omit-define-syntaxes))
(define-struct variable-id (sym)
#:omit-define-syntaxes
#:property prop:procedure (lambda (self stx)
(raise-syntax-error
#f
(string-append
"misuse of an identifier (not in `scheme', etc.) that is"
" bound as a code-typesetting variable")
stx)))
(define-struct element-id-transformer (proc)
#:omit-define-syntaxes
#:property prop:procedure (lambda (self stx)
(raise-syntax-error
#f
(string-append
"misuse of an identifier (not in `scheme', etc.) that is"
" bound as an code-typesetting element transformer")
stx))))
(define-syntax (define-code stx)
(syntax-case stx ()

37
collects/scribble/struct.ss
View File

@ -376,26 +376,35 @@
(define deserialize-generated-tag
(make-deserialize-info values values))
(provide generate-tag tag-key)
(provide generate-tag tag-key
current-tag-prefixes
add-current-tag-prefix)
(define (generate-tag tg ci)
(if (generated-tag? (cadr tg))
(let ([t (cadr tg)])
(list (car tg)
(let ([tags (collect-info-tags ci)])
(or (hash-ref tags t #f)
(let ([key (list* 'gentag
(hash-count tags)
(collect-info-gen-prefix ci))])
(hash-set! tags t key)
key)))))
tg))
(let ([t (cadr tg)])
(list (car tg)
(let ([tags (collect-info-tags ci)])
(or (hash-ref tags t #f)
(let ([key (list* 'gentag
(hash-count tags)
(collect-info-gen-prefix ci))])
(hash-set! tags t key)
key)))))
tg))
(define (tag-key tg ri)
(if (generated-tag? (cadr tg))
(list (car tg)
(hash-ref (collect-info-tags (resolve-info-ci ri)) (cadr tg)))
tg))
(list (car tg)
(hash-ref (collect-info-tags (resolve-info-ci ri)) (cadr tg)))
tg))
(define current-tag-prefixes (make-parameter null))
(define (add-current-tag-prefix t)
(let ([l (current-tag-prefixes)])
(if (null? l)
t
(cons (car t) (append l (cdr t))))))
;; ----------------------------------------

28
collects/scribblings/gui/canvas-class.scrbl
View File

@ -111,7 +111,7 @@ When tab-focus is enabled for a canvas, Tab, arrow, and Enter keyboard
@defmethod[(get-scroll-page [which (one-of/c 'horizontal 'vertical)])
(integer-in 1 10000)]{
(integer-in 1 1000000000)]{
Get the current page step size of a manual scrollbar. The result is
@scheme[0] if the scrollbar is not active or it is automatic.
@ -126,7 +126,7 @@ See also
@defmethod[(get-scroll-pos [which (one-of/c 'horizontal 'vertical)])
(integer-in 0 10000)]{
(integer-in 0 1000000000)]{
Gets the current value of a manual scrollbar. The result is always
@scheme[0] if the scrollbar is not active or it is automatic.
@ -141,7 +141,7 @@ See also
@defmethod[(get-scroll-range [which (one-of/c 'horizontal 'vertical)])
(integer-in 0 10000)]{
(integer-in 0 1000000000)]{
Gets the current maximum value of a manual scrollbar. The result is
always @scheme[0] if the scrollbar is not active or it is automatic.
@ -183,8 +183,8 @@ Gets the size in device units of the scrollable canvas area (as
}
@defmethod[(init-auto-scrollbars [horiz-pixels (or/c (integer-in 1 10000) false/c)]
[vert-pixels (or/c (integer-in 1 10000) false/c)]
@defmethod[(init-auto-scrollbars [horiz-pixels (or/c (integer-in 1 1000000000) false/c)]
[vert-pixels (or/c (integer-in 1 1000000000) false/c)]
[h-value (real-in 0.0 1.0)]
[v-value (real-in 0.0 1.0)])
void?]{
@ -222,12 +222,12 @@ See also
}
@defmethod[(init-manual-scrollbars [h-length (or/c (integer-in 0 10000) false/c)]
[v-length (or/c (integer-in 0 10000) false/c)]
[h-page (integer-in 1 10000)]
[v-page (integer-in 1 10000)]
[h-value (integer-in 0 10000)]
[v-value (integer-in 0 10000)])
@defmethod[(init-manual-scrollbars [h-length (or/c (integer-in 0 1000000000) false/c)]
[v-length (or/c (integer-in 0 1000000000) false/c)]
[h-page (integer-in 1 1000000000)]
[v-page (integer-in 1 1000000000)]
[h-value (integer-in 0 1000000000)]
[v-value (integer-in 0 1000000000)])
void?]{
Enables and initializes manual scrollbars for the canvas. A
@ -319,7 +319,7 @@ See also
@defmethod[(set-scroll-page [which (one-of/c 'horizontal 'vertical)]
[value (integer-in 1 10000)])
[value (integer-in 1 1000000000)])
void?]{
Set the current page step size of a manual scrollbar. (This method has
@ -336,7 +336,7 @@ See also
@defmethod[(set-scroll-pos [which (one-of/c 'horizontal 'vertical)]
[value (integer-in 0 10000)])
[value (integer-in 0 1000000000)])
void?]{
Sets the current value of a manual scrollbar. (This method has no
@ -356,7 +356,7 @@ See also
@defmethod[(set-scroll-range [which (one-of/c 'horizontal 'vertical)]
[value (integer-in 0 10000)])
[value (integer-in 0 1000000000)])
void?]{
Sets the current maximum value of a manual scrollbar. (This method has

2
collects/scribblings/gui/snip-class.scrbl
View File

@ -834,7 +834,7 @@ The snip's editor is usually internally locked for reading when this
@methimpl{
Creates a new @scheme[snip%] instance while @scheme[position]
Creates a new @scheme[snip%] instance with @scheme[position]
elements, and modifies @this-obj[] to decrement its count by
@scheme[position]. The nest snip is installed into @scheme[first] and
@this-obj[] is installed into @scheme[second].

2
collects/scribblings/reference/cont-marks.scrbl
View File

@ -166,7 +166,7 @@ for programmatic use.
A stack trace is extracted from an exception and displayed by the
default error display handler (see
@scheme[current-error-display-handler]) for exceptions other than
@scheme[error-display-handler]) for exceptions other than
@scheme[exn:fail:user] (see @scheme[raise-user-error] in
@secref["errorproc"]).}

6
collects/scribblings/reference/read.scrbl
View File

@ -29,7 +29,7 @@ See @secref["reader"] for information on the default reader in
@defproc[(read/recursive [in input-port? (current-input-port)]
[start (or/c char? #f) #f]
[readtable (or/c readtable? #f) (current-readtable)]
[graph? any/c #f])
[graph? any/c #t])
any]{
Similar to calling @scheme[read], but normally used during the dynamic
@ -77,7 +77,7 @@ See @secref["readtables"] for an extended example that uses
[in input-port? (current-input-port)]
[start (or/c char? #f) #f]
[readtable (or/c readtable? #f) (current-readtable)]
[graph? any/c #f])
[graph? any/c #t])
any]{
Analogous to calling @scheme[read/recursive], but the resulting value
@ -317,7 +317,7 @@ Like @scheme[read-syntax], but for Honu mode (see
@defproc[(read-honu/recursive [in input-port? (current-input-port)]
[start (or/c char? #f) #f]
[readtable (or/c readtable? #f) (current-readtable)]
[graph? any/c #f])
[graph? any/c #t])
any]{
Like @scheme[read/recursive], but for Honu mode (see

31
collects/scribblings/scribble/manual.scrbl
View File

@ -872,6 +872,7 @@ and @litchar{^} for subscripts and superscripts.}
@defproc[(secref [tag string?]
[#:doc module-path (or/c module-path? false/c) #f]
[#:tag-prefixes prefixes (or/c (listof string?) false/c) #f]
[#:underline? underline? any/c #t])
element?]{
@ -879,20 +880,29 @@ Inserts the hyperlinked title of the section tagged @scheme[tag], but
@schemeidfont{aux-element} items in the title content are omitted in the
hyperlink label.
If @scheme[module-path] is provided, the @scheme[tag] refers to a tag
with a prefix determined by @scheme[module-path]. When
If @scheme[#:doc module-path] is provided, the @scheme[tag] refers to
a tag with a prefix determined by @scheme[module-path]. When
@exec{setup-plt} renders documentation, it automatically adds a tag
prefix to the document based on the source module. Thus, for example,
to refer to a section of the PLT Scheme reference,
@scheme[module-path] would be @scheme['(lib
"scribblings/reference/reference.scrbl")].
The @scheme[#:tag-prefixes prefixes] argument similarly supports
selecting a particular section as determined by a path of tag
prefixes. When a @scheme[#:doc] argument is provided, then
@scheme[prefixes] should trace a path of tag-prefixed subsections to
reach the @scheme[tag] section. When @scheme[#:doc] is not provided,
the @scheme[prefixes] path is relative to any enclosing section (i.e.,
the youngest ancestor that produces a match).
If @scheme[underline?] is @scheme[#f], then the hyperlink is rendered
in HTML without an underline.}
@defproc[(seclink [tag string?]
[#:doc module-path (or/c module-path? false/c) #f]
[#:tag-prefixes prefixes (or/c (listof string?) false/c) #f]
[#:underline? underline? any/c #t]
[pre-content any/c] ...) element?]{
@ -968,17 +978,21 @@ If @scheme[style?] is true, then @scheme[defterm] is used on
@scheme[pre-content].}
@defproc[(tech [pre-content any/c] ...
[#:doc module-path (or/c module-path? false/c) #f])
[#:doc module-path (or/c module-path? false/c) #f]
[#:tag-prefixes prefixes (or/c (listof string?) false/c) #f])
element?]{
Produces an element for the @tech{decode}d @scheme[pre-content], and
hyperlinks it to the definition of the content as established by
@scheme[deftech]. The content's string form is normalized in the same
way as for @scheme[deftech]. The @scheme[#:doc] argument supports
cross-document references, like in @scheme[secref].
way as for @scheme[deftech]. The @scheme[#:doc] and
@scheme[#:tag-prefixes] arguments support cross-document and
section-specific references, like in @scheme[secref].
The hyperlink is relatively quiet, in that underlining in HTML output
appears only when the mouse is moved over the term.
With the default style files, the hyperlink created by @scheme[tech]
is somewhat quieter than most hyperlinks: the underline in HTML output
is gray, instead of blue, and the term and underline turn blue only
when the mouse is moved over the term.
In some cases, combining both natural-language uses of a term and
proper linking can require some creativity, even with the
@ -987,7 +1001,8 @@ defined, but a sentence uses the term ``binding,'' the latter can be
linked to the former using @schemefont["@tech{bind}ing"].}
@defproc[(techlink [pre-content any/c] ...
[#:doc module-path (or/c module-path? false/c) #f])
[#:doc module-path (or/c module-path? false/c) #f]
[#:tag-prefixes prefixes (or/c (listof string?) false/c) #f])
element?]{
Like @scheme[tech], but the link is not a quiet. For example, in HTML

2
collects/scribblings/scribble/struct.scrbl
View File

@ -189,7 +189,7 @@ added to a list value using @scheme[cons]; a prefix is not added to a
outside the part, including the use of tags in the part's
@scheme[tags] field. Typically, a document's main part has a tag
prefix that applies to the whole document; references to sections and
defined terms within the document from other documents must include,
defined terms within the document from other documents must include the prefix,
while references within the same document omit the prefix. Part
prefixes can be used within a document as well, to help disambiguate
references within the document.

22
src/mred/wxs/wxs_cnvs.cxx
View File

@ -874,7 +874,7 @@ static Scheme_Object *os_wxCanvasSetScrollPage(int n, Scheme_Object *p[])
x0 = WITH_VAR_STACK(unbundle_symset_orientation(p[POFFSET+0], "set-scroll-page in canvas%"));
x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 1, 10000, "set-scroll-page in canvas%"));
x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 1, 1000000000, "set-scroll-page in canvas%"));
WITH_VAR_STACK(((wxCanvas *)((Scheme_Class_Object *)p[0])->primdata)->SetScrollPage(x0, x1));
@ -898,7 +898,7 @@ static Scheme_Object *os_wxCanvasSetScrollRange(int n, Scheme_Object *p[])
x0 = WITH_VAR_STACK(unbundle_symset_orientation(p[POFFSET+0], "set-scroll-range in canvas%"));
x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 10000, "set-scroll-range in canvas%"));
x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 1000000000, "set-scroll-range in canvas%"));
WITH_VAR_STACK(((wxCanvas *)((Scheme_Class_Object *)p[0])->primdata)->SetScrollRange(x0, x1));
@ -922,7 +922,7 @@ static Scheme_Object *os_wxCanvasSetScrollPos(int n, Scheme_Object *p[])
x0 = WITH_VAR_STACK(unbundle_symset_orientation(p[POFFSET+0], "set-scroll-pos in canvas%"));
x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 10000, "set-scroll-pos in canvas%"));
x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 1000000000, "set-scroll-pos in canvas%"));
WITH_VAR_STACK(((wxCanvas *)((Scheme_Class_Object *)p[0])->primdata)->SetScrollPos(x0, x1));
@ -1146,18 +1146,18 @@ static Scheme_Object *os_wxCanvasSetScrollbars(int n, Scheme_Object *p[])
VAR_STACK_PUSH(0, p);
x0 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+0], 0, 10000, "set-scrollbars in canvas%"));
x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 10000, "set-scrollbars in canvas%"));
x2 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+2], 0, 10000, "set-scrollbars in canvas%"));
x3 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+3], 0, 10000, "set-scrollbars in canvas%"));
x4 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+4], 1, 10000, "set-scrollbars in canvas%"));
x5 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+5], 1, 10000, "set-scrollbars in canvas%"));
x0 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+0], 0, 1000000000, "set-scrollbars in canvas%"));
x1 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+1], 0, 1000000000, "set-scrollbars in canvas%"));
x2 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+2], 0, 1000000000, "set-scrollbars in canvas%"));
x3 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+3], 0, 1000000000, "set-scrollbars in canvas%"));
x4 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+4], 1, 1000000000, "set-scrollbars in canvas%"));
x5 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+5], 1, 1000000000, "set-scrollbars in canvas%"));
if (n > (POFFSET+6)) {
x6 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+6], 0, 10000, "set-scrollbars in canvas%"));
x6 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+6], 0, 1000000000, "set-scrollbars in canvas%"));
} else
x6 = 0;
if (n > (POFFSET+7)) {
x7 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+7], 0, 10000, "set-scrollbars in canvas%"));
x7 = WITH_VAR_STACK(objscheme_unbundle_integer_in(p[POFFSET+7], 0, 1000000000, "set-scrollbars in canvas%"));
} else
x7 = 0;
if (n > (POFFSET+8)) {

8
src/mred/wxs/wxs_cnvs.xc
View File

@ -80,7 +80,7 @@ static void wxSetResizeCorner(wxCanvas *c, Bool v)
// @ "get-scroll-units" : void GetScrollUnitsPerPage(int*,int*); : : / PANELREDIRECT[ FillZero(x0,x1); READY_TO_RETURN; return scheme_void]
@ "get-virtual-size" : void GetVirtualSize(int*,int*); : : / PANELREDIRECT[FillZero(x0,x1); READY_TO_RETURN; return scheme_void]
@ "set-scrollbars" : void SetScrollbars(rint[0|10000],rint[0|10000],rint[0|10000],rint[0|10000],rint[1|10000],rint[1|10000],rint[0|10000]=0,rint[0|10000]=0,bool=TRUE); : : / PANELREDIRECT[READY_TO_RETURN; return scheme_void]
@ "set-scrollbars" : void SetScrollbars(rint[0|1000000000],rint[0|1000000000],rint[0|1000000000],rint[0|1000000000],rint[1|1000000000],rint[1|1000000000],rint[0|1000000000]=0,rint[0|1000000000]=0,bool=TRUE); : : / PANELREDIRECT[READY_TO_RETURN; return scheme_void]
@ "show-scrollbars" : void EnableScrolling(bool,bool)
@ m "set-resize-corner" : void wxSetResizeCorner(bool)
@ "view-start" : void ViewStart(int*,int*); : : / PANELREDIRECT[FillZero(x0,x1); READY_TO_RETURN; return scheme_void]
@ -91,9 +91,9 @@ static void wxSetResizeCorner(wxCanvas *c, Bool v)
@ "get-scroll-range" : int GetScrollRange(SYM[orientation]);
@ "get-scroll-page" : int GetScrollPage(SYM[orientation]);
@ "set-scroll-pos" : void SetScrollPos(SYM[orientation], rint[0|10000]);
@ "set-scroll-range" : void SetScrollRange(SYM[orientation], rint[0|10000]);
@ "set-scroll-page" : void SetScrollPage(SYM[orientation], rint[1|10000]);
@ "set-scroll-pos" : void SetScrollPos(SYM[orientation], rint[0|1000000000]);
@ "set-scroll-range" : void SetScrollRange(SYM[orientation], rint[0|1000000000]);
@ "set-scroll-page" : void SetScrollPage(SYM[orientation], rint[1|1000000000]);
@ v "on-scroll" : void OnScroll(wxScrollEvent!); : JMPDECL/SETJMP/RESETJMP : / PANELREDIRECT[READY_TO_RETURN; return scheme_void]

4
src/mzscheme/src/module.c
View File

@ -2227,7 +2227,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn,
SCHEME_VEC_ELS(vec)[6] = mark_src;
SCHEME_VEC_ELS(vec)[7] = (can_override ? scheme_true : scheme_false);
SCHEME_VEC_ELS(vec)[8] = exets ? scheme_make_integer(exets[i]) : scheme_false;
SCHEME_VEC_ELS(vec)[9] = exets ? exinsps[i] : scheme_false;
SCHEME_VEC_ELS(vec)[9] = exinsps ? exinsps[i] : scheme_false;
scheme_hash_set(required, exs[i], vec);
}
}
@ -6478,7 +6478,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
e = scheme_expand_expr(e, nenv, &erec1, 0);
}
lifted_reqs = scheme_append(scheme_frame_get_require_lifts(xenv), lifted_reqs);
lifted_reqs = scheme_append(scheme_frame_get_require_lifts(cenv), lifted_reqs);
l = scheme_frame_get_lifts(cenv);
if (SCHEME_NULLP(l)) {

2
src/worksp/mred/mred.manifest
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="4.1.5.4"
version="4.1.5.5"
processorArchitecture="X86"
name="Org.PLT-Scheme.MrEd"
type="win32"

8
src/worksp/mred/mred.rc
View File

@ -20,8 +20,8 @@ APPLICATION ICON DISCARDABLE "mred.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,1,5,4
PRODUCTVERSION 4,1,5,4
FILEVERSION 4,1,5,5
PRODUCTVERSION 4,1,5,5
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -39,11 +39,11 @@ BEGIN
VALUE "CompanyName", "PLT Scheme Inc.\0"
VALUE "FileDescription", "PLT Scheme GUI application\0"
VALUE "InternalName", "MrEd\0"
VALUE "FileVersion", "4, 1, 5, 4\0"
VALUE "FileVersion", "4, 1, 5, 5\0"
VALUE "LegalCopyright", "Copyright © 1995-2009\0"
VALUE "OriginalFilename", "MrEd.exe\0"
VALUE "ProductName", "PLT Scheme\0"
VALUE "ProductVersion", "4, 1, 5, 4\0"
VALUE "ProductVersion", "4, 1, 5, 5\0"
END
END
BLOCK "VarFileInfo"

8
src/worksp/mzcom/mzcom.rc
View File

@ -53,8 +53,8 @@ END
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,1,5,4
PRODUCTVERSION 4,1,5,4
FILEVERSION 4,1,5,5
PRODUCTVERSION 4,1,5,5
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -70,12 +70,12 @@ BEGIN
BLOCK "040904b0"
BEGIN
VALUE "FileDescription", "MzCOM Module"
VALUE "FileVersion", "4, 1, 5, 4"
VALUE "FileVersion", "4, 1, 5, 5"
VALUE "InternalName", "MzCOM"
VALUE "LegalCopyright", "Copyright 2000-2009 PLT (Paul Steckler)"
VALUE "OriginalFilename", "MzCOM.EXE"
VALUE "ProductName", "MzCOM Module"
VALUE "ProductVersion", "4, 1, 5, 4"
VALUE "ProductVersion", "4, 1, 5, 5"
END
END
BLOCK "VarFileInfo"

6
src/worksp/mzcom/mzobj.rgs
View File

@ -1,19 +1,19 @@
HKCR
{
MzCOM.MzObj.4.1.5.4 = s 'MzObj Class'
MzCOM.MzObj.4.1.5.5 = s 'MzObj Class'
{
CLSID = s '{A3B0AF9E-2AB0-11D4-B6D2-0060089002FE}'
}
MzCOM.MzObj = s 'MzObj Class'
{
CLSID = s '{A3B0AF9E-2AB0-11D4-B6D2-0060089002FE}'
CurVer = s 'MzCOM.MzObj.4.1.5.4'
CurVer = s 'MzCOM.MzObj.4.1.5.5'
}
NoRemove CLSID
{
ForceRemove {A3B0AF9E-2AB0-11D4-B6D2-0060089002FE} = s 'MzObj Class'
{
ProgID = s 'MzCOM.MzObj.4.1.5.4'
ProgID = s 'MzCOM.MzObj.4.1.5.5'
VersionIndependentProgID = s 'MzCOM.MzObj'
ForceRemove 'Programmable'
LocalServer32 = s '%MODULE%'

8
src/worksp/mzscheme/mzscheme.rc
View File

@ -29,8 +29,8 @@ APPLICATION ICON DISCARDABLE "mzscheme.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,1,5,4
PRODUCTVERSION 4,1,5,4
FILEVERSION 4,1,5,5
PRODUCTVERSION 4,1,5,5
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -48,11 +48,11 @@ BEGIN
VALUE "CompanyName", "PLT Scheme Inc.\0"
VALUE "FileDescription", "PLT Scheme application\0"
VALUE "InternalName", "MzScheme\0"
VALUE "FileVersion", "4, 1, 5, 4\0"
VALUE "FileVersion", "4, 1, 5, 5\0"
VALUE "LegalCopyright", "Copyright <20>© 1995-2009\0"
VALUE "OriginalFilename", "mzscheme.exe\0"
VALUE "ProductName", "PLT Scheme\0"
VALUE "ProductVersion", "4, 1, 5, 4\0"
VALUE "ProductVersion", "4, 1, 5, 5\0"
END
END
BLOCK "VarFileInfo"

8
src/worksp/starters/start.rc
View File

@ -22,8 +22,8 @@ APPLICATION ICON DISCARDABLE "mzstart.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,1,5,4
PRODUCTVERSION 4,1,5,4
FILEVERSION 4,1,5,5
PRODUCTVERSION 4,1,5,5
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -45,7 +45,7 @@ BEGIN
#ifdef MZSTART
VALUE "FileDescription", "PLT Scheme Launcher\0"
#endif
VALUE "FileVersion", "4, 1, 5, 4\0"
VALUE "FileVersion", "4, 1, 5, 5\0"
#ifdef MRSTART
VALUE "InternalName", "mrstart\0"
#endif
@ -60,7 +60,7 @@ BEGIN
VALUE "OriginalFilename", "MzStart.exe\0"
#endif
VALUE "ProductName", "PLT Scheme\0"
VALUE "ProductVersion", "4, 1, 5, 4\0"
VALUE "ProductVersion", "4, 1, 5, 5\0"
END
END
BLOCK "VarFileInfo"

12
src/wxwindow/src/msw/wx_win.cxx
View File

@ -2404,6 +2404,18 @@ void wxSubWnd::OnHScroll( WORD wParam, WORD pos, HWND control)
case SB_THUMBTRACK:
event->moveType = wxEVENT_TYPE_SCROLL_THUMBTRACK;
{
/* Work-around for 16-bit limit on incoming `pos' */
SCROLLINFO si;
ZeroMemory(&si, sizeof(si));
si.cbSize = sizeof(si);
si.fMask = SIF_TRACKPOS;
if (GetScrollInfo(handle, SB_HORZ, &si)) {
pos = si.nTrackPos;
event->pos = pos;
}
}
break;
default: