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

raise GUI size limit to 1000000

Browse Source 
Add `dimension-integer?', `position-integer?',
`spacing-integer?', and `positive-dimension-integer?' to make
the documentation, especially, more parameterized over the
limit.

Also, make the slider limits match the dimension/position limit,
since they're often related.

Things go wrong with, for example, a canvas that is
larger than 32k in a dimension. It looks like there's
a problem on each platform, although not exactly the
same problem. Meanwhile, even larger scrollable panels
can work ok on platforms other than Windows.

Closes PR 13849

original commit: 2b1b8696f02fa59dea4278c2786fd21444204fc5
This commit is contained in:
Matthew Flatt 2013-08-07 09:46:21 -07:00
parent be8caf7ad8
commit 4ad4792778
62 changed files with 394 additions and 344 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/gui-pkgs/gui-doc/scribblings/framework/canvas.scrbl
View File

@ -79,7 +79,7 @@
The result of this mixin uses the same initialization arguments as the
mixin's argument.
@defmethod*[#:mode override (((on-size (width (integer-in 0 10000)) (height (integer-in 0 10000))) void?))]{
@defmethod*[#:mode override (((on-size (width dimension-integer?) (height dimension-integer?)) void?))]{
Adjusts the sizes of the marked snips.

32
pkgs/gui-pkgs/gui-doc/scribblings/framework/frame.scrbl
View File

@ -201,10 +201,10 @@
@defmixin[frame:size-pref-mixin (frame:basic<%>) (frame:size-pref<%>)]{
@defconstructor/auto-super[([size-preferences-key symbol?]
[position-preferences-key (or/c symbol? #f) #f]
[width (or/c (integer-in 0 10000) #f) #f]
[height (or/c (integer-in 0 10000) #f) #f]
[x (or/c (integer-in -10000 10000) #f) #f]
[y (or/c (integer-in -10000 10000) #f) #f])]{
[width (or/c dimension-integer? #f) #f]
[height (or/c dimension-integer? #f) #f]
[x (or/c position-integer? #f) #f]
[y (or/c position-integer? #f) #f])]{
The @racket[size-preferences-key] symbol is used with
@racket[preferences:get] and @racket[preferences:set] to track the current
@ -227,15 +227,15 @@
}
@defmethod[#:mode override (on-size (width (integer-in 0 10000))
(height (integer-in 0 10000)))
@defmethod[#:mode override (on-size (width dimension-integer?)
(height dimension-integer?))
void?]{
Updates the preferences, according to the width and
height. The preferences key is the one passed
to the initialization argument of the class.
}
@defmethod[#:mode override (on-move (width (integer-in -10000 10000))
(height (integer-in -10000 10000)))
@defmethod[#:mode override (on-move (width position-integer?)
(height position-integer?))
void?]{
Updates the preferences according to the width and
height, if @racket[position-preferences-key] is not @racket[#f], using
@ -575,10 +575,10 @@
@defconstructor[((filename string?)
(editor% (implementation?/c editor:basic<%>))
(parent (or/c (is-a?/c frame%) false/c) #f)
(width (or/c (integer-in 0 10000) false/c) #f)
(height (or/c (integer-in 0 10000) false/c) #f)
(x (or/c (integer-in -10000 10000) false/c) #f)
(y (or/c (integer-in -10000 10000) false/c) #f)
(width (or/c dimension-integer? false/c) #f)
(height (or/c dimension-integer? false/c) #f)
(x (or/c position-integer? false/c) #f)
(y (or/c position-integer? false/c) #f)
(style (listof (or/c 'no-resize-border
'no-caption
'no-system-menu
@ -590,11 +590,11 @@
'metal))
null)
(enabled any/c #t)
(border (integer-in 0 1000) 0)
(spacing (integer-in 0 1000) 0)
(border spacing-integer? 0)
(spacing spacing-integer? 0)
(alignment (list/c (or/c 'left 'center 'right) (or/c 'top 'center 'bottom)) '(center top))
(min-width (integer-in 0 10000) graphical-minimum-width)
(min-height (integer-in 0 10000) graphical-minimum-height)
(min-width dimension-integer? graphical-minimum-width)
(min-height dimension-integer? graphical-minimum-height)
(stretchable-width any/c #t)
(stretchable-height any/c #t))]{

30
pkgs/gui-pkgs/gui-doc/scribblings/gui/area-container-intf.scrbl
View File

@ -61,8 +61,8 @@ Suspends geometry management in the container's top-level window
}
@defmethod*[([(border)
(integer-in 0 1000)]
[(border [margin (integer-in 0 1000)])
spacing-integer?]
[(border [margin spacing-integer?])
void?])]{
Gets or sets the border margin for the container in pixels. This
@ -104,11 +104,11 @@ The
}
@defmethod[(container-size [info (listof (list/c (integer-in 0 10000)
(integer-in 0 10000)
@defmethod[(container-size [info (listof (list/c dimension-integer?
dimension-integer?
any/c
any/c))])
(values (integer-in 0 10000) (integer-in 0 10000))]{
(values dimension-integer? dimension-integer?)]{
Called to determine the minimum size of a container. See
@|geomdiscuss| for more information.
@ -149,16 +149,16 @@ Returns a list of the container's non-deleted children. (The non-deleted
}
@defmethod[(place-children [info (listof (list/c (integer-in 0 10000)
(integer-in 0 10000)
@defmethod[(place-children [info (listof (list/c dimension-integer?
dimension-integer?
any/c
any/c))]
[width (integer-in 0 10000)]
[height (integer-in 0 10000)])
(listof (list/c (integer-in 0 10000)
(integer-in 0 10000)
(integer-in 0 10000)
(integer-in 0 10000)))]{
[width dimension-integer?]
[height dimension-integer?])
(listof (list/c dimension-integer?
dimension-integer?
dimension-integer?
dimension-integer?))]{
Called to place the children of a container. See @|geomdiscuss|
for more information.
@ -213,8 +213,8 @@ Similarly, a container's vertical alignment can be @racket['top],
}
@defmethod*[([(spacing)
(integer-in 0 1000)]
[(spacing [spacing (integer-in 0 1000)])
spacing-integer?]
[(spacing [spacing spacing-integer?])
void?])]{
Gets or sets the spacing, in pixels, used between subareas in the

12
pkgs/gui-pkgs/gui-doc/scribblings/gui/area-intf.scrbl
View File

@ -25,8 +25,8 @@ All @racket[area<%>] classes accept the following named instantiation
@defmethod[(get-graphical-min-size)
(values (integer-in 0 10000)
(integer-in 0 10000))]{
(values dimension-integer?
dimension-integer?)]{
Returns the area's graphical minimum size as two values: the minimum
width and the minimum height (in pixels).
@ -56,8 +56,8 @@ Returns the area's closest frame or dialog ancestor. For a frame or
}
@defmethod*[([(min-width)
(integer-in 0 10000)]
[(min-width [w (integer-in 0 10000)])
dimension-integer?]
[(min-width [w dimension-integer?])
void?])]{
Gets or sets the area's minimum width (in pixels) for geometry
@ -78,8 +78,8 @@ When setting the minimum width, if @racket[w] is smaller than the
}
@defmethod*[([(min-height)
(integer-in 0 10000)]
[(min-height [h (integer-in 0 10000)])
dimension-integer?]
[(min-height [h dimension-integer?])
void?])]{
Gets or sets the area's minimum height for geometry management.

8
pkgs/gui-pkgs/gui-doc/scribblings/gui/button-class.scrbl
View File

@ -20,10 +20,10 @@ Whenever a button is clicked by the user, the button's callback
[style (listof (or/c 'border 'deleted)) null]
[font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #f]
[stretchable-height any/c #f])]{

40
pkgs/gui-pkgs/gui-doc/scribblings/gui/canvas-class.scrbl
View File

@ -18,10 +18,10 @@ A @racket[canvas%] object is a general-purpose window for drawing and
[label (or/c label-string? #f) #f]
[gl-config (or/c (is-a?/c gl-config%) #f) #f]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 0]
[horiz-margin (integer-in 0 1000) 0]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 0]
[horiz-margin spacing-integer? 0]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{
@ -101,7 +101,7 @@ The @racket[gl-config] argument determines properties of an OpenGL
@defmethod[(get-scroll-page [which (or/c 'horizontal 'vertical)])
(integer-in 1 1000000)]{
positive-dimension-integer?]{
Get the current page step size of a manual scrollbar. The result is
@racket[0] if the scrollbar is not active or it is automatic.
@ -116,7 +116,7 @@ See also
@defmethod[(get-scroll-pos [which (or/c 'horizontal 'vertical)])
(integer-in 0 1000000)]{
dimension-integer?]{
Gets the current value of a manual scrollbar. The result is always
@racket[0] if the scrollbar is not active or it is automatic.
@ -131,7 +131,7 @@ See also
@defmethod[(get-scroll-range [which (or/c 'horizontal 'vertical)])
(integer-in 0 1000000)]{
dimension-integer?]{
Gets the current maximum value of a manual scrollbar. The result is
always @racket[0] if the scrollbar is not active or it is automatic.
@ -146,7 +146,7 @@ See also
@defmethod[(get-view-start)
(values (integer-in 0 10000) (integer-in 0 10000))]{
(values dimension-integer? dimension-integer?)]{
Get the location at which the visible portion of the canvas
starts, based on the current values of the horizontal and
@ -163,7 +163,7 @@ If the scrollbars are disabled or initialized as manual (see
@defmethod[(get-virtual-size)
(value (integer-in 0 10000) (integer-in 0 10000))]{
(value dimension-integer? dimension-integer?)]{
Gets the size in device units of the scrollable canvas area (as
opposed to the client size, which is the area of the canvas currently
visible). This is the same size as the client size (as returned by
@ -173,8 +173,8 @@ Gets the size in device units of the scrollable canvas area (as
}
@defmethod[(init-auto-scrollbars [horiz-pixels (or/c (integer-in 1 1000000) #f)]
[vert-pixels (or/c (integer-in 1 1000000) #f)]
@defmethod[(init-auto-scrollbars [horiz-pixels (or/c positive-dimension-integer? #f)]
[vert-pixels (or/c positive-dimension-integer? #f)]
[h-value (real-in 0.0 1.0)]
[v-value (real-in 0.0 1.0)])
void?]{
@ -218,12 +218,12 @@ See also
}
@defmethod[(init-manual-scrollbars [h-length (or/c (integer-in 0 1000000) #f)]
[v-length (or/c (integer-in 0 1000000) #f)]
[h-page (integer-in 1 1000000)]
[v-page (integer-in 1 1000000)]
[h-value (integer-in 0 1000000)]
[v-value (integer-in 0 1000000)])
@defmethod[(init-manual-scrollbars [h-length (or/c dimension-integer? #f)]
[v-length (or/c dimension-integer? #f)]
[h-page positive-dimension-integer?]
[v-page positive-dimension-integer?]
[h-value dimension-integer?]
[v-value dimension-integer?])
void?]{
Enables and initializes manual scrollbars for the canvas. A
@ -339,7 +339,7 @@ See also
@defmethod[(set-scroll-page [which (or/c 'horizontal 'vertical)]
[value (integer-in 1 1000000)])
[value positive-dimension-integer?])
void?]{
Set the current page step size of a manual scrollbar. (This method has
@ -356,7 +356,7 @@ See also
@defmethod[(set-scroll-pos [which (or/c 'horizontal 'vertical)]
[value (integer-in 0 1000000)])
[value dimension-integer?])
void?]{
Sets the current value of a manual scrollbar. (This method has no
@ -376,7 +376,7 @@ See also
@defmethod[(set-scroll-range [which (or/c 'horizontal 'vertical)]
[value (integer-in 0 1000000)])
[value dimension-integer?])
void?]{
Sets the current maximum value of a manual scrollbar. (This method has

8
pkgs/gui-pkgs/gui-doc/scribblings/gui/canvas-intf.scrbl
View File

@ -140,8 +140,8 @@ drawing.
@defmethod*[([(min-client-height)
(integer-in 0 10000)]
[(min-client-height [h (integer-in 0 10000)])
dimension-integer?]
[(min-client-height [h dimension-integer?])
void?])]{
Gets or sets the canvas's minimum height for geometry management,
@ -156,8 +156,8 @@ The minimum height is ignored when it is smaller than the canvas's
@defmethod*[([(min-client-width)
(integer-in 0 10000)]
[(min-client-width [w (integer-in 0 10000)])
dimension-integer?]
[(min-client-width [w dimension-integer?])
void?])]{
Gets or sets the canvas's minimum width for geometry management, based

8
pkgs/gui-pkgs/gui-doc/scribblings/gui/check-box-class.scrbl
View File

@ -24,10 +24,10 @@ Whenever a check box is clicked by the user, the check box's value is
[value any/c #f]
[font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #f]
[stretchable-height any/c #f])]{

8
pkgs/gui-pkgs/gui-doc/scribblings/gui/choice-class.scrbl
View File

@ -29,10 +29,10 @@ See also @racket[list-box%].
[selection exact-nonnegative-integer? 0]
[font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #f]
[stretchable-height any/c #f])]{

8
pkgs/gui-pkgs/gui-doc/scribblings/gui/combo-field-class.scrbl
View File

@ -27,10 +27,10 @@ A @racket[combo-field%] object is a @racket[text-field%]
null]
[font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #f])]{

16
pkgs/gui-pkgs/gui-doc/scribblings/gui/dialog-class.scrbl
View File

@ -9,21 +9,21 @@ A dialog is a top-level window that is @defterm{modal}: while the
@defconstructor[([label label-string?]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
[width (or/c (integer-in 0 10000) #f) #f]
[height (or/c (integer-in 0 10000) #f) #f]
[x (or/c (integer-in 0 10000) #f) #f]
[y (or/c (integer-in 0 10000) #f) #f]
[width (or/c dimension-integer? #f) #f]
[height (or/c dimension-integer? #f) #f]
[x (or/c dimension-integer? #f) #f]
[y (or/c dimension-integer? #f) #f]
[style (listof (or/c 'no-caption 'resize-border
'no-sheet 'close-button))
null]
[enabled any/c #t]
[border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0]
[border spacing-integer? 0]
[spacing spacing-integer? 0]
[alignment (list/c (or/c 'left 'center 'right)
(or/c 'top 'center 'bottom))
'(center top)]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{

16
pkgs/gui-pkgs/gui-doc/scribblings/gui/editor-canvas-class.scrbl
View File

@ -22,13 +22,13 @@ An @racket[editor-canvas%] object manages and displays a
[label (or/c label-string? #f) #f]
[wheel-step (or/c (integer-in 1 10000) #f) 3]
[line-count (or/c (integer-in 1 1000) #f) #f]
[horizontal-inset (integer-in 0 1000) 5]
[vertical-inset (integer-in 0 1000) 5]
[horizontal-inset spacing-integer? 5]
[vertical-inset spacing-integer? 5]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 0]
[horiz-margin (integer-in 0 1000) 0]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 0]
[horiz-margin spacing-integer? 0]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{
@ -258,8 +258,8 @@ around the editor area is always cleared.
}
@defmethod[#:mode override
(on-size [width (integer-in 0 10000)]
[height (integer-in 0 10000)])
(on-size [width dimension-integer?]
[height dimension-integer?])
void?]{
If the canvas is displaying an editor, its @method[editor<%>

16
pkgs/gui-pkgs/gui-doc/scribblings/gui/frame-class.scrbl
View File

@ -9,21 +9,21 @@ A frame is a top-level container window. It has a title bar (which
@defconstructor[([label label-string?]
[parent (or/c (is-a?/c frame%) #f) #f]
[width (or/c (integer-in 0 10000) #f) #f]
[height (or/c (integer-in 0 10000) #f) #f]
[x (or/c (integer-in -10000 10000) #f) #f]
[y (or/c (integer-in -10000 10000) #f) #f]
[width (or/c dimension-integer? #f) #f]
[height (or/c dimension-integer? #f) #f]
[x (or/c position-integer? #f) #f]
[y (or/c position-integer? #f) #f]
[style (listof (or/c 'no-resize-border 'no-caption
'no-system-menu 'hide-menu-bar
'toolbar-button 'float 'metal)) null]
[enabled any/c #t]
[border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0]
[border spacing-integer? 0]
[spacing spacing-integer? 0]
[alignment (list/c (or/c 'left 'center 'right)
(or/c 'top 'center 'bottom))
'(center top)]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{

18
pkgs/gui-pkgs/gui-doc/scribblings/gui/gauge-class.scrbl
View File

@ -13,7 +13,7 @@ of the gauge.
@defconstructor[([label (or/c label-string? #f)]
[range (integer-in 1 1000000)]
[range positive-dimension-integer?]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%)
(is-a?/c panel%) (is-a?/c pane%))]
[style (listof (or/c 'horizontal 'vertical
@ -22,10 +22,10 @@ of the gauge.
'(horizontal)]
[font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c (memq 'horizontal style)]
[stretchable-height any/c (memq 'vertical style)])]{
@ -49,26 +49,26 @@ The @racket[style] list must include either @racket['horizontal],
}
@defmethod[(get-range)
(integer-in 1 1000000)]{
positive-dimension-integer?]{
Returns the range (maximum value) of the gauge.
}
@defmethod[(get-value)
(integer-in 0 1000000)]{
dimension-integer?]{
Returns the gauge's current value.
}
@defmethod[(set-range [range (integer-in 1 1000000)])
@defmethod[(set-range [range positive-dimension-integer?])
void?]{
Sets the range (maximum value) of the gauge.
}
@defmethod[(set-value [pos (integer-in 0 1000000)])
@defmethod[(set-value [pos dimension-integer?])
void?]{
Sets the gauge's current value. If the specified value is larger than

12
pkgs/gui-pkgs/gui-doc/scribblings/gui/group-box-panel-class.scrbl
View File

@ -19,15 +19,15 @@ Unlike most panel classes, a group-box panel's horizontal and vertical
[style (listof (or/c 'deleted)) null]
[font (is-a?/c font%) small-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[border spacing-integer? 0]
[spacing spacing-integer? 0]
[alignment (list/c (or/c 'left 'center 'right)
(or/c 'top 'center 'bottom))
'(center top)]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{

12
pkgs/gui-pkgs/gui-doc/scribblings/gui/horizontal-pane-class.scrbl
View File

@ -8,15 +8,15 @@ A horizontal pane arranges its subwindows in a single row. See also
@defconstructor[([parent (or/c (is-a?/c frame%) (is-a?/c dialog%)
(is-a?/c panel%) (is-a?/c pane%))]
[vert-margin (integer-in 0 1000) 0]
[horiz-margin (integer-in 0 1000) 0]
[border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0]
[vert-margin spacing-integer? 0]
[horiz-margin spacing-integer? 0]
[border spacing-integer? 0]
[spacing spacing-integer? 0]
[alignment (list/c (or/c 'left 'center 'right)
(or/c 'top 'center 'bottom))
'(left center)]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{

12
pkgs/gui-pkgs/gui-doc/scribblings/gui/horizontal-panel-class.scrbl
View File

@ -12,15 +12,15 @@ A horizontal panel arranges its subwindows in a single row. See also
'hscroll 'auto-hscroll
'vscroll 'auto-vscroll)) null]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 0]
[horiz-margin (integer-in 0 1000) 0]
[border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0]
[vert-margin spacing-integer? 0]
[horiz-margin spacing-integer? 0]
[border spacing-integer? 0]
[spacing spacing-integer? 0]
[alignment (list/c (or/c 'left 'center 'right)
(or/c 'top 'center 'bottom))
'(left center)]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{

20
pkgs/gui-pkgs/gui-doc/scribblings/gui/list-box-class.scrbl
View File

@ -48,10 +48,10 @@ See also @racket[choice%].
[font (is-a?/c font%) view-control-font]
[label-font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t]
[columns (cons/c label-string? (listof label-string?))
@ -182,9 +182,9 @@ See also @method[list-box% set-column-order].}
@defmethod[(get-column-width [column exact-nonnegative-integer?])
(values (integer-in 0 10000)
(integer-in 0 10000)
(integer-in 0 10000))]{
(values dimension-integer?
dimension-integer?
dimension-integer?)]{
Gets the width of the column identified by @racket[column] (in logical
positions, as opposed to display positions), which must be between 0
@ -309,9 +309,9 @@ See also @method[list-box% get-column-order].}
@defmethod[(set-column-width [column exact-nonnegative-integer?]
[width (integer-in 0 10000)]
[min-width (integer-in 0 10000)]
[max-width (integer-in 0 10000)])
[width dimension-integer?]
[min-width dimension-integer?]
[max-width dimension-integer?])
void?]{
Sets the width of the column identified by @racket[column] (in logical

8
pkgs/gui-pkgs/gui-doc/scribblings/gui/message-class.scrbl
View File

@ -17,10 +17,10 @@ A message control is a static line of text or a static bitmap. The
[style (listof (or/c 'deleted)) null]
[font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #f]
[stretchable-height any/c #f]
[auto-resize any/c #f])]{

29
pkgs/gui-pkgs/gui-doc/scribblings/gui/miscwin-funcs.scrbl
View File

@ -30,6 +30,16 @@ See also @racket[is-busy?].
Rings the system bell.
}
@defproc[(dimension-integer? [v any/c]) boolean?]{
Equivalent to @racket[(integer-in 0 1000000)].
Beware that certain kinds of windows behave badly when larger than
32,000 or so in either dimension on some platforms. Redraw of the
window may be disabled or clipped, for example.}
@defproc[(end-busy-cursor) void?]{
See @racket[begin-busy-cursor].
}
@ -300,6 +310,16 @@ On Mac OS X, Quicktime is used to play sounds; most sound
with OS 7.5 and up) is required.}
@defproc[(position-integer? [v any/c]) boolean?]{
Equivalent to @racket[(integer-in -1000000 1000000)].}
@defproc[(positive-dimension-integer? [v any/c]) boolean?]{
Equivalent to @racket[(integer-in 1 1000000)].}
@defproc[(register-collecting-blit [canvas (is-a?/c canvas%)]
[x real?]
[y real?]
@ -341,8 +361,8 @@ Unregisters all blit requests installed for @racket[canvas] with
@racket[register-collecting-blit].}
@defproc[(send-message-to-window [x (integer-in -10000 10000)]
[y (integer-in -10000 10000)]
@defproc[(send-message-to-window [x position-integer?]
[y position-integer?]
[message any/c])
any/c]{
@ -357,6 +377,11 @@ Unregisters all blit requests installed for @racket[canvas] with
}
@defproc[(spacing-integer? [v any/c]) boolean?]{
Equivalent to @racket[(integer-in 0 1000)].}
@defproc[(system-position-ok-before-cancel?) boolean?]{
Returns @racket[#t] on Windows---indicating that a dialog with

12
pkgs/gui-pkgs/gui-doc/scribblings/gui/pane-class.scrbl
View File

@ -17,15 +17,15 @@ See also @racket[grow-box-spacer-pane%].
@defconstructor[([parent (or/c (is-a?/c frame%) (is-a?/c dialog%)
(is-a?/c panel%) (is-a?/c pane%))]
[vert-margin (integer-in 0 1000) 0]
[horiz-margin (integer-in 0 1000) 0]
[border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0]
[vert-margin spacing-integer? 0]
[horiz-margin spacing-integer? 0]
[border spacing-integer? 0]
[spacing spacing-integer? 0]
[alignment (list/c (or/c 'left 'center 'right)
(or/c 'top 'center 'bottom))
'(center top)]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{

12
pkgs/gui-pkgs/gui-doc/scribblings/gui/panel-class.scrbl
View File

@ -23,15 +23,15 @@ A @racket[panel%] object has a degenerate placement strategy for
'hscroll 'auto-hscroll
'vscroll 'auto-vscroll)) null]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 0]
[horiz-margin (integer-in 0 1000) 0]
[border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0]
[vert-margin spacing-integer? 0]
[horiz-margin spacing-integer? 0]
[border spacing-integer? 0]
[spacing spacing-integer? 0]
[alignment (list/c (or/c 'left 'center 'right)
(or/c 'top 'center 'bottom))
'(center center)]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{

2
pkgs/gui-pkgs/gui-doc/scribblings/gui/popup-menu-class.scrbl
View File

@ -68,7 +68,7 @@ an item callback is invoked, if the user selected an item.)
}
@defmethod[(set-min-width [width (integer-in 0 10000)])
@defmethod[(set-min-width [width dimension-integer?])
void?]{
Sets the popup menu's minimum width in pixels.

8
pkgs/gui-pkgs/gui-doc/scribblings/gui/radio-box-class.scrbl
View File

@ -33,10 +33,10 @@ Whenever the user changes the selected radio button, the radio box's
[selection (or/c exact-nonnegative-integer? #f) 0]
[font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #f]
[stretchable-height any/c #f])]{

6
pkgs/gui-pkgs/gui-doc/scribblings/gui/scroll-event-class.scrbl
View File

@ -17,7 +17,7 @@ See
'page-up 'page-down 'thumb)
'thumb]
[direction (or/c 'horizontal 'vertical) 'vertical]
[position (integer-in 0 10000) 0]
[position dimension-integer? 0]
[time-stamp exact-integer? 0])]{
See the corresponding @racket[get-] and @racket[set-] methods for
@ -55,7 +55,7 @@ Returns the type of the event, one of the following:
}
@defmethod[(get-position)
(integer-in 0 10000)]{
dimension-integer?]{
Returns the position of the scrollbar after the action triggering the
event. See also @method[scroll-event% set-position].
@ -81,7 +81,7 @@ for information about each event type.
}
@defmethod[(set-position [position (integer-in 0 10000)])
@defmethod[(set-position [position dimension-integer?])
void?]{
Records the position of the scrollbar after the action triggering the

18
pkgs/gui-pkgs/gui-doc/scribblings/gui/slider-class.scrbl
View File

@ -17,22 +17,22 @@ Whenever the user changes the value of a slider, its callback
@defconstructor[([label (or/c label-string? #f)]
[min-value (integer-in -10000 10000)]
[max-value (integer-in -10000 10000)]
[min-value position-integer?]
[max-value position-integer?]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%)
(is-a?/c panel%) (is-a?/c pane%))]
[callback ((is-a?/c slider%) (is-a?/c control-event%) . -> . any) (lambda (b e) (void))]
[init-value (integer-in -10000 10000) min-value]
[init-value position-integer? min-value]
[style (listof (or/c 'horizontal 'vertical 'plain
'vertical-label 'horizontal-label
'deleted))
'(horizontal)]
[font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c (memq 'horizontal style)]
[stretchable-height any/c (memq 'vertical style)])]{
@ -63,13 +63,13 @@ The @racket[style] argument must include either @racket['vertical] for
}
@defmethod[(get-value)
(integer-in -10000 10000)]{
position-integer?]{
Gets the current slider value.
}
@defmethod[(set-value [value (integer-in -10000 10000)])
@defmethod[(set-value [value position-integer?])
void?]{
Sets the value (and displayed position) of the slider. (The control's

8
pkgs/gui-pkgs/gui-doc/scribblings/gui/subarea-intf.scrbl
View File

@ -21,8 +21,8 @@ All @racket[subarea<%>] classes accept the following named
@defmethod*[([(horiz-margin)
(integer-in 0 1000)]
[(horiz-margin [margin (integer-in 0 1000)])
spacing-integer?]
[(horiz-margin [margin spacing-integer?])
void?])]{
Gets or sets the area's horizontal margin, which is added both to the
@ -32,8 +32,8 @@ Gets or sets the area's horizontal margin, which is added both to the
}
@defmethod*[([(vert-margin)
(integer-in 0 1000)]
[(vert-margin [margin (integer-in 0 1000)])
spacing-integer?]
[(vert-margin [margin spacing-integer?])
void?])]{
Gets or sets the area's vertical margin, which is added both to the

12
pkgs/gui-pkgs/gui-doc/scribblings/gui/tab-panel-class.scrbl
View File

@ -26,15 +26,15 @@ The @racket[tab-panel%] class does not implement the virtual
[style (listof (or/c 'no-border 'deleted)) null]
[font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 0]
[horiz-margin (integer-in 0 1000) 0]
[border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0]
[vert-margin spacing-integer? 0]
[horiz-margin spacing-integer? 0]
[border spacing-integer? 0]
[spacing spacing-integer? 0]
[alignment (list/c (or/c 'left 'center 'right)
(or/c 'top 'center 'bottom))
'(center top)]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{

8
pkgs/gui-pkgs/gui-doc/scribblings/gui/text-field-class.scrbl
View File

@ -51,10 +51,10 @@ The keymap for the text field's editor is initialized by calling the
'(single)]
[font (is-a?/c font%) normal-control-font]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 2]
[horiz-margin (integer-in 0 1000) 2]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[vert-margin spacing-integer? 2]
[horiz-margin spacing-integer? 2]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c (memq 'multiple style)])]{

8
pkgs/gui-pkgs/gui-doc/scribblings/gui/top-level-window-intf.scrbl
View File

@ -107,8 +107,8 @@ See also @method[top-level-window<%> get-edit-target-window] and
}
@defmethod[(move [x (integer-in -10000 10000)]
[y (integer-in -10000 10000)])
@defmethod[(move [x position-integer?]
[y position-integer?])
void?]{
Moves the window to the given position on the screen.
@ -319,8 +319,8 @@ Checks whether the given event pops open the system menu in the
}
@defmethod[(resize [width (integer-in 0 10000)]
[height (integer-in 0 10000)])
@defmethod[(resize [width dimension-integer?]
[height dimension-integer?])
void?]{
Sets the size of the window (in pixels), but only if the given size is

12
pkgs/gui-pkgs/gui-doc/scribblings/gui/vertical-pane-class.scrbl
View File

@ -10,15 +10,15 @@ A vertical pane arranges its subwindows in a single column. See also @racket[pan
@defconstructor[([parent (or/c (is-a?/c frame%) (is-a?/c dialog%)
(is-a?/c panel%) (is-a?/c pane%))]
[vert-margin (integer-in 0 1000) 0]
[horiz-margin (integer-in 0 1000) 0]
[border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0]
[vert-margin spacing-integer? 0]
[horiz-margin spacing-integer? 0]
[border spacing-integer? 0]
[spacing spacing-integer? 0]
[alignment (list/c (or/c 'left 'center 'right)
(or/c 'top 'center 'bottom))
'(center top)]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{

12
pkgs/gui-pkgs/gui-doc/scribblings/gui/vertical-panel-class.scrbl
View File

@ -15,15 +15,15 @@ A vertical panel arranges its subwindows in a single column. See
'hscroll 'auto-hscroll
'vscroll 'auto-vscroll)) null]
[enabled any/c #t]
[vert-margin (integer-in 0 1000) 0]
[horiz-margin (integer-in 0 1000) 0]
[border (integer-in 0 1000) 0]
[spacing (integer-in 0 1000) 0]
[vert-margin spacing-integer? 0]
[horiz-margin spacing-integer? 0]
[border spacing-integer? 0]
[spacing spacing-integer? 0]
[alignment (list/c (or/c 'left 'center 'right)
(or/c 'top 'center 'bottom))
'(center top)]
[min-width (or/c (integer-in 0 10000) #f) #f]
[min-height (or/c (integer-in 0 10000) #f) #f]
[min-width (or/c dimension-integer? #f) #f]
[min-height (or/c dimension-integer? #f) #f]
[stretchable-width any/c #t]
[stretchable-height any/c #t])]{

48
pkgs/gui-pkgs/gui-doc/scribblings/gui/window-intf.scrbl
View File

@ -29,10 +29,10 @@ All @racket[window<%>] classes accept the following named instantiation
disabled. See also @method[window<%> on-drop-file].
}
@defmethod[(client->screen [x (integer-in -10000 10000)]
[y (integer-in -10000 10000)])
(values (integer-in -10000 10000)
(integer-in -10000 10000))]{
@defmethod[(client->screen [x position-integer?]
[y position-integer?])
(values position-integer?
position-integer?)]{
@index["global coordinates"]{Converts} local window coordinates to
screen coordinates.
@ -101,8 +101,8 @@ See also @method[window<%> get-handle].}
@defmethod[(get-client-size)
(values (integer-in 0 10000)
(integer-in 0 10000))]{
(values dimension-integer?
dimension-integer?)]{
Gets the interior size of the window in pixels. For a container, the
interior size is the size available for placing subwindows (including
@ -148,7 +148,7 @@ See also @method[window<%> get-client-handle].}
@defmethod[(get-height)
(integer-in 0 10000)]{
dimension-integer?]{
Returns the window's total height (in pixels).
@ -203,8 +203,8 @@ Like
@defmethod[(get-size)
(values (integer-in 0 10000)
(integer-in 0 10000))]{
(values dimension-integer?
dimension-integer?)]{
Gets the current size of the entire window in pixels, not counting
horizontal and vertical margins. (On Unix, this size does not include
@ -220,7 +220,7 @@ See also
@defmethod[(get-width)
(integer-in 0 10000)]{
dimension-integer?]{
Returns the window's current total width (in pixels).
@ -230,7 +230,7 @@ See also
}
@defmethod[(get-x)
(integer-in -10000 10000)]{
position-integer?]{
Returns the position of the window's left edge in its
parent's coordinate system.
@ -241,7 +241,7 @@ See also
}
@defmethod[(get-y)
(integer-in -10000 10000)]{
position-integer?]{
Returns the position of the window's top edge in its
parent's coordinate system.
@ -325,8 +325,8 @@ Does nothing.
}}
@defmethod[(on-move [x (integer-in -10000 10000)]
[y (integer-in -10000 10000)])
@defmethod[(on-move [x position-integer?]
[y position-integer?])
void?]{
@methspec{
@ -342,8 +342,8 @@ Does nothing.
}}
@defmethod[(on-size [width (integer-in 0 10000)]
[height (integer-in 0 10000)])
@defmethod[(on-size [width dimension-integer?]
[height dimension-integer?])
void?]{
@methspec{
@ -505,8 +505,8 @@ Does nothing.
}}
@defmethod[(popup-menu [menu (is-a?/c popup-menu%)]
[x (integer-in 0 10000)]
[y (integer-in 0 10000)])
[x position-integer?]
[y position-integer?])
void?]{
@popupmenuinfo["window" "window" ""]
@ -523,10 +523,10 @@ Enqueues an event to repaint the window.
}
@defmethod[(screen->client [x (integer-in -10000 10000)]
[y (integer-in -10000 10000)])
(values (integer-in -10000 10000)
(integer-in -10000 10000))]{
@defmethod[(screen->client [x position-integer?]
[y position-integer?])
(values position-integer?
position-integer?)]{
@index["global coordinates"]{Converts} global coordinates to window
local coordinates. See also @racket[client->screen] for information
@ -576,8 +576,8 @@ window is shown.
}
@defmethod[(warp-pointer [x (integer-in -10000 10000)]
[y (integer-in -10000 10000)])
@defmethod[(warp-pointer [x position-integer?]
[y position-integer?])
void?]{
Moves the cursor to the given location in the window's local coordinates.

4
pkgs/gui-pkgs/gui-lib/mred/mred-sig.rkt
View File

@ -45,6 +45,7 @@ cursor%
dc<%>
dc-path%
dialog%
dimension-integer?
editor-admin%
editor-canvas%
editor-data%
@ -156,6 +157,8 @@ pen-list%
play-sound
point%
popup-menu%
position-integer?
positive-dimension-integer?
post-script-dc%
printer-dc%
ps-setup%
@ -181,6 +184,7 @@ snip%
snip-admin%
snip-class%
snip-class-list<%>
spacing-integer?
special-control-key
special-option-key
string-snip%

16
pkgs/gui-pkgs/gui-lib/mred/private/check.rkt
View File

@ -107,16 +107,12 @@
i))
range))))
(define check-range-integer (check-bounded-integer 0 10000 #f))
(define check-slider-integer (check-bounded-integer -10000 10000 #f))
(define check-init-pos-integer (check-bounded-integer -10000 10000 #t))
(define check-slider-integer (check-bounded-integer (- GAUGE-MAX) GAUGE-MAX #f))
(define check-margin-integer (check-bounded-integer 0 1000 #f))
(define check-gauge-integer (check-bounded-integer 1 1000000 #f))
(define check-gauge-range-integer (check-bounded-integer 0 1000000 #f))
(define check-gauge-integer (check-bounded-integer 1 GAUGE-MAX #f))
(define check-gauge-range-integer (check-bounded-integer 0 GAUGE-MAX #f))
(define (check-wheel-step cwho wheel-step)
(when (and wheel-step
@ -148,8 +144,10 @@
(define (check-non-negative-integer/false who i)
(-check-non-negative-integer who i #t))
(define check-dimension (check-bounded-integer 0 10000 #t))
(define check-non#f-dimension (check-bounded-integer 0 10000 #f))
(define check-init-dimension (check-bounded-integer 0 WIN-SIZE-MAX #t))
(define check-dimension (check-bounded-integer 0 WIN-SIZE-MAX #f))
(define check-position (check-bounded-integer (- WIN-SIZE-MAX) WIN-SIZE-MAX #f))
(define check-init-position (check-bounded-integer (- WIN-SIZE-MAX) WIN-SIZE-MAX #t))
(define (check-label-string-or-bitmap who label)
(unless (or (label-string? label) (is-a? label wx:bitmap%))

9
pkgs/gui-pkgs/gui-lib/mred/private/const.rkt
View File

@ -17,10 +17,13 @@
;; the maximum hard-min-width of a gauge
(define const-max-gauge-length 150)
;; maximum reasonable minimum width/height
(define max-min 10000)
;; the maximum window size/position value:
(define WIN-SIZE-MAX 1000000)
;; the maximum slide/gauge value:
(define GAUGE-MAX WIN-SIZE-MAX)
(define side-combo-width (case (system-type)
[(windows) 20]
[(macosx) 18]

16
pkgs/gui-pkgs/gui-lib/mred/private/gdi.rkt
View File

@ -30,16 +30,16 @@
[(canvas x y w h on off on-x on-y off-x) (register-collecting-blit canvas x y w h on off on-x on-y off-x 0)]
[(canvas x y w h on off on-x on-y off-x off-y)
(check-instance 'register-collecting-blit canvas% 'canvas% #f canvas)
((check-bounded-integer -10000 10000 #f) 'register-collecting-blit x)
((check-bounded-integer -10000 10000 #f) 'register-collecting-blit y)
((check-bounded-integer 0 10000 #f) 'register-collecting-blit w)
((check-bounded-integer 0 10000 #f) 'register-collecting-blit h)
(check-position 'register-collecting-blit x)
(check-position 'register-collecting-blit y)
(check-dimension 'register-collecting-blit w)
(check-dimension 'register-collecting-blit h)
(check-instance 'register-collecting-blit wx:bitmap% 'bitmap% #f on)
(check-instance 'register-collecting-blit wx:bitmap% 'bitmap% #f off)
((check-bounded-integer -10000 10000 #f) 'register-collecting-blit on-x)
((check-bounded-integer -10000 10000 #f) 'register-collecting-blit on-y)
((check-bounded-integer -10000 10000 #f) 'register-collecting-blit off-x)
((check-bounded-integer -10000 10000 #f) 'register-collecting-blit off-y)
(check-position 'register-collecting-blit on-x)
(check-position 'register-collecting-blit on-y)
(check-position 'register-collecting-blit off-x)
(check-position 'register-collecting-blit off-y)
(wx:register-collecting-blit (mred->wx canvas) x y w h on off on-x on-y off-x off-y)]))
(define unregister-collecting-blit

8
pkgs/gui-pkgs/gui-lib/mred/private/mrcanvas.rkt
View File

@ -174,8 +174,8 @@
(when y-len (check-gauge-integer who y-len))
(check-gauge-integer who x-page)
(check-gauge-integer who y-page)
(check-range-integer who x-val)
(check-range-integer who y-val)
(check-gauge-integer who x-val)
(check-gauge-integer who y-val)
(when (and x-len (< x-len x-val))
(raise-arguments-error (who->name who)
"horizontal value is larger than the horizontal range"
@ -206,8 +206,8 @@
(unless (or (eq? d 'horizontal) (eq? d 'vertical))
(raise-argument-error (who->name `(method canvas% ,name)) "(or/c 'horizontal 'vertical)" d))
(let ([bottom (if must-positive? 1 0)])
(unless (<= bottom v 10000000)
((check-bounded-integer bottom 10000000 #f) `(method canvas% ,name) v))))
(unless (<= bottom v GAUGE-MAX)
((check-bounded-integer bottom GAUGE-MAX #f) `(method canvas% ,name) v))))
(define get-scroll-pos (entry-point (lambda (d) (check-scroll 'get-scroll-pos d 1 #f) (send wx get-scroll-pos d))))
(define set-scroll-pos (entry-point (lambda (d v) (check-scroll 'set-scroll-pos d v #f) (send wx set-scroll-pos d v))))

9
pkgs/gui-pkgs/gui-lib/mred/private/mrcontainer.rkt
View File

@ -108,11 +108,14 @@
(andmap
(lambda (l)
(and (list? l) (= (length l) 4)
(integer? (car l)) (exact? (car l)) (<= 0 (car l) 10000)
(integer? (cadr l)) (exact? (cadr l)) (<= 0 (cadr l) 10000)))
(integer? (car l)) (exact? (car l)) (<= 0 (car l) WIN-SIZE-MAX)
(integer? (cadr l)) (exact? (cadr l)) (<= 0 (cadr l) WIN-SIZE-MAX)))
l))
(raise-argument-error (who->name '(method area-container<%> container-size))
"(listof (list/c (integer-in 0 10000) (integer-in 0 10000) any/c any/c))"
(format
"(listof (list/c (integer-in 0 ~a) (integer-in 0 ~a) any/c any/c))"
WIN-SIZE-MAX
WIN-SIZE-MAX)
l))
(let ([l (send (get-wx-panel) do-get-graphical-min-size)])
(apply values l))))]

14
pkgs/gui-pkgs/gui-lib/mred/private/mred.rkt
View File

@ -41,7 +41,8 @@
"repl.rkt"
"helper.rkt"
"dynamic.rkt"
"check.rkt")
"check.rkt"
"const.rkt")
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These functions are re-implemented in scheme/gui/base
@ -172,6 +173,11 @@
[else ".gracketrc"]))]
[else #f])))
(define (dimension-integer? x) (and (exact-integer? x) (<= 0 x WIN-SIZE-MAX)))
(define (position-integer? x) (and (exact-integer? x) (<= (- WIN-SIZE-MAX) x WIN-SIZE-MAX)))
(define (spacing-integer? x) (and (exact-integer? x) (<= 0 x 1000)))
(define (positive-dimension-integer? x) (and (exact-integer? x) (<= 1 x WIN-SIZE-MAX)))
(provide (all-from racket/draw)
(all-from racket/snip)
(all-from file/resource))
@ -286,4 +292,8 @@
system-position-ok-before-cancel?
label-string?
key-code-symbol?
find-graphical-system-path))
find-graphical-system-path
dimension-integer?
positive-dimension-integer?
position-integer?
spacing-integer?))

2
pkgs/gui-pkgs/gui-lib/mred/private/mrpopup.rkt
View File

@ -31,7 +31,7 @@
(send i on-demand)))
(send wx get-items)))]
[set-min-width (lambda (n)
(check-range-integer '(method popup-menu% set-min-width) n)
(check-dimension '(method popup-menu% set-min-width) n)
(send wx set-width n))]
[get-font (lambda ()
(send wx get-font))])

32
pkgs/gui-pkgs/gui-lib/mred/private/mrtop.rkt
View File

@ -93,14 +93,14 @@
[(dir) (send wx center dir)]))]
[move (entry-point
(lambda (x y)
(check-slider-integer '(method top-level-window<%> move) x)
(check-slider-integer '(method top-level-window<%> move) y)
(check-position '(method top-level-window<%> move) x)
(check-position '(method top-level-window<%> move) y)
(send wx move x y)))]
[resize (entry-point
(lambda (w h)
(check-range-integer '(method top-level-window<%> resize) w)
(check-range-integer '(method top-level-window<%> resize) h)
(send wx set-size -11111 -11111 w h)))]
(check-dimension '(method top-level-window<%> resize) w)
(check-dimension '(method top-level-window<%> resize) h)
(send wx set-size #f #f w h)))]
[get-focus-window (entry-point
(lambda () (let ([w (send wx get-focus-window)])
@ -166,10 +166,10 @@
(let ([cwho '(constructor frame)])
(check-label-string cwho label)
(check-frame-parent/false cwho parent)
(check-dimension cwho width)
(check-dimension cwho height)
(check-init-pos-integer cwho x)
(check-init-pos-integer cwho y)
(check-init-dimension cwho width)
(check-init-dimension cwho height)
(check-init-position cwho x)
(check-init-position cwho y)
(check-style cwho #f '(no-resize-border no-caption no-system-menu
toolbar-button hide-menu-bar float metal)
style))
@ -211,7 +211,7 @@
(lambda (finish)
(set! wx (finish (make-object wx-frame% this this
(and parent (mred->wx parent)) label
(or x -11111) (or y -11111)
x y ; each can be #f
(or width -1) (or height -1)
style)
#f))
@ -249,7 +249,10 @@
(let ([cwho '(constructor dialog)])
(check-label-string cwho label)
(check-top-level-parent/false cwho parent)
(for-each (lambda (x) (check-dimension cwho x)) (list width height x y))
(check-init-position cwho x)
(check-init-position cwho y)
(check-init-dimension cwho width)
(check-init-dimension cwho height)
(check-style cwho #f '(no-caption resize-border no-sheet close-button) style))
(rename-super [super-on-subwindow-char on-subwindow-char])
(define wx #f)
@ -270,7 +273,8 @@
(lambda (finish)
(set! wx (finish (make-object wx-dialog% this this
(and parent (mred->wx parent)) label
(or x -11111) (or y -11111) (or width 0) (or height 0)
x y ; each can be #f
(or width 0) (or height 0)
style)
#f))
wx)]
@ -317,8 +321,8 @@
(loop (cdr l) f s ms))))))
(define (send-message-to-window x y m)
(check-slider-integer 'send-message-to-window x)
(check-slider-integer 'send-message-to-window y)
(check-position 'send-message-to-window x)
(check-position 'send-message-to-window y)
(let ([w (wx:location->window x y)])
(and w (let ([f (wx->proxy w)])
(and f

28
pkgs/gui-pkgs/gui-lib/mred/private/mrwindow.rkt
View File

@ -41,8 +41,8 @@
[stretchable-width no-val]
[stretchable-height no-val])
(let ([cwho '(iconstructor area)])
(unless (eq? min-width no-val) (check-dimension cwho min-width))
(unless (eq? min-height no-val) (check-dimension cwho min-height)))
(unless (eq? min-width no-val) (check-init-dimension cwho min-width))
(unless (eq? min-height no-val) (check-init-dimension cwho min-height)))
(mismatches)
(define get-wx-outer-panel get-outer-wx-pan)
(define parent prnt)
@ -123,8 +123,8 @@
[popup-menu (entry-point
(lambda (m x y)
(check-instance '(method window<%> popup-menu) popup-menu% 'popup-menu% #f m)
(check-range-integer '(method window<%> popup-menu) x)
(check-range-integer '(method window<%> popup-menu) y)
(check-position '(method window<%> popup-menu) x)
(check-position '(method window<%> popup-menu) y)
(let ([mwx (mred->wx m)])
(and (send mwx popup-grab this)
(as-exit
@ -134,11 +134,11 @@
[on-focus (lambda (x) (void))]
[on-subwindow-focus (lambda (win active?) (void))]
[on-size (lambda (w h)
(check-range-integer '(method window<%> on-size) w)
(check-range-integer '(method window<%> on-size) h))]
(check-dimension '(method window<%> on-size) w)
(check-dimension '(method window<%> on-size) h))]
[on-move (lambda (x y)
(check-slider-integer '(method window<%> on-move) x)
(check-slider-integer '(method window<%> on-move) y))]
(check-position '(method window<%> on-move) x)
(check-position '(method window<%> on-move) y))]
[on-subwindow-char (lambda (w e)
(check-instance '(method window<%> on-subwindow-char) window<%> 'window<%> #f w)
(check-instance '(method window<%> on-subwindow-char) wx:key-event% 'key-event% #f e)
@ -175,15 +175,15 @@
[client->screen (entry-point
(lambda (x y)
(check-slider-integer '(method window<%> client->screen) x)
(check-slider-integer '(method window<%> client->screen) y)
(check-position '(method window<%> client->screen) x)
(check-position '(method window<%> client->screen) y)
(double-boxed
x y
(lambda (x y) (send wx client-to-screen x y)))))]
[screen->client (entry-point
(lambda (x y)
(check-slider-integer '(method window<%> screen->client) x)
(check-slider-integer '(method window<%> screen->client) y)
(check-position '(method window<%> screen->client) x)
(check-position '(method window<%> screen->client) y)
(double-boxed
x y
(lambda (x y) (send wx screen-to-client x y)))))]
@ -230,8 +230,8 @@
[warp-pointer (entry-point (lambda (x y)
(let ([who '(method window<%> warp-pointer)])
(check-init-pos-integer who x)
(check-init-pos-integer who y))
(check-init-position who x)
(check-init-position who y))
(send wx warp-pointer x y)))])
(define wx #f)
(super-make-object (lambda () (set! wx (mk-wx)) wx) get-wx-panel get-outer-wx-panel mismatches parent)

8
pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/frame.rkt
View File

@ -261,7 +261,7 @@
(tellv tb setVisible: #:type _BOOL #f)
(tellv tb release))))
(internal-move -11111 (if (= y -11111) 0 y))
(internal-move #f (or y 0))
(tellv cocoa setAcceptsMouseMovedEvents: #:type _BOOL #t)
@ -515,7 +515,7 @@
(- (super get-y) (get-menu-bar-height)))
(define/override (set-size x y w h)
(unless (and (= x -1) (= y -1))
(unless (and (equal? x -1) (equal? y -1))
(internal-move x y))
(let ([f (tell #:type _NSRect cocoa frame)])
(tellv cocoa setFrame:
@ -538,8 +538,8 @@
(make-NSSize w h))
display: #:type _BOOL #t)))
(define/override (internal-move x y)
(let ([x (if (= x -11111) (get-x) x)]
[y (if (= y -11111) (get-y) y)])
(let ([x (if (not x) (get-x) x)]
[y (if (not y) (get-y) y)])
(tellv cocoa setFrameTopLeftPoint: #:type _NSPoint (make-NSPoint x (- (flip-screen y)
(get-menu-bar-height))))))

8
pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/window.rkt
View File

@ -658,8 +658,8 @@
(set-box! h (->long (NSSize-height s)))))
(define/public (set-size x y w h)
(let ([x (if (= x -11111) (get-x) x)]
[y (if (= y -11111) (get-y) y)])
(let ([x (if (not x) (get-x) x)]
[y (if (not y) (get-y) y)])
;; old location will need refresh:
(tellv cocoa setNeedsDisplay: #:type _BOOL #t)
(tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint x (flip y h))
@ -973,10 +973,10 @@
(tellv cocoa-win enableFlushWindow))))
(define (make-init-point x y)
(make-NSPoint (if (= x -11111)
(make-NSPoint (if (not x)
0
x)
(if (= y -11111)
(if (not y)
0
y)))

4
pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/dc.rkt
View File

@ -47,7 +47,9 @@
(init w h gdk-win)
(super-make-object (make-alternate-bitmap-kind w h))
(define pixmap (gdk_pixmap_new gdk-win (max 1 w) (max 1 h)
(define pixmap (gdk_pixmap_new gdk-win
(min (max 1 w) 32000)
(min (max 1 h) 32000)
(if gdk-win
-1
(GdkVisual-rec-depth

12
pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/frame.rkt
View File

@ -268,7 +268,7 @@
(define/override (get-dialog-level) 0)
(define/public (frame-relative-dialog-status win) #f)
(define/override (get-unset-pos) -11111)
(define/override (get-unset-pos) #f)
(define/override (center dir wrt)
(let ([w-box (box 0)]
@ -292,17 +292,17 @@
(set-top-position (if (or (eq? dir 'both)
(eq? dir 'horizontal))
(+ (unbox sx-box) (quotient (- sw fw) 2))
-11111)
#f)
(if (or (eq? dir 'both)
(eq? dir 'vertical))
(+ (unbox sy-box) (quotient (- sh fh) 2))
-11111)))))
#f)))))
(define/public (set-top-position x y)
(unless (and (= x -11111) (= y -11111))
(unless (and (not x) (not y))
(gtk_widget_set_uposition gtk
(if (= x -11111) -2 x)
(if (= y -11111) -2 y))))
(or x -2)
(or y -2))))
(define/override (really-set-size gtk x y processed-x processed-y w h)
(set-top-position x y)

22
pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/window.rkt
View File

@ -469,17 +469,17 @@
(set-size x y -1 -1))
(define/public (set-size x y w h)
(unless (and (or (= x -11111) (= save-x x))
(or (= y -11111) (= save-y y))
(unless (and (or (not x) (equal? save-x x))
(or (not y) (equal? save-y y))
(or (= w -1) (= save-w (max w client-delta-w)))
(or (= h -1) (= save-h (max h client-delta-h))))
(unless (= x -11111) (set! save-x x))
(unless (= y -11111) (set! save-y y))
(unless (not x) (set! save-x x))
(unless (not y) (set! save-y y))
(unless (= w -1) (set! save-w w))
(unless (= h -1) (set! save-h h))
(set! save-w (max save-w client-delta-w))
(set! save-h (max save-h client-delta-h))
(really-set-size gtk x y save-x save-y save-w save-h)
(really-set-size gtk x y (or save-x 0) (or save-y 0) save-w save-h)
(queue-on-size)))
(define/public (save-size x y w h)
@ -497,8 +497,8 @@
;; called in event-pump thread
(unless (and (= save-w w)
(= save-h h)
(= save-x x)
(= save-y y))
(equal? save-x x)
(equal? save-y y))
(set! save-w w)
(set! save-h h)
(set! save-x x)
@ -533,8 +533,8 @@
(define/public (set-auto-size [dw 0] [dh 0])
(let ([req (make-GtkRequisition 0 0)])
(gtk_widget_size_request gtk req)
(set-size -11111
-11111
(set-size #f
#f
(+ (GtkRequisition-width req) dw)
(+ (GtkRequisition-height req) dh))))
@ -560,8 +560,8 @@
(unless no-show? (show #t))
(define/public (get-x) (if (= save-x -11111) 0 save-x))
(define/public (get-y) (if (= save-y -11111) 0 save-y))
(define/public (get-x) (or save-x 0))
(define/public (get-y) (or save-y 0))
(define/public (get-width) save-w)
(define/public (get-height) save-h)

2
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt
View File

@ -118,7 +118,7 @@
(define/public (auto-size-button
font
label
#:resize [resize (lambda (w h) (set-size -11111 -11111 w h))])
#:resize [resize (lambda (w h) (set-size #f #f w h))])
(cond
[orientation
(let ([h? (memq orientation '(left right))])

2
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt
View File

@ -58,7 +58,7 @@
(if (null? choices) (list "Choice") choices)
0 0 40 0
(lambda (w h)
(set-size -11111 -11111 w (* h 8))))
(set-size #f #f w (* h 8))))
(define choice-dropped? #f)

4
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/dialog.rkt
View File

@ -47,8 +47,8 @@
dialog-proc
0)])
(SetWindowTextW hwnd label)
(let ([x (if (= x -11111) 0 x)]
[y (if (= y -11111) 0 y)])
(let ([x (or x 0)]
[y (or y 0)])
(MoveWindow hwnd x y w h #t))
hwnd))

4
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/frame.rkt
View File

@ -212,8 +212,8 @@
0
(bitwise-ior WS_CAPTION
WS_MINIMIZEBOX)))
(if (= x -11111) CW_USEDEFAULT x)
(if (= y -11111) CW_USEDEFAULT y)
(or x CW_USEDEFAULT)
(or y CW_USEDEFAULT)
w h
#f
#f

4
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt
View File

@ -52,8 +52,8 @@
(set-range rng)
(if (memq 'horizontal style)
(set-size -11111 -11111 100 24)
(set-size -11111 -11111 24 100))
(set-size #f #f 100 24)
(set-size #f #f 24 100))
(define/public (get-value)
(SendMessageW hwnd PBM_GETPOS 0 0))

2
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/group-panel.rkt
View File

@ -61,7 +61,7 @@
(auto-size #f label 0 0 0 0
(lambda (w h)
(set! label-h h)
(set-size -11111 -11111 (+ w 10) (+ h 10))))
(set-size #f #f (+ w 10) (+ h 10))))
(define/public (set-label lbl)
(SetWindowTextW hwnd lbl))

2
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt
View File

@ -266,7 +266,7 @@
[style style])
(set-control-font font)
(set-size -11111 -11111 40 60)
(set-size #f #f 40 60)
(define callback cb)

2
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/message.rkt
View File

@ -87,7 +87,7 @@
(set-control-font font)
(if (symbol? label)
(set-size -11111 -11111 32 32)
(set-size #f #f 32 32)
(auto-size font label 0 0 0 0))
(define/public (set-preferred-size) #f)

8
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt
View File

@ -119,11 +119,11 @@
(set! value-w w)
(set! value-h h)
(if vertical?
(set-size -11111 -11111 (+ THICKNESS w) (max h MIN_LENGTH))
(set-size -11111 -11111 (max w MIN_LENGTH) (+ THICKNESS h)))))
(set-size #f #f (+ THICKNESS w) (max h MIN_LENGTH))
(set-size #f #f (max w MIN_LENGTH) (+ THICKNESS h)))))
(if vertical?
(set-size -11111 -11111 THICKNESS MIN_LENGTH)
(set-size -11111 -11111 MIN_LENGTH THICKNESS)))
(set-size #f #f THICKNESS MIN_LENGTH)
(set-size #f #f MIN_LENGTH THICKNESS)))
(SendMessageW slider-hwnd TBM_SETRANGE 1 (MAKELPARAM lo hi))
(set-value val)

2
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/tab-panel.rkt
View File

@ -104,7 +104,7 @@
0 0 0 0 #:combine-width +
(lambda (w h)
(set! tab-height (+ h 6))
(set-size -11111 -11111
(set-size #f #f
(+ w (* 6 (length choices)))
(+ h 12))))

10
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt
View File

@ -325,13 +325,13 @@
(define/public (set-size x y w h)
(let-values ([(x y w h)
(if (or (= x -11111)
(= y -11111)
(if (or (not x)
(not y)
(= w -1)
(= h -1))
(let ([r (GetWindowRect hwnd)])
(values (if (= x -11111) (RECT-left r) x)
(if (= y -11111) (RECT-top r) y)
(values (or x (RECT-left r))
(or y (RECT-top r))
(if (= w -1) (- (RECT-right r) (RECT-left r)) w)
(if (= h -1) (- (RECT-bottom r) (RECT-top r)) h)))
(values x y w h))])
@ -355,7 +355,7 @@
(define/public (auto-size font label min-w min-h dw dh
[resize
(lambda (w h) (set-size -11111 -11111 w h))]
(lambda (w h) (set-size #f #f w h))]
#:combine-width [combine-w max]
#:combine-height [combine-h max]
#:scale-w [scale-w 1]

12
pkgs/gui-pkgs/gui-lib/mred/private/wxitem.rkt
View File

@ -53,10 +53,10 @@
;; Otherwise, does nothing.
[set-size
(lambda (x y width height)
(set! x (if (= x -11111)
(set! x (if (not x)
(get-x)
(+ x (send (area-parent) dx))))
(set! y (if (= y -11111)
(set! y (if (not y)
(get-y)
(+ y (send (area-parent) dy))))
(unless (and (same-dimension? x (get-x))
@ -95,13 +95,13 @@
(case-lambda
[() (- (min-width) (client-inset #f))]
[(new-width)
(check-range-integer '(method canvas<%> min-client-width) new-width)
(check-dimension '(method canvas<%> min-client-width) new-width)
(min-width (+ new-width (client-inset #f)))])]
[min-client-height
(case-lambda
[() (- (min-height) (client-inset #t))]
[(new-height)
(check-range-integer '(method canvas<%> min-client-height) new-height)
(check-dimension '(method canvas<%> min-client-height) new-height)
(min-height (+ new-height (client-inset #t)))])])
(define -mw 0)
@ -117,13 +117,13 @@
(mk-param
-mw identity
(lambda (v)
(check-range-integer '(method area<%> min-width) v))
(check-dimension '(method area<%> min-width) v))
force-redraw)]
[min-height
(mk-param
-mh identity
(lambda (v)
(check-range-integer '(method area<%> min-height) v))
(check-dimension '(method area<%> min-height) v))
force-redraw)]
[x-margin

6
pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt
View File

@ -98,8 +98,8 @@
;; pointer to panel in the frame for use in on-size
(define panel #f)
(define use-default-position? (and (= -11111 (list-ref args 2))
(= -11111 (list-ref args 1))))
(define use-default-position? (and (not (list-ref args 2))
(not (list-ref args 1))))
(define enabled? #t)
(define focus #f)
@ -349,7 +349,7 @@
(set! last-height correct-h)
(set! already-trying? #t)
(enforce-size -1 -1 -1 -1 1 1)
(set-size -11111 -11111 correct-w correct-h)
(set-size #f #f correct-w correct-h)
(enforce-size min-w min-h
(if sx? -1 min-w) (if sy? -1 min-h)
1 1)

5
pkgs/gui-pkgs/gui-lib/mred/private/wxwindow.rkt
View File

@ -4,6 +4,7 @@
"te.rkt"
"lock.rkt"
"helper.rkt"
"const.rkt"
"wx.rkt")
(provide (protect-out wx-make-window%
@ -204,8 +205,8 @@
(set! old-h h)
(as-exit (lambda () (send mred on-size w h)))))
(let* ([p (area-parent)]
[x (max -10000 (min 10000 (- (get-x) (or (and p (send p dx)) 0))))]
[y (max -10000 (min 10000 (- (get-y) (or (and p (send p dy)) 0))))])
[x (max (- WIN-SIZE-MAX) (min WIN-SIZE-MAX (- (get-x) (or (and p (send p dx)) 0))))]
[y (max (- WIN-SIZE-MAX) (min WIN-SIZE-MAX (- (get-y) (or (and p (send p dy)) 0))))])
(when (not (and (= x old-x) (= y old-y)))
(set! old-x x)
(set! old-y y)