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

fix keyboard navigation (all platforms)

Browse Source 
Also, fix `set-selection' in `list-box%' to not invoke the
tab panel's callback function (cocoa & gtk).

original commit: 4535f5d8cc0fe4d0c3c360d7527980b1c3b7e39a
This commit is contained in:
Matthew Flatt 2011-09-30 12:17:46 -06:00
parent 7fb531ebc6
commit 6c3d889b93
11 changed files with 111 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/mred/private/helper.rkt
View File

@ -286,17 +286,18 @@
append
(map
(lambda (i)
(cond
[(send i has-tabbing-children?)
(if (send i is-shown-to-root?)
(container->children i except must-focus?)
null)]
[(or (eq? i except)
(and must-focus? (not (send i gets-focus?)))
(not (send i is-enabled-to-root?))
(not (send i is-shown-to-root?)))
null]
[else (list i)]))
(append
(if (and (send i has-tabbing-children?)
(send i is-shown-to-root?))
(container->children i except must-focus?)
null)
(cond
[(or (eq? i except)
(and must-focus? (not (send i gets-focus?)))
(not (send i is-enabled-to-root?))
(not (send i is-shown-to-root?)))
null]
[else (list i)])))
(send f get-children))))
(define (filter-overlapping l)

12
collects/mred/private/wx/cocoa/radio-box.rkt
View File

@ -115,8 +115,16 @@
(define/public (button-focus i)
(if (= i -1)
0
(set-focus)))
(if horiz?
(tell #:type _NSInteger (get-cocoa) selectedColumn)
(tell #:type _NSInteger (get-cocoa) selectedRow))
(let ([which (get-selection)])
(set-focus)
(tellv (get-cocoa)
selectCellAtRow: #:type _NSInteger (if horiz? 0 i)
column: #:type _NSInteger (if horiz? i 0))
(unless (equal? which (get-selection))
(queue-window-event this (lambda () (clicked)))))))
(define/private (get-button i)
(tell (get-cocoa)

29
collects/mred/private/wx/cocoa/tab-panel.rkt
View File

@ -11,6 +11,7 @@
"queue.rkt"
"../common/event.rkt"
"../common/procs.rkt"
"../../lock.rkt"
(for-syntax racket/base))
(provide
@ -44,7 +45,9 @@
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb]
(-a _void (tabView: [_id cocoa] didSelectTabViewItem: [_id item-cocoa])
(queue-window*-event wxb (lambda (wx) (send wx do-callback)))))
(let ([wx (->wx wxb)])
(when (and wx (send wx callbacks-enabled?))
(queue-window*-event wxb (lambda (wx) (send wx do-callback)))))))
(define-objc-class MyPSMTabBarControl PSMTabBarControl
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
@ -125,9 +128,17 @@
(define/public (set-label i str)
(tellv (list-ref item-cocoas i) setLabel: #:type _NSString (label->plain-label str)))
(define callbacks-ok? #t)
(define/public (callbacks-enabled?) callbacks-ok?)
(define/public (set-selection i)
(define/private (direct-set-selection i)
(tellv tabv-cocoa selectTabViewItem: (list-ref item-cocoas i)))
(define/public (set-selection i)
(atomically
(set! callbacks-ok? #f)
(direct-set-selection i)
(set! callbacks-ok? #t)))
(define/public (get-selection)
(item->index (tell tabv-cocoa selectedTabViewItem)))
@ -183,6 +194,20 @@
(when control-cocoa
(tellv control-cocoa setEnabled: #:type _BOOL on?))))
(define/override (gets-focus?)
(and (not control-cocoa)
(tell #:type _BOOL tabv-cocoa canBecomeKeyView)))
(define/override (get-cocoa-focus)
(if control-cocoa
content-cocoa
tabv-cocoa))
(define/public (number) (length item-cocoas))
(define/public (button-focus n)
(if (= n -1)
(get-selection)
(direct-set-selection n)))
(define/override (maybe-register-as-child parent on?)
(register-as-child parent on?)))

3
collects/mred/private/wx/cocoa/window.rkt
View File

@ -482,6 +482,7 @@
(define/public (get-cocoa) cocoa)
(define/public (get-cocoa-content) cocoa)
(define/public (get-cocoa-focus) (get-cocoa-content))
(define/public (get-cocoa-cursor-content) (get-cocoa-content))
(define/public (get-cocoa-window) (send parent get-cocoa-window))
(define/public (get-wx-window) (send parent get-wx-window))
@ -674,7 +675,7 @@
(is-enabled-to-root?))
(let ([w (tell cocoa window)])
(when w
(tellv w makeFirstResponder: (get-cocoa-content))))))
(tellv w makeFirstResponder: (get-cocoa-focus))))))
(define/public (on-set-focus) (void))
(define/public (on-kill-focus) (void))

2
collects/mred/private/wx/gtk/message.rkt
View File

@ -77,4 +77,6 @@
(set-auto-size)
#t)
(define/override (gets-focus?) #f)
(def/public-unimplemented get-font))

2
collects/mred/private/wx/gtk/panel.rkt
View File

@ -128,6 +128,8 @@
(define/override (get-client-gtk) client-gtk)
(define/override (gets-focus?) #f)
(super-new [parent parent]
[gtk gtk]
[extra-gtks (list client-gtk)]

2
collects/mred/private/wx/gtk/radio-box.rkt
View File

@ -103,7 +103,7 @@
0)
(gtk_widget_grab_focus (list-ref radio-gtks i))))
(define/override (set-focus)
(button-focus (max 0 (set-selection))))
(button-focus (max 0 (get-selection))))
(define/public (set-selection i)
(atomically
(set! no-clicked? #t)

24
collects/mred/private/wx/gtk/tab-panel.rkt
View File

@ -9,6 +9,7 @@
"types.rkt"
"widget.rkt"
"message.rkt"
"../../lock.rkt"
"../common/event.rkt")
(provide
@ -21,6 +22,7 @@
(define-gtk gtk_notebook_set_scrollable (_fun _GtkWidget _gboolean -> _void))
(define-gtk gtk_notebook_get_current_page (_fun _GtkWidget -> _int))
(define-gtk gtk_notebook_set_current_page (_fun _GtkWidget _int -> _void))
(define-gtk gtk_notebook_get_tab_label (_fun _GtkWidget _GtkWidget -> _GtkWidget))
(define-gtk gtk_container_remove (_fun _GtkWidget _GtkWidget -> _void))
@ -110,11 +112,14 @@
(select-bin bin-gtk)
(gtk_widget_unref client-gtk))
(define callback-ok? #t)
(define/public (page-changed i)
; range check works around spurious callbacks:
(when (< -1 i (length pages))
(swap-in (page-bin-gtk (list-ref pages i)))
(queue-window-event this (lambda () (do-callback)))))
(when callback-ok?
(queue-window-event this (lambda () (do-callback))))))
(connect-changed gtk)
(define/override (get-client-gtk) client-gtk)
@ -159,7 +164,22 @@
(gtk_label_set_text_with_mnemonic (page-label-gtk (list-ref pages i))
(mnemonic-string str)))
(define/public (set-selection i)
(define/public (number) (length pages))
(define/public (button-focus n)
(if (= n -1)
(get-selection)
(direct-set-selection n)))
(define/override (gets-focus?) #t)
(define/override (set-focus)
(gtk_widget_grab_focus gtk))
(define/private (direct-set-selection i)
(gtk_notebook_set_current_page gtk i))
(define/public (set-selection i)
(atomically
(set! callback-ok? #f)
(direct-set-selection i)
(set! callback-ok? #t)))
(define/public (get-selection)
(gtk_notebook_get_current_page gtk))))

9
collects/mred/private/wx/win32/tab-panel.rkt
View File

@ -25,6 +25,8 @@
(define TCM_GETITEMCOUNT (+ TCM_FIRST 4))
(define TCM_DELETEITEM (+ TCM_FIRST 8))
(define TCM_DELETEALLITEMS (+ TCM_FIRST 9))
(define TCM_GETCURFOCUS (+ TCM_FIRST 47))
(define TCM_SETCURFOCUS (+ TCM_FIRST 48))
(define-cstruct _TCITEMW
([mask _UINT]
@ -169,6 +171,13 @@
(let ([sel (max 0 (min (length choices) sel))])
(set-selection sel))))
(define/override (gets-focus?) #t)
(define/public (button-focus i)
(if (= i -1)
(SendMessageW hwnd TCM_GETCURFOCUS 0 0)
(SendMessageW hwnd TCM_SETCURFOCUS i 0)))
(define/public (set-callback cb)
(set! callback cb))))

25
collects/mred/private/wxpanel.rkt
View File

@ -37,6 +37,7 @@
[on-set-focus (lambda () (void))]
[on-kill-focus (lambda () (void))]
[set-focus (lambda () (void))]
[gets-focus? (lambda () #f)]
[enable (lambda () (void))]
[show (lambda (on?) (void))]
[is-shown? (lambda () #f)]
@ -110,9 +111,11 @@
[set-focus ; dispatch focus to a child panel
(lambda ()
(if (null? children)
(super-set-focus)
(send (car children) set-focus)))]
(if (focus-on-self?)
(super-set-focus)
(if (null? children)
(super-set-focus)
(send (car children) set-focus))))]
[ext-dx (lambda () (if hidden-child
tab-h-border
@ -131,6 +134,7 @@
(public
[need-move-children (lambda () (set! move-children? #t))]
[focus-on-self? (lambda () #f)]
[get-children (lambda () children)]
[get-hidden-child (lambda () hidden-child)]
@ -806,19 +810,28 @@
;; "horizontal" and "vertical."
(define (wx-make-vertical-panel% wx-linear-panel%) (wx-make-horizontal/vertical-panel% wx-linear-panel% #f))
(define (wx-make-tab% %)
(class %
(inherit gets-focus?)
(super-new)
(define/override (tabbing-position x y w h)
;; claim that the panel is short:
(list this x y w 16))
(define/override (focus-on-self?) (gets-focus?))))
(define wx-panel% (wx-make-panel% wx:panel%))
(define wx-control-panel% (wx-make-panel% wx:panel% const-default-x-margin const-default-y-margin))
(define wx-canvas-panel% (wx-make-panel% wx:canvas-panel%))
(define wx-tab-panel% (wx-make-panel% wx:tab-panel%))
(define wx-tab-panel% (wx-make-tab% (wx-make-panel% wx:tab-panel%)))
(define wx-group-panel% (wx-make-panel% wx:group-panel%))
(define wx-linear-panel% (wx-make-linear-panel% wx-panel%))
(define wx-linear-canvas-panel% (wx-make-linear-panel% wx-canvas-panel%))
(define wx-control-linear-panel% (wx-make-linear-panel% wx-control-panel%))
(define wx-linear-tab-panel% (wx-make-linear-panel% wx-tab-panel%))
(define wx-linear-tab-panel% (wx-make-tab% (wx-make-linear-panel% wx-tab-panel%)))
(define wx-linear-group-panel% (wx-make-linear-panel% wx-group-panel%))
(define wx-horizontal-panel% (wx-make-horizontal-panel% wx-linear-panel%))
(define wx-vertical-panel% (wx-make-vertical-panel% wx-linear-panel%))
(define wx-vertical-tab-panel% (wx-make-vertical-panel% wx-linear-tab-panel%))
(define wx-vertical-tab-panel% (wx-make-tab% (wx-make-vertical-panel% wx-linear-tab-panel%)))
(define wx-vertical-group-panel% (wx-make-vertical-panel% wx-linear-group-panel%))
(define wx-control-horizontal-panel% (wx-make-horizontal-panel% wx-control-linear-panel%))
(define wx-horizontal-canvas-panel% (wx-make-horizontal-panel% wx-linear-canvas-panel%))

8
collects/mred/private/wxtop.rkt
View File

@ -496,12 +496,14 @@
(memq code '(right down)))]
[normal-move
(lambda ()
(let* ([o (if (or (is-a? o wx:canvas%) (is-a? o wx:item%))
(let* ([o (if (or (is-a? o wx:canvas%)
(is-a? o wx:item%)
(is-a? o wx:tab-panel%))
(if (is-a? o wx-group-box<%>)
#f
o)
#f)]
[candidates
[candidates
(map object->position (container->children panel o #t))]
[dests (filter-overlapping candidates)]
[pos (if o (object->position o) (list 'x 0 0 1 1))]
@ -528,7 +530,7 @@
(as-exit (lambda () (send o on-tab-in))))))))))])
(if (and (not (eqv? code #\tab))
(or (is-a? o wx:radio-box%)
(is-a? o wx-tab-group<%>)))
(is-a? o wx:tab-panel%)))
(let ([n (send o number)]
[s (send o button-focus -1)]
[v-move? (memq code '(up down))]