! -*-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