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

Rackety

Browse Source
This commit is contained in:
Robby Findler 2017-01-15 07:59:09 -06:00
parent 757a3c2463
commit 97b23af4b1
1 changed files with 61 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
gui-lib/framework/private/group.rkt
View File

@ -279,27 +279,28 @@
(exit:exit))))) (exit:exit)))))
(define (choose-a-frame parent) (define (choose-a-frame parent)
(letrec-values ([(sorted-frames) (define sorted-frames
(sort (sort
(send (get-the-frame-group) get-frames) (send (get-the-frame-group) get-frames)
(λ (x y) (string-ci<=? (send x get-label) (send y get-label))))] (λ (x y) (string-ci<=? (send x get-label) (send y get-label)))))
[(d) (make-object dialog% (string-constant bring-frame-to-front) parent 400 600)] (define d
[(lb) (instantiate list-box% () (make-object dialog% (string-constant bring-frame-to-front) parent 400 600))
(define lb
(new list-box%
(label #f) (label #f)
(choices (map (λ (x) (gui-utils:trim-string (send x get-label) 200)) sorted-frames)) (choices (map (λ (x) (gui-utils:trim-string (send x get-label) 200)) sorted-frames))
(callback (λ (x y) (listbox-callback y))) (callback (λ (x y) (listbox-callback y)))
(parent d))] (parent d)))
[(t) (instantiate text:hide-caret/selection% ())] (define t (new text:hide-caret/selection%))
[(ec) (instantiate canvas:basic% () (define ec (new canvas:basic%
(parent d) (parent d)
(stretchable-height #f))] (stretchable-height #f)))
[(bp) (instantiate horizontal-panel% () (define bp (new horizontal-panel%
(parent d) (parent d)
(stretchable-height #f) (stretchable-height #f)
(alignment '(right center)))] (alignment '(right center))))
[(cancelled?) #t] (define cancelled? #t)
[(listbox-callback) (define (listbox-callback evt)
(λ (evt)
(case (send evt get-event-type) (case (send evt get-event-type)
[(list-box) [(list-box)
@ -318,15 +319,15 @@
(send t end-edit-sequence))] (send t end-edit-sequence))]
[(list-box-dclick) [(list-box-dclick)
(set! cancelled? #f) (set! cancelled? #f)
(send d show #f)]))] (send d show #f)]))
[(ok cancel) (define-values (ok cancel)
(gui-utils:ok/cancel-buttons (gui-utils:ok/cancel-buttons
bp bp
(λ (x y) (λ (x y)
(set! cancelled? #f) (set! cancelled? #f)
(send d show #f)) (send d show #f))
(λ (x y) (λ (x y)
(send d show #f)))]) (send d show #f))))
(send ec set-line-count 3) (send ec set-line-count 3)
(send ec set-editor t) (send ec set-editor t)
(send t auto-wrap #t) (send t auto-wrap #t)
@ -339,7 +340,7 @@
(unless cancelled? (unless cancelled?
(let ([sels (send lb get-selections)]) (let ([sels (send lb get-selections)])
(unless (null? sels) (unless (null? sels)
(send (list-ref sorted-frames (car sels)) show #t)))))) (send (list-ref sorted-frames (car sels)) show #t)))))
(define (internal-get-the-frame-group) (define (internal-get-the-frame-group)