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

.

Browse Source 
original commit: ac4104ccb9f7c951df25461a02ea7141a36ff89b
This commit is contained in:
Matthew Flatt 2002-12-05 02:42:32 +00:00
parent 26fa90222f
commit c76ae442e3
4 changed files with 50 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/mred/mred.ss
View File

@ -1152,7 +1152,7 @@
(set-min-width (init-min (get-width)))
(set-min-height (init-min (get-height)))
(unless (memq 'inactive window-style)
(unless (memq 'deleted window-style)
;; For a pane[l], the creator must call the equivalent of the following,
;; delaying to let the panel's wx field get initialized before
;; panel-sizing methods are called
@ -2546,7 +2546,7 @@
removed-children)])
(when non-window
(raise-mismatch-error 'change-children
(format "cannot make non-window area inactive in ~e: "
(format "cannot delete non-window area in ~e: "
(wx->proxy this))
non-window)))
@ -3221,8 +3221,8 @@
(cdr r))
r))))])
(sequence
(super-init #f proxy parent (if (memq 'inactive style) '(inactive) null))
(unless (memq 'inactive style)
(super-init #f proxy parent (if (memq 'deleted style) '(deleted) null))
(unless (memq 'deleted style)
(send (area-parent) add-child this)))
(private-field
[multi? (memq 'multiple style)]
@ -3347,7 +3347,7 @@
(raise-type-error (who->name who) "frame% object or #f" p)))
(define (check-orientation cwho l)
(check-style cwho '(vertical horizontal) '(inactive) l))
(check-style cwho '(vertical horizontal) '(deleted) l))
(define (check-container-ready cwho p)
(when p
@ -4036,7 +4036,7 @@
(let ([cwho '(constructor message)])
(check-label-string/bitmap/iconsym cwho label)
(check-container-parent cwho parent)
(check-style cwho #f '(inactive) style))
(check-style cwho #f '(deleted) style))
(as-entry
(lambda ()
(super-init (lambda () (make-object wx-message% this this
@ -4056,7 +4056,7 @@
(check-label-string-or-bitmap cwho label)
(check-container-parent cwho parent)
(check-callback cwho callback)
(check-style cwho #f '(border inactive) style))
(check-style cwho #f '(border deleted) style))
(as-entry
(lambda ()
(super-init (lambda () (make-object wx-button% this this
@ -4074,7 +4074,7 @@
(check-label-string-or-bitmap cwho label)
(check-container-parent cwho parent)
(check-callback cwho callback)
(check-style cwho #f '(inactive) style)))
(check-style cwho #f '(deleted) style)))
(override
[label-checker (lambda () check-label-string-or-bitmap)]) ; module-local method
(private-field
@ -4179,7 +4179,7 @@
(check-container-parent cwho parent)
(check-callback cwho callback)
(check-slider-integer cwho init-value)
(check-style cwho '(vertical horizontal) '(plain inactive) style)))
(check-style cwho '(vertical horizontal) '(plain deleted) style)))
(private-field
[wx #f])
(public
@ -4315,7 +4315,7 @@
(sequence
(let ([cwho '(constructor choice)])
(check-list-control-args cwho label choices parent callback)
(check-style cwho #f '(inactive) style)
(check-style cwho #f '(deleted) style)
(check-non-negative-integer cwho selection))
(super-init (lambda () (make-object wx-choice% this this
(mred->wx-container parent) (wrap-callback callback)
@ -4335,7 +4335,7 @@
(sequence
(let ([cwho '(constructor list-box)])
(check-list-control-args cwho label choices parent callback)
(check-style cwho '(single multiple extended) '(inactive) style)
(check-style cwho '(single multiple extended) '(deleted) style)
(check-non-negative-integer/false cwho selection)))
(rename [super-append append])
(override
@ -4413,7 +4413,7 @@
(check-container-parent cwho parent)
(check-callback cwho callback)
(check-string cwho init-value)
(check-style cwho '(single multiple) '(hscroll password inactive) style)))
(check-style cwho '(single multiple) '(hscroll password deleted) style)))
(private-field
[wx #f])
(public
@ -4444,7 +4444,7 @@
(sequence
(let ([cwho '(constructor tab-group)])
(check-list-control-args cwho label choices parent callback)
(check-style cwho #f '(inactive) style))
(check-style cwho #f '(deleted) style))
(super-init (lambda () (make-object wx-tab-group% this this
style
(mred->wx-container parent)
@ -4506,7 +4506,7 @@
(sequence
(let ([cwho '(constructor canvas)])
(check-container-parent cwho parent)
(check-style cwho #f '(border hscroll vscroll gl inactive) style)
(check-style cwho #f '(border hscroll vscroll gl deleted) style)
(check-callback cwho paint-callback)
(check-label-string/false cwho label)))
(public
@ -4616,7 +4616,7 @@
(let ([cwho '(constructor editor-canvas)])
(check-container-parent cwho parent)
(check-instance cwho internal-editor<%> "text% or pasteboard%" #t editor)
(check-style cwho #f '(hide-vscroll hide-hscroll no-vscroll no-hscroll inactive) style)
(check-style cwho #f '(hide-vscroll hide-hscroll no-vscroll no-hscroll deleted) style)
(check-gauge-integer cwho scrolls-per-page)
(check-label-string/false cwho label)
(unless (eq? wheel-step no-val)
@ -4774,7 +4774,7 @@
[else 'panel])]
[cwho `(constructor ,who)])
(check-container-parent cwho parent)
(check-style cwho #f '(border inactive) style)
(check-style cwho #f '(border deleted) style)
(as-entry
(lambda ()
(super-init (lambda () (set! wx (make-object (case who
@ -4785,7 +4785,7 @@
(lambda () wx)
(lambda () (check-container-ready cwho parent))
#f parent #f)
(unless (memq 'inactive style)
(unless (memq 'deleted style)
(send (send wx area-parent) add-child wx))))
(send parent after-new-child this)))))
@ -4803,7 +4803,7 @@
(raise-type-error (who->name cwho) "list of strings (up to 200 characters)" choices))
(check-callback cwho callback)
(check-container-parent cwho parent)
(check-style cwho #f '(inactive) style))
(check-style cwho #f '(deleted) style))
(super-init parent style))
(private-field

14
collects/tests/mred/frame-steps.txt
View File

@ -208,17 +208,17 @@ Also, while the busy cursor is on, try creating a new Big/Medium Frame
and make sure that the busy cursor is active in the new frame and over
all controls in the new frame.
Inactive Adds
Deleted Adds
-------------
The "New Inactive" popup creates subwindow<%>s and adds them to the
same panel as the "New Inactive" control, but each subwindow<%> is
created with the 'inactive style, which means that the subwindow<%> is
initially hidden and inactive. The "*Activate Last*" item activates
The "New Deleted" popup creates subwindow<%>s and adds them to the
same panel as the "New Deleted" control, but each subwindow<%> is
created with the 'deleted style, which means that the subwindow<%> is
initially hidden and deleted. The "*Activate Last*" item activates
the last-created subwindow<%>, i.e., it shows the subwindow<%> and
adjusts the panel size to accomodate the activated window<%>. The key
part of this test is that no inactive subwindow<%> is shown, and no
inactive subwindow<%> affects the panel's geometry.
part of this test is that no deleted subwindow<%> is shown, and no
deleted subwindow<%> affects the panel's geometry.
Popup Menus (Big Frame)
-----------

46
collects/tests/mred/item.ss
View File

@ -469,10 +469,10 @@
cp)
items)))
(define (add-inactive-adds panel l)
(define (add-deleted-adds panel l)
(define v #f)
(make-object choice% "New Inactive"
(make-object choice% "New Deleted"
(list*
"..."
"*Activate Last*"
@ -486,28 +486,28 @@
[(1) (send (send v get-parent) add-child v)]
[else (set! v ((cadr (list-ref l (- i 2)))))])))))
(define (add-big-inactive-adds panel)
(add-inactive-adds
(define (add-big-deleted-adds panel)
(add-deleted-adds
panel
(list (list "Message" (lambda () (instantiate message% ("Hello" panel) [style '(inactive)])))
(list "Bitmap Message" (lambda () (instantiate message% (bb-bmp panel) [style '(inactive)])))
(list "Icon Message" (lambda () (instantiate message% ('app panel) [style '(inactive)])))
(list "Button" (lambda () (instantiate button% ("Hello" panel void) [style '(inactive)])))
(list "Bitmap Button" (lambda () (instantiate button% (bb-bmp panel void) [style '(inactive)])))
(list "Checkbox" (lambda () (instantiate check-box% ("Hello" panel void) [style '(inactive)])))
(list "Bitmap Checkbox" (lambda () (instantiate check-box% (bb-bmp panel void) [style '(inactive)])))
(list "Radio Box" (lambda () (instantiate radio-box% ("Hello" (list "A" "B" "C") panel void) [style '(vertical inactive)])))
(list "Bitmap Radio Box" (lambda () (instantiate radio-box% ("Hello" (list bb-bmp bb-bmp) panel void) [style '(vertical inactive)]))))))
(list (list "Message" (lambda () (instantiate message% ("Hello" panel) [style '(deleted)])))
(list "Bitmap Message" (lambda () (instantiate message% (bb-bmp panel) [style '(deleted)])))
(list "Icon Message" (lambda () (instantiate message% ('app panel) [style '(deleted)])))
(list "Button" (lambda () (instantiate button% ("Hello" panel void) [style '(deleted)])))
(list "Bitmap Button" (lambda () (instantiate button% (bb-bmp panel void) [style '(deleted)])))
(list "Checkbox" (lambda () (instantiate check-box% ("Hello" panel void) [style '(deleted)])))
(list "Bitmap Checkbox" (lambda () (instantiate check-box% (bb-bmp panel void) [style '(deleted)])))
(list "Radio Box" (lambda () (instantiate radio-box% ("Hello" (list "A" "B" "C") panel void) [style '(vertical deleted)])))
(list "Bitmap Radio Box" (lambda () (instantiate radio-box% ("Hello" (list bb-bmp bb-bmp) panel void) [style '(vertical deleted)]))))))
(define (add-med-inactive-adds panel)
(add-inactive-adds
(define (add-med-deleted-adds panel)
(add-deleted-adds
panel
(list (list "Canvas" (lambda () (instantiate canvas% (panel) [style '(inactive)])))
(list "Editor Canvas" (lambda () (instantiate editor-canvas% (panel) [style '(inactive)])))
(list "Slider" (lambda () (instantiate slider% ("Hello" 1 3 panel void) [style '(inactive vertical)])))
(list "Gauge" (lambda () (instantiate gauge% ("Hello" 3 panel) [style '(inactive vertical)])))
(list "Tab Panel" (lambda () (instantiate tab-panel% ('("Hello" "Bye") panel void) [style '(inactive)])))
(list "Panel" (lambda () (instantiate panel% (panel) [style '(inactive border)]))))))
(list (list "Canvas" (lambda () (instantiate canvas% (panel) [style '(deleted)])))
(list "Editor Canvas" (lambda () (instantiate editor-canvas% (panel) [style '(deleted)])))
(list "Slider" (lambda () (instantiate slider% ("Hello" 1 3 panel void) [style '(deleted vertical)])))
(list "Gauge" (lambda () (instantiate gauge% ("Hello" 3 panel) [style '(deleted vertical)])))
(list "Tab Panel" (lambda () (instantiate tab-panel% ('("Hello" "Bye") panel void) [style '(deleted)])))
(list "Panel" (lambda () (instantiate panel% (panel) [style '(deleted border)]))))))
(define (big-frame h-radio? v-label? null-label? stretchy? special-label-font? special-button-font?
initially-disabled? alternate-init?)
@ -557,7 +557,7 @@
(add-cursors f lp ctls)
(add-big-inactive-adds lp))
(add-big-deleted-adds lp))
(send f show #t)
(set! prev-frame f)
@ -679,7 +679,7 @@
(add-cursors f2 lp2 (cons canvas items))
(add-med-inactive-adds lp2))
(add-med-deleted-adds lp2))
(send f2 create-status-line)
(send f2 set-status-text "This is the status line")

4
notes/mred/HISTORY
View File

@ -9,8 +9,8 @@ Added value init argument to check%, selection init argument to
radio-box%, choice%, and list-box%; in the argument order, the new
argument follows the style argument
Added checked init argument for checkable-menu-item%
Added and 'inactive style to every subwindow<%> class; a window
created with 'inactive is initially invisible and takes no
Added and 'deleted style to every subwindow<%> class; a window
created with 'deleted is initially invisible and takes no
space in its container
Mac OS X: file dialogs use given starting directory, and dialog%s
with a parent frame are shown as "sheets"