173 lines
4.3 KiB
Plaintext
173 lines
4.3 KiB
Plaintext
|
|
;;File: mwm-bindings.gwm --
|
|
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
|
|
;;Author: Frederic CHARTON
|
|
;;Revision: 1.0 -- Sep 12 1989
|
|
;;State: Exp
|
|
;;GWM Version: 1.4
|
|
|
|
|
|
|
|
; The standard behaviors & grabs :
|
|
(: root-std-grabs ())
|
|
(: window-std-grabs ())
|
|
(: icon-std-grabs ())
|
|
(: root-std-behavior ())
|
|
(: window-std-behavior ())
|
|
(: icon-std-behavior ())
|
|
|
|
|
|
; KEY-BINDINGS-MAKE :
|
|
; =================
|
|
(df key-bindings-make args
|
|
(with (
|
|
theResult '(root (() ()) window (() ()) icon (() ()))
|
|
; ^ ^
|
|
; state -------------------+ |
|
|
; grabs ----------------------+
|
|
)
|
|
(for key-item args
|
|
(with (
|
|
key (# 0 (# 0 key-item))
|
|
modifier (# 1 (# 0 key-item))
|
|
context (# 1 key-item)
|
|
fctn (# 2 key-item)
|
|
fctn.name (# 0 fctn)
|
|
fctn.name.string (match "[.]\\(.*\\)" fctn.name 1)
|
|
theTransition ()
|
|
theGrab ()
|
|
)
|
|
(: theTransition
|
|
(list 'on (list 'keypress (key-make key) modifier)
|
|
(list 'if (eval (atom (+ "e." fctn.name.string))) fctn)
|
|
)
|
|
)
|
|
(: theGrab (list (eval (list 'keypress (key-make key) modifier))))
|
|
(for ctxt context
|
|
; state :
|
|
(## 0 (# ctxt theResult)
|
|
(state-make (eval theTransition) (# 0 (# ctxt theResult))))
|
|
; grabs :
|
|
(## 1 (# ctxt theResult)
|
|
(+ (# 1 (# ctxt theResult)) theGrab))
|
|
)
|
|
)
|
|
)
|
|
theResult
|
|
))
|
|
|
|
|
|
(de general-ctxt (ctxt)
|
|
(if (= ctxt 'root) "root"
|
|
(= ctxt 'icon) "icon"
|
|
"window"
|
|
)
|
|
)
|
|
|
|
; BUTTON-BINDINGS-MAKE :
|
|
; ====================
|
|
(df button-bindings-make args
|
|
(with (
|
|
theResult '(root (press (()()()()) release (()()()())
|
|
click (()()()()) double-click (()()()())
|
|
)
|
|
window (press (()()()()) release (()()()())
|
|
click (()()()()) double-click (()()()())
|
|
)
|
|
frame (press (()()()()) release (()()()())
|
|
click (()()()()) double-click (()()()())
|
|
)
|
|
icon (press (()()()()) release (()()()())
|
|
click (()()()()) double-click (()()()())
|
|
)
|
|
title (press (()()()()) release (()()()())
|
|
click (()()()()) double-click (()()()())
|
|
)
|
|
border (press (()()()()) release (()()()())
|
|
click (()()()()) double-click (()()()())
|
|
)
|
|
app (press (()()()()) release (()()()())
|
|
click (()()()()) double-click (()()()())
|
|
)
|
|
app-grabs ()
|
|
)
|
|
)
|
|
(for button-item args
|
|
(with (
|
|
button (# 0 button-item)
|
|
trigger (if (= 'buttonpress (# 0 button)) 'press
|
|
(= 'buttonrelease (# 0 button)) 'release
|
|
(= 'button (# 0 button)) 'click 'double-click
|
|
)
|
|
nbutton (# 1 button)
|
|
modifier (# 2 button)
|
|
context (# 1 button-item)
|
|
fctn (# 2 button-item)
|
|
fctn.name (# 0 fctn)
|
|
fctn.name.string (match "[.]\\(.*\\)" fctn.name 1)
|
|
)
|
|
(for ctxt context
|
|
(if (= fctn.name.string "menu")
|
|
(progn
|
|
(set (atom (+ (general-ctxt ctxt) "-std-behavior"))
|
|
(state-make
|
|
(with (wob (menu-wob (eval (# 1 fctn)))) (# 'wfsm wob-property))
|
|
(eval (atom (+ (general-ctxt ctxt) "-std-behavior")))
|
|
))
|
|
(set (atom (+ (general-ctxt ctxt) "-std-grabs"))
|
|
(+ (eval (atom (+ (general-ctxt ctxt) "-std-grabs")))
|
|
(with (wob (menu-wob (eval (# 1 fctn)))) (# 'wgrabs wob-property))))
|
|
)
|
|
)
|
|
(## nbutton (# trigger (# ctxt theResult))
|
|
(+ (list (atom (+ "m" (itoa (eval modifier))))
|
|
(list 'if (eval (atom (+ "e." fctn.name.string))) fctn))
|
|
(# nbutton (# trigger (# ctxt theResult)))))
|
|
(if (= ctxt 'app)
|
|
(## 'app-grabs theResult (+ (# 'app-grabs theResult) (list button))))
|
|
)
|
|
)
|
|
)
|
|
theResult
|
|
)
|
|
)
|
|
|
|
; DO-BINDING-BUTTON :
|
|
; =================
|
|
(de do-binding-button (nbutton modifier trigger context)
|
|
(for ctxt context
|
|
(eval (# (atom (+ "m" (itoa modifier)))
|
|
(# nbutton
|
|
(# trigger (# ctxt buttonBindings)))))
|
|
)
|
|
)
|
|
|
|
|
|
; DO-BINDINGS-STATE :
|
|
; =================
|
|
(de do-bindings-state (context)
|
|
(: context (list quote context))
|
|
(eval
|
|
(list
|
|
'state-make
|
|
(list
|
|
'on '(buttonpress any any)
|
|
(list 'do-binding-button '(current-event-code) '(current-event-modifier)
|
|
''press context))
|
|
(list
|
|
'on '(buttonrelease any any)
|
|
(list 'do-binding-button '(current-event-code) '(current-event-modifier)
|
|
''release context))
|
|
(list
|
|
'on '(button any any)
|
|
(list 'do-binding-button '(current-event-code) '(current-event-modifier)
|
|
''click context))
|
|
(list
|
|
'on '(double-button any any)
|
|
(list 'do-binding-button '(current-event-code) '(current-event-modifier)
|
|
''double-click context))
|
|
)
|
|
))
|
|
|
|
|