153 lines
4.1 KiB
Plaintext
153 lines
4.1 KiB
Plaintext
|
! -*-factor-*-
|
||
|
|
|
||
|
|
USING: kernel namespaces sequences hashtables process x11
|
||
|
|
vars x.geometry x x.widgets x.keysym-table wm.root wm.menu
|
||
|
|
wm.unmapped-frames-menu ;
|
||
|
|
|
||
|
|
IN: factory-rc
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
! Menus
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
USE: x.widgets.keymenu
|
||
|
|
|
||
|
|
: new-wm-menu ( -- menu ) { } <wm-menu> 1 over set-border-width ;
|
||
|
|
|
||
|
|
VARS: apps-menu
|
||
|
|
emacs-menu
|
||
|
|
mail-menu
|
||
|
|
factor-menu ;
|
||
|
|
|
||
|
|
{ apps-menu emacs-menu mail-menu factor-menu } [ new-wm-menu swap set ] each
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
USING: io parser tools ;
|
||
|
|
|
||
|
|
: personal-factory-menus ( -- path ) home "/.factory-menus" append ;
|
||
|
|
|
||
|
|
: system-factory-menus ( -- path ) "apps/factory/factory-menus" resource-path ;
|
||
|
|
|
||
|
|
: factory-menus ( -- path )
|
||
|
|
personal-factory-menus dup exists? [ ] [ drop system-factory-menus ] if ;
|
||
|
|
|
||
|
|
: load-factory-menus ( -- ) factory-menus run-file ;
|
||
|
|
|
||
|
|
: edit-factory-menus ( -- ) factory-menus 0 edit-location ;
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
VAR: unmapped-frames-menu
|
||
|
|
|
||
|
|
<unmapped-frames-menu> >unmapped-frames-menu
|
||
|
|
|
||
|
|
1 unmapped-frames-menu> set-border-width
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
VAR: root-menu
|
||
|
|
|
||
|
|
! USE: definitions
|
||
|
|
|
||
|
|
new-wm-menu >root-menu
|
||
|
|
|
||
|
|
load-factory-menus
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
! Setup workspaces
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
USE: wm.workspace
|
||
|
|
|
||
|
|
workspaces> not [
|
||
|
|
init-workspaces
|
||
|
|
|
||
|
|
add-workspace
|
||
|
|
add-workspace
|
||
|
|
add-workspace
|
||
|
|
add-workspace
|
||
|
|
add-workspace
|
||
|
|
add-workspace
|
||
|
|
|
||
|
|
0 >current-workspace
|
||
|
|
] when
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
VAR: wm-root
|
||
|
|
|
||
|
|
window-table> hash-values [ wm-root? ] subset first >wm-root
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
! wm-root-key-action
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
USING: math wm.frame ;
|
||
|
|
|
||
|
|
: find-in-table ( window -- object )
|
||
|
|
dup window-id window-table> hash dup [ nip ] [ drop ] if ;
|
||
|
|
|
||
|
|
: circulate-focus ( -- )
|
||
|
|
root children [ find-in-table ] map [ mapped? ] subset dup length 1 >
|
||
|
|
[ reverse dup first lower
|
||
|
|
second dup raise
|
||
|
|
dup frame? [ frame-child ] [ ] if
|
||
|
|
RevertToPointerRoot CurrentTime rot set-input-focus ]
|
||
|
|
[ drop ]
|
||
|
|
if ;
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
USING: words math ;
|
||
|
|
|
||
|
|
: mask-test ( state mask -- ? ) 0 [ execute bitor ] reduce bit-test ;
|
||
|
|
|
||
|
|
USE: io
|
||
|
|
|
||
|
|
: wm-root-key-action* ( event wm-root -- ) [ >wm-root >event
|
||
|
|
{ { [ event> lookup-keysym keysym>name "F12" = ]
|
||
|
|
[ root-menu> popup ] }
|
||
|
|
{ [ event> lookup-keysym keysym>name "LEFT" =
|
||
|
|
event> XKeyEvent-state { ControlMask Mod1Mask } mask-test
|
||
|
|
and ]
|
||
|
|
[ prev-workspace ] }
|
||
|
|
{ [ event> lookup-keysym keysym>name "RIGHT" =
|
||
|
|
event> XKeyEvent-state { ControlMask Mod1Mask } mask-test
|
||
|
|
and ]
|
||
|
|
[ next-workspace ] }
|
||
|
|
|
||
|
|
{ [ event> lookup-keysym keysym>name "TAB" =
|
||
|
|
event> XKeyEvent-state { Mod1Mask } mask-test
|
||
|
|
and ]
|
||
|
|
[ circulate-focus ] }
|
||
|
|
|
||
|
|
{ [ t ] [ "wm-root-key-action* :: ignoring key" print flush ] }
|
||
|
|
} cond
|
||
|
|
] with-scope ;
|
||
|
|
|
||
|
|
[ wm-root-key-action* ] wm-root> set-wm-root-key-action
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
! Grab keys
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
"F12" name>keysym keysym-to-keycode
|
||
|
|
AnyModifier wm-root> False GrabModeAsync GrabModeAsync grab-key
|
||
|
|
|
||
|
|
"LEFT" name>keysym keysym-to-keycode
|
||
|
|
ControlMask Mod1Mask bitor wm-root> False GrabModeAsync GrabModeAsync grab-key
|
||
|
|
|
||
|
|
"RIGHT" name>keysym keysym-to-keycode
|
||
|
|
ControlMask Mod1Mask bitor wm-root> False GrabModeAsync GrabModeAsync grab-key
|
||
|
|
|
||
|
|
"TAB" name>keysym keysym-to-keycode
|
||
|
|
Mod1Mask wm-root> False GrabModeAsync GrabModeAsync grab-key
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
! Start tty-server
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
! USING: threads tty-server ;
|
||
|
|
|
||
|
|
! [ 9010 tty-server ] in-thread
|