diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index 180447ff4f..2f7bee927b 100644 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -82,7 +82,7 @@ SYMBOLS: C+ A+ M+ S+ ; TUPLE: key-down mods sym ; : ( mods sym action? class -- mods' sym' ) - [ [ S+ rot remove swap ] unless ] dip boa ; inline + [ [ [ S+ swap remove f like ] dip ] unless ] dip boa ; inline : ( mods sym action? -- key-down ) key-down ; diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor index 9faf888559..de57c2dc72 100644 --- a/basis/ui/x11/x11.factor +++ b/basis/ui/x11/x11.factor @@ -7,7 +7,7 @@ x11.events x11.xim x11.glx x11.clipboard x11.constants x11.windows io.encodings.string io.encodings.ascii io.encodings.utf8 combinators debugger command-line qualified math.vectors classes.tuple opengl.gl threads math.geometry.rect -environment ; +environment ascii ; IN: ui.x11 SINGLETON: x11-ui-backend @@ -67,18 +67,26 @@ M: world configure-event : event-modifiers ( event -- seq ) XKeyEvent-state modifiers modifier ; +: valid-input? ( string gesture -- ? ) + over empty? [ 2drop f ] [ + mods>> { f { S+ } } member? [ + [ [ 127 = not ] [ CHAR: \s >= ] bi and ] all? + ] [ + [ [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] tri and and ] all? + ] if + ] if ; + : key-down-event>gesture ( event world -- string gesture ) dupd handle>> xic>> lookup-string >r swap event-modifiers r> key-code ; -: valid-input? ( string -- ? ) - [ f ] [ [ [ 127 = not ] [ CHAR: \s >= ] bi and ] all? ] if-empty ; - M: world key-down-event [ key-down-event>gesture ] keep - world-focus [ propagate-gesture ] keep - over valid-input? [ user-input ] [ 2drop ] if ; + world-focus + [ propagate-gesture drop ] + [ 2over valid-input? [ nip user-input ] [ 3drop ] if ] + 3bi ; : key-up-event>gesture ( event -- gesture ) dup event-modifiers swap 0 XLookupKeysym key-code ;