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-width (init-min (get-width)))
(set-min-height (init-min (get-height))) (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, ;; For a pane[l], the creator must call the equivalent of the following,
;; delaying to let the panel's wx field get initialized before ;; delaying to let the panel's wx field get initialized before
;; panel-sizing methods are called ;; panel-sizing methods are called
@ -2546,7 +2546,7 @@
removed-children)]) removed-children)])
(when non-window (when non-window
(raise-mismatch-error 'change-children (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)) (wx->proxy this))
non-window))) non-window)))
@ -3221,8 +3221,8 @@
(cdr r)) (cdr r))
r))))]) r))))])
(sequence (sequence
(super-init #f proxy parent (if (memq 'inactive style) '(inactive) null)) (super-init #f proxy parent (if (memq 'deleted style) '(deleted) null))
(unless (memq 'inactive style) (unless (memq 'deleted style)
(send (area-parent) add-child this))) (send (area-parent) add-child this)))
(private-field (private-field
[multi? (memq 'multiple style)] [multi? (memq 'multiple style)]
@ -3347,7 +3347,7 @@
(raise-type-error (who->name who) "frame% object or #f" p))) (raise-type-error (who->name who) "frame% object or #f" p)))
(define (check-orientation cwho l) (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) (define (check-container-ready cwho p)
(when p (when p
@ -4036,7 +4036,7 @@
(let ([cwho '(constructor message)]) (let ([cwho '(constructor message)])
(check-label-string/bitmap/iconsym cwho label) (check-label-string/bitmap/iconsym cwho label)
(check-container-parent cwho parent) (check-container-parent cwho parent)
(check-style cwho #f '(inactive) style)) (check-style cwho #f '(deleted) style))
(as-entry (as-entry
(lambda () (lambda ()
(super-init (lambda () (make-object wx-message% this this (super-init (lambda () (make-object wx-message% this this
@ -4056,7 +4056,7 @@
(check-label-string-or-bitmap cwho label) (check-label-string-or-bitmap cwho label)
(check-container-parent cwho parent) (check-container-parent cwho parent)
(check-callback cwho callback) (check-callback cwho callback)
(check-style cwho #f '(border inactive) style)) (check-style cwho #f '(border deleted) style))
(as-entry (as-entry
(lambda () (lambda ()
(super-init (lambda () (make-object wx-button% this this (super-init (lambda () (make-object wx-button% this this
@ -4074,7 +4074,7 @@
(check-label-string-or-bitmap cwho label) (check-label-string-or-bitmap cwho label)
(check-container-parent cwho parent) (check-container-parent cwho parent)
(check-callback cwho callback) (check-callback cwho callback)
(check-style cwho #f '(inactive) style))) (check-style cwho #f '(deleted) style)))
(override (override
[label-checker (lambda () check-label-string-or-bitmap)]) ; module-local method [label-checker (lambda () check-label-string-or-bitmap)]) ; module-local method
(private-field (private-field
@ -4179,7 +4179,7 @@
(check-container-parent cwho parent) (check-container-parent cwho parent)
(check-callback cwho callback) (check-callback cwho callback)
(check-slider-integer cwho init-value) (check-slider-integer cwho init-value)
(check-style cwho '(vertical horizontal) '(plain inactive) style))) (check-style cwho '(vertical horizontal) '(plain deleted) style)))
(private-field (private-field
[wx #f]) [wx #f])
(public (public
@ -4315,7 +4315,7 @@
(sequence (sequence
(let ([cwho '(constructor choice)]) (let ([cwho '(constructor choice)])
(check-list-control-args cwho label choices parent callback) (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)) (check-non-negative-integer cwho selection))
(super-init (lambda () (make-object wx-choice% this this (super-init (lambda () (make-object wx-choice% this this
(mred->wx-container parent) (wrap-callback callback) (mred->wx-container parent) (wrap-callback callback)
@ -4335,7 +4335,7 @@
(sequence (sequence
(let ([cwho '(constructor list-box)]) (let ([cwho '(constructor list-box)])
(check-list-control-args cwho label choices parent callback) (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))) (check-non-negative-integer/false cwho selection)))
(rename [super-append append]) (rename [super-append append])
(override (override
@ -4413,7 +4413,7 @@
(check-container-parent cwho parent) (check-container-parent cwho parent)
(check-callback cwho callback) (check-callback cwho callback)
(check-string cwho init-value) (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 (private-field
[wx #f]) [wx #f])
(public (public
@ -4444,7 +4444,7 @@
(sequence (sequence
(let ([cwho '(constructor tab-group)]) (let ([cwho '(constructor tab-group)])
(check-list-control-args cwho label choices parent callback) (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 (super-init (lambda () (make-object wx-tab-group% this this
style style
(mred->wx-container parent) (mred->wx-container parent)
@ -4506,7 +4506,7 @@
(sequence (sequence
(let ([cwho '(constructor canvas)]) (let ([cwho '(constructor canvas)])
(check-container-parent cwho parent) (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-callback cwho paint-callback)
(check-label-string/false cwho label))) (check-label-string/false cwho label)))
(public (public
@ -4616,7 +4616,7 @@
(let ([cwho '(constructor editor-canvas)]) (let ([cwho '(constructor editor-canvas)])
(check-container-parent cwho parent) (check-container-parent cwho parent)
(check-instance cwho internal-editor<%> "text% or pasteboard%" #t editor) (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-gauge-integer cwho scrolls-per-page)
(check-label-string/false cwho label) (check-label-string/false cwho label)
(unless (eq? wheel-step no-val) (unless (eq? wheel-step no-val)
@ -4774,7 +4774,7 @@
[else 'panel])] [else 'panel])]
[cwho `(constructor ,who)]) [cwho `(constructor ,who)])
(check-container-parent cwho parent) (check-container-parent cwho parent)
(check-style cwho #f '(border inactive) style) (check-style cwho #f '(border deleted) style)
(as-entry (as-entry
(lambda () (lambda ()
(super-init (lambda () (set! wx (make-object (case who (super-init (lambda () (set! wx (make-object (case who
@ -4785,7 +4785,7 @@
(lambda () wx) (lambda () wx)
(lambda () (check-container-ready cwho parent)) (lambda () (check-container-ready cwho parent))
#f parent #f) #f parent #f)
(unless (memq 'inactive style) (unless (memq 'deleted style)
(send (send wx area-parent) add-child wx)))) (send (send wx area-parent) add-child wx))))
(send parent after-new-child this))))) (send parent after-new-child this)))))
@ -4803,7 +4803,7 @@
(raise-type-error (who->name cwho) "list of strings (up to 200 characters)" choices)) (raise-type-error (who->name cwho) "list of strings (up to 200 characters)" choices))
(check-callback cwho callback) (check-callback cwho callback)
(check-container-parent cwho parent) (check-container-parent cwho parent)
(check-style cwho #f '(inactive) style)) (check-style cwho #f '(deleted) style))
(super-init parent style)) (super-init parent style))
(private-field (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 and make sure that the busy cursor is active in the new frame and over
all controls in the new frame. all controls in the new frame.
Inactive Adds Deleted Adds
------------- -------------
The "New Inactive" popup creates subwindow<%>s and adds them to the The "New Deleted" popup creates subwindow<%>s and adds them to the
same panel as the "New Inactive" control, but each subwindow<%> is same panel as the "New Deleted" control, but each subwindow<%> is
created with the 'inactive style, which means that the subwindow<%> is created with the 'deleted style, which means that the subwindow<%> is
initially hidden and inactive. The "*Activate Last*" item activates initially hidden and deleted. The "*Activate Last*" item activates
the last-created subwindow<%>, i.e., it shows the subwindow<%> and the last-created subwindow<%>, i.e., it shows the subwindow<%> and
adjusts the panel size to accomodate the activated window<%>. The key adjusts the panel size to accomodate the activated window<%>. The key
part of this test is that no inactive subwindow<%> is shown, and no part of this test is that no deleted subwindow<%> is shown, and no
inactive subwindow<%> affects the panel's geometry. deleted subwindow<%> affects the panel's geometry.
Popup Menus (Big Frame) Popup Menus (Big Frame)
----------- -----------

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

@ -469,10 +469,10 @@
cp) cp)
items))) items)))
(define (add-inactive-adds panel l) (define (add-deleted-adds panel l)
(define v #f) (define v #f)
(make-object choice% "New Inactive" (make-object choice% "New Deleted"
(list* (list*
"..." "..."
"*Activate Last*" "*Activate Last*"
@ -486,28 +486,28 @@
[(1) (send (send v get-parent) add-child v)] [(1) (send (send v get-parent) add-child v)]
[else (set! v ((cadr (list-ref l (- i 2)))))]))))) [else (set! v ((cadr (list-ref l (- i 2)))))])))))
(define (add-big-inactive-adds panel) (define (add-big-deleted-adds panel)
(add-inactive-adds (add-deleted-adds
panel panel
(list (list "Message" (lambda () (instantiate message% ("Hello" panel) [style '(inactive)]))) (list (list "Message" (lambda () (instantiate message% ("Hello" panel) [style '(deleted)])))
(list "Bitmap Message" (lambda () (instantiate message% (bb-bmp panel) [style '(inactive)]))) (list "Bitmap Message" (lambda () (instantiate message% (bb-bmp panel) [style '(deleted)])))
(list "Icon Message" (lambda () (instantiate message% ('app panel) [style '(inactive)]))) (list "Icon Message" (lambda () (instantiate message% ('app panel) [style '(deleted)])))
(list "Button" (lambda () (instantiate button% ("Hello" panel void) [style '(inactive)]))) (list "Button" (lambda () (instantiate button% ("Hello" panel void) [style '(deleted)])))
(list "Bitmap Button" (lambda () (instantiate button% (bb-bmp panel void) [style '(inactive)]))) (list "Bitmap Button" (lambda () (instantiate button% (bb-bmp panel void) [style '(deleted)])))
(list "Checkbox" (lambda () (instantiate check-box% ("Hello" panel void) [style '(inactive)]))) (list "Checkbox" (lambda () (instantiate check-box% ("Hello" panel void) [style '(deleted)])))
(list "Bitmap Checkbox" (lambda () (instantiate check-box% (bb-bmp panel void) [style '(inactive)]))) (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 inactive)]))) (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 inactive)])))))) (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) (define (add-med-deleted-adds panel)
(add-inactive-adds (add-deleted-adds
panel panel
(list (list "Canvas" (lambda () (instantiate canvas% (panel) [style '(inactive)]))) (list (list "Canvas" (lambda () (instantiate canvas% (panel) [style '(deleted)])))
(list "Editor Canvas" (lambda () (instantiate editor-canvas% (panel) [style '(inactive)]))) (list "Editor Canvas" (lambda () (instantiate editor-canvas% (panel) [style '(deleted)])))
(list "Slider" (lambda () (instantiate slider% ("Hello" 1 3 panel void) [style '(inactive vertical)]))) (list "Slider" (lambda () (instantiate slider% ("Hello" 1 3 panel void) [style '(deleted vertical)])))
(list "Gauge" (lambda () (instantiate gauge% ("Hello" 3 panel) [style '(inactive vertical)]))) (list "Gauge" (lambda () (instantiate gauge% ("Hello" 3 panel) [style '(deleted vertical)])))
(list "Tab Panel" (lambda () (instantiate tab-panel% ('("Hello" "Bye") panel void) [style '(inactive)]))) (list "Tab Panel" (lambda () (instantiate tab-panel% ('("Hello" "Bye") panel void) [style '(deleted)])))
(list "Panel" (lambda () (instantiate panel% (panel) [style '(inactive border)])))))) (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? (define (big-frame h-radio? v-label? null-label? stretchy? special-label-font? special-button-font?
initially-disabled? alternate-init?) initially-disabled? alternate-init?)
@ -557,7 +557,7 @@
(add-cursors f lp ctls) (add-cursors f lp ctls)
(add-big-inactive-adds lp)) (add-big-deleted-adds lp))
(send f show #t) (send f show #t)
(set! prev-frame f) (set! prev-frame f)
@ -679,7 +679,7 @@
(add-cursors f2 lp2 (cons canvas items)) (add-cursors f2 lp2 (cons canvas items))
(add-med-inactive-adds lp2)) (add-med-deleted-adds lp2))
(send f2 create-status-line) (send f2 create-status-line)
(send f2 set-status-text "This is the 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 radio-box%, choice%, and list-box%; in the argument order, the new
argument follows the style argument argument follows the style argument
Added checked init argument for checkable-menu-item% Added checked init argument for checkable-menu-item%
Added and 'inactive style to every subwindow<%> class; a window Added and 'deleted style to every subwindow<%> class; a window
created with 'inactive is initially invisible and takes no created with 'deleted is initially invisible and takes no
space in its container space in its container
Mac OS X: file dialogs use given starting directory, and dialog%s Mac OS X: file dialogs use given starting directory, and dialog%s
with a parent frame are shown as "sheets" with a parent frame are shown as "sheets"