929 lines
30 KiB
Plaintext
929 lines
30 KiB
Plaintext
;;File: mwm-win.gwm -- mwm-like frame
|
|
;;Author: Frederic CHARTON
|
|
;;Revision: 1.1 -- Marc 2 1990
|
|
;;Updated by Anders Holst (aho@nada.kth.se) July 22 1995
|
|
|
|
(: mwm-ed-borderwidth 0)
|
|
|
|
; STANDARD BEHAVIOR OF WINDOWS :
|
|
; ============================
|
|
(: window-std-behavior
|
|
(state-make
|
|
(on focus-out (progn ;(? "focus leaving window " window-name "\n")
|
|
(maintain-focus-out)))
|
|
(on focus-in (progn ;(? "focus entering window " window-name "\n")
|
|
(maintain-focus-in)))
|
|
(on (user-event 'resize-by-menu)
|
|
(progn
|
|
(set-focus)
|
|
(warp-pointer (/ window-width 2) (/ window-height 2) window)
|
|
(with (cursor cross-cursor) (grab-server window 'only))
|
|
(: resize-flag window)))
|
|
(if (= keyboardFocusPolicy 'explicit)
|
|
(on leave-window
|
|
(if (not (current-event-from-grab))
|
|
(progn
|
|
(if (= resize-flag window)
|
|
(progn (: resize-flag ())
|
|
(ungrab-server)
|
|
(with (mwm-resize-style-catch-corners 1
|
|
old mwm-resize-style-corner-size)
|
|
(: mwm-resize-style-corner-size
|
|
(# 'resize-corner-size window))
|
|
(resize-window)
|
|
(: mwm-resize-style-corner-size old)
|
|
)
|
|
)
|
|
(send-user-event 'leave-window))
|
|
)
|
|
)
|
|
)
|
|
(on leave-window
|
|
(if (not (current-event-from-grab))
|
|
(progn
|
|
(if (= resize-flag window)
|
|
(progn (: resize-flag ())
|
|
(ungrab-server)
|
|
(with (mwm-resize-style-catch-corners 1
|
|
old mwm-resize-style-corner-size)
|
|
(: mwm-resize-style-corner-size
|
|
(# 'resize-corner-size window))
|
|
(resize-window)
|
|
(: mwm-resize-style-corner-size old)
|
|
)
|
|
|
|
)
|
|
)
|
|
(set-focus ())
|
|
)
|
|
(with (cmp (current-mouse-position)
|
|
cmpx (- (# 0 cmp) window-x) cmpy (- (# 1 cmp) window-y)
|
|
)
|
|
(if (not (and (> cmpx 0) (> cmpy 0)
|
|
(< cmpx window-width)
|
|
(< cmpy window-height)))
|
|
(set-focus ())
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(if (= keyboardFocusPolicy 'explicit)
|
|
(on enter-window
|
|
(if (not (# 'got-focus window-property))
|
|
(set-grabs (replayable-event (buttonpress 1 alone)))
|
|
)
|
|
)
|
|
(on enter-window (set-focus))
|
|
)
|
|
|
|
(if (= keyboardFocusPolicy 'explicit)
|
|
(on (buttonpress 1 alone)
|
|
(if (not (# 'got-focus window-property))
|
|
(progn
|
|
(set-focus)
|
|
(if (not (= resize-flag window)) (: resize-flag ()))
|
|
(if passSelectButton
|
|
(ungrab-server-and-replay-event ())
|
|
(allow-event-processing))
|
|
(unset-grabs (buttonpress 1 alone) )
|
|
)
|
|
(progn ; has focus already, got this by mistake
|
|
(ungrab-server-and-replay-event ())
|
|
(unset-grabs (buttonpress 1 alone) )))
|
|
)
|
|
)
|
|
(on name-change (send-user-event 'name-change))
|
|
(on (property-change "WM_ICON_NAME")
|
|
(if (window-icon?)
|
|
(send-user-event 'name-change window-icon)))
|
|
(on window-icon-pixmap-change
|
|
(send-user-event 'icon-pixmap-change window-icon))
|
|
)
|
|
)
|
|
|
|
;-------------------------------------------------------------------------
|
|
|
|
|
|
; THE TILES :
|
|
; =========
|
|
|
|
(defun make-vbar-tile (size active spec)
|
|
(with (foreground (if active clientActiveBackground clientBackground)
|
|
theTile (pixmap-make size 1))
|
|
(with (foreground (if active clientActiveTopShadowColor
|
|
clientTopShadowColor))
|
|
(draw-line theTile 0 0 (if (eq spec 'right) 0 1) 0))
|
|
(with (foreground (if active clientActiveBottomShadowColor
|
|
clientBottomShadowColor))
|
|
(draw-line theTile (- size 1) 0 (- size (if (eq spec 'left) 1 2)) 0))
|
|
theTile
|
|
))
|
|
|
|
(defun make-hbar-tile (size active spec)
|
|
(with (foreground (if active clientActiveBackground clientBackground)
|
|
theTile (pixmap-make 1 size))
|
|
(with (foreground (if active clientActiveTopShadowColor
|
|
clientTopShadowColor))
|
|
(draw-line theTile 0 0 0 (if (eq spec 'title) 0 1)))
|
|
(with (foreground (if active clientActiveBottomShadowColor
|
|
clientBottomShadowColor))
|
|
(draw-line theTile 0 (- size 1) 0 (- size (if spec 1 2))))
|
|
theTile
|
|
))
|
|
|
|
(: shadowed-vbar-tile
|
|
(make-vbar-tile resizeBorderWidth () ()))
|
|
|
|
(: active-shadowed-vbar-tile
|
|
(make-vbar-tile resizeBorderWidth t ()))
|
|
|
|
(: shadowed-vbar-tile-l
|
|
(make-vbar-tile (- resizeBorderWidth 1) () 'left))
|
|
|
|
(: active-shadowed-vbar-tile-l
|
|
(make-vbar-tile (- resizeBorderWidth 1) t 'left))
|
|
|
|
(: shadowed-vbar-tile-r
|
|
(make-vbar-tile (- resizeBorderWidth 1) () 'right))
|
|
|
|
(: active-shadowed-vbar-tile-r
|
|
(make-vbar-tile (- resizeBorderWidth 1) t 'right))
|
|
|
|
(: shadowed-hbar-tile
|
|
(make-hbar-tile resizeBorderWidth () ()))
|
|
|
|
(: active-shadowed-hbar-tile
|
|
(make-hbar-tile resizeBorderWidth t ()))
|
|
|
|
(: shadowed-hbar-tile-t
|
|
(make-hbar-tile (- resizeBorderWidth 1) () t))
|
|
|
|
(: active-shadowed-hbar-tile-t
|
|
(make-hbar-tile (- resizeBorderWidth 1) t t))
|
|
|
|
(: border-vbar-tile
|
|
(make-vbar-tile frameBorderwidth () ()))
|
|
|
|
(: active-border-vbar-tile
|
|
(make-vbar-tile frameBorderwidth t ()))
|
|
|
|
(: border-vbar-tile-l
|
|
(make-vbar-tile (- frameBorderwidth 1) () 'left))
|
|
|
|
(: active-border-vbar-tile-l
|
|
(make-vbar-tile (- frameBorderwidth 1) t 'left))
|
|
|
|
(: border-vbar-tile-r
|
|
(make-vbar-tile (- frameBorderwidth 1) () 'right))
|
|
|
|
(: active-border-vbar-tile-r
|
|
(make-vbar-tile (- frameBorderwidth 1) t 'right))
|
|
|
|
(: border-hbar-tile
|
|
(make-hbar-tile frameBorderwidth () ()))
|
|
|
|
(: active-border-hbar-tile
|
|
(make-hbar-tile frameBorderwidth t ()))
|
|
|
|
(: border-hbar-tile-t
|
|
(make-hbar-tile (- frameBorderwidth 1) () t))
|
|
|
|
(: active-border-hbar-tile-t
|
|
(make-hbar-tile (- frameBorderwidth 1) t t))
|
|
|
|
|
|
(defun make-tl-pixmap (w h active seam spec)
|
|
(with (foreground (if active clientActiveBackground clientBackground)
|
|
tSC (if active clientActiveTopShadowColor clientTopShadowColor)
|
|
bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
|
|
theTile (pixmap-make w h))
|
|
(with (foreground tSC)
|
|
(draw-line theTile 0 0 (- w 1) 0)
|
|
(draw-line theTile 0 1 (- w 1) 1)
|
|
(draw-line theTile 0 0 0 (- h 1))
|
|
(draw-line theTile 1 0 1 (- h 1))
|
|
(if seam (draw-line theTile (- w 1) 0 (- w 1) (- h 2)))
|
|
)
|
|
(with (foreground bSC)
|
|
(if spec
|
|
(draw-line theTile (- h 1) (- h 1) (- w 1) (- h 1))
|
|
(progn
|
|
(draw-line theTile (- h 2) (- h 2) (- w 2) (- h 2))
|
|
(draw-line theTile (- h 2) (- h 1) (- w 1) (- h 1))))
|
|
(if seam (draw-line theTile (- w 2) 1 (- w 2) (- h 1)))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
(defun make-tr-pixmap (w h active seam spec)
|
|
(with (foreground (if active clientActiveBackground clientBackground)
|
|
tSC (if active clientActiveTopShadowColor clientTopShadowColor)
|
|
bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
|
|
theTile (pixmap-make w h))
|
|
(with (foreground tSC)
|
|
(draw-line theTile 0 0 (- w 1) 0)
|
|
(draw-line theTile 0 1 (- w 2) 1)
|
|
(if seam (draw-line theTile 1 0 1 (- h 2)))
|
|
(if (not spec) (draw-line theTile (+ (- w h) 1) (- h 1)
|
|
(+ (- w h) 1) (- h 1)))
|
|
)
|
|
(with (foreground bSC)
|
|
(if seam (draw-line theTile 0 1 0 (- h 1)))
|
|
(draw-line theTile (- w 1) 1 (- w 1) (- h 1))
|
|
(draw-line theTile (- w 2) 2 (- w 2) (- h 1))
|
|
(draw-line theTile 0 (- h 1) (- w h) (- h 1))
|
|
(if (not spec)
|
|
(if seam (draw-line theTile 2 (- h 2) (+ (- w h) 1) (- h 2))
|
|
(draw-line theTile 0 (- h 2) (+ (- w h) 1) (- h 2))))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
(defun make-bl-pixmap (w h active seam)
|
|
(with (foreground (if active clientActiveBackground clientBackground)
|
|
tSC (if active clientActiveTopShadowColor clientTopShadowColor)
|
|
bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
|
|
theTile (pixmap-make w h))
|
|
(with (foreground tSC)
|
|
(draw-line theTile 0 0 0 (- h 1))
|
|
(draw-line theTile 1 0 1 (- h 2))
|
|
(draw-line theTile h 0 (- w 1) 0)
|
|
(draw-line theTile (- h 1) 1 (- w 1) 1)
|
|
(if seam (draw-line theTile (- w 1) 0 (- w 1) (- h 2)))
|
|
)
|
|
(with (foreground bSC)
|
|
(draw-line theTile 1 (- h 1) (- w 1) (- h 1))
|
|
(draw-line theTile 2 (- h 2) (- w (if seam 2 1)) (- h 2))
|
|
(draw-line theTile (- h 2) 0 (- h 1) 0)
|
|
(draw-line theTile (- h 2) 1 (- h 2) 1)
|
|
(if seam (draw-line theTile (- w 2) 1 (- w 2) (- h 1)))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
(defun make-br-pixmap (w h active seam)
|
|
(with (foreground (if active clientActiveBackground clientBackground)
|
|
tSC (if active clientActiveTopShadowColor clientTopShadowColor)
|
|
bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
|
|
theTile (pixmap-make w h))
|
|
(with (foreground tSC)
|
|
(draw-line theTile 0 0 (+ (- w h) 1) 0)
|
|
(draw-line theTile 0 1 (+ (- w h) 1) 1)
|
|
(if seam (draw-line theTile 1 0 1 (- h 2)))
|
|
)
|
|
(with (foreground bSC)
|
|
(draw-line theTile 0 (- h 1) (- w 1) (- h 1))
|
|
(draw-line theTile (if seam 2 0) (- h 2) (- w 1) (- h 2))
|
|
(draw-line theTile (- w 1) 0 (- w 1) (- h 1))
|
|
(draw-line theTile (- w 2) 0 (- w 2) (- h 2))
|
|
(if seam (draw-line theTile 0 2 0 (- h 1)))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
(defun make-bv-pixmap (w h active)
|
|
(with (foreground (if active clientActiveBackground clientBackground)
|
|
tSC (if active clientActiveTopShadowColor clientTopShadowColor)
|
|
bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
|
|
theTile (pixmap-make w h))
|
|
(with (foreground tSC)
|
|
(draw-line theTile 0 1 (- w 1) 1)
|
|
(draw-line theTile 0 0 0 (- h 1))
|
|
(draw-line theTile 1 1 1 (- h 1))
|
|
)
|
|
(with (foreground bSC)
|
|
(draw-line theTile 1 0 (- w 1) 0)
|
|
(draw-line theTile (- w 1) 0 (- w 1) (- h 1))
|
|
(draw-line theTile (- w 2) 2 (- w 2) (- h 1))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
(defun make-tv-pixmap (w h active spec)
|
|
(with (foreground (if active clientActiveBackground clientBackground)
|
|
tSC (if active clientActiveTopShadowColor clientTopShadowColor)
|
|
bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
|
|
theTile (pixmap-make w h))
|
|
(with (foreground tSC)
|
|
(draw-line theTile 0 0 0 (- h 1))
|
|
(if (not (eq spec 'right))
|
|
(draw-line theTile 1 0 1 (- h 1)))
|
|
(draw-line theTile 0 (- h 1) (- w 2) (- h 1))
|
|
)
|
|
(with (foreground bSC)
|
|
(if (not (eq spec 'left))
|
|
(draw-line theTile (- w 2) 0 (- w 2) (- h 2)))
|
|
(draw-line theTile (- w 1) 0 (- w 1) (- h 1))
|
|
(draw-line theTile 1 (- h 2) (- w 1) (- h 2))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
|
|
; RESIZE HANDLE'S FSM :
|
|
; ===================
|
|
|
|
(: resize-plug.fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on (user-event 'focus-in)
|
|
(: wob-tile (# 'activepixmap wob-property)) )
|
|
(on (user-event 'focus-out)
|
|
(: wob-tile (# 'pixmap wob-property)) )
|
|
(on (buttonpress 1 any)
|
|
(progn
|
|
(do-binding-button 1 (current-event-modifier)
|
|
'press '(frame border))
|
|
(resize-window)) )
|
|
(do-bindings-state '(frame border))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
; BORDER'S FSM :
|
|
; ============
|
|
|
|
(: border.fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on (user-event 'focus-in)
|
|
(: wob-tile (# 'activepixmap wob-property)) )
|
|
(on (user-event 'focus-out)
|
|
(: wob-tile (# 'pixmap wob-property)) )
|
|
(do-bindings-state '(frame border))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
|
|
|
|
; THE PLUGS :
|
|
; =========
|
|
|
|
(defunq make-border-plug (pix-expr)
|
|
(with (borderwidth 0
|
|
fsm border.fsm
|
|
pixmap (with (active ()) (eval pix-expr))
|
|
activepixmap (with (active t) (eval pix-expr))
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap))
|
|
(plug-make pixmap)))
|
|
|
|
(defunq make-resize-plug (cur pix-expr)
|
|
(with (borderwidth 0
|
|
cursor (if resizeCursors (eval cur) frame-cursor)
|
|
fsm resize-plug.fsm
|
|
tile ()
|
|
pixmap (with (active ()) (eval pix-expr))
|
|
activepixmap (with (active t) (eval pix-expr))
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap))
|
|
(plug-make pixmap)))
|
|
|
|
|
|
(: border-plug-tl
|
|
(make-border-plug (make-tl-pixmap frameBorderwidth frameBorderwidth
|
|
active () ())))
|
|
|
|
(: border-plug-tr
|
|
(make-border-plug (make-tr-pixmap frameBorderwidth frameBorderwidth
|
|
active () ())))
|
|
|
|
(: border-plug-tl2
|
|
(make-border-plug (make-tl-pixmap frameBorderwidth (- frameBorderwidth 1)
|
|
active () t)))
|
|
|
|
(: border-plug-tr2
|
|
(make-border-plug (make-tr-pixmap frameBorderwidth (- frameBorderwidth 1)
|
|
active () t)))
|
|
|
|
(: border-plug-bl
|
|
(make-border-plug (make-bl-pixmap frameBorderwidth frameBorderwidth
|
|
active ())))
|
|
|
|
(: border-plug-br
|
|
(make-border-plug (make-br-pixmap frameBorderwidth frameBorderwidth
|
|
active ())))
|
|
|
|
(: top-resize-vplug-left
|
|
(make-resize-plug cursor-NW
|
|
(make-tv-pixmap resizeBorderWidth
|
|
(- mwm-resize-style-corner-size
|
|
resizeBorderWidth)
|
|
active ())))
|
|
|
|
(: top-resize-vplug-right
|
|
(make-resize-plug cursor-NE
|
|
(make-tv-pixmap resizeBorderWidth
|
|
(- mwm-resize-style-corner-size
|
|
resizeBorderWidth)
|
|
active ())))
|
|
|
|
(: top-resize-vplug-left2
|
|
(with (fsm resize-plug.fsm
|
|
borderwidth 0
|
|
cursor (if resizeCursors cursor-W frame-cursor)
|
|
tile shadowed-vbar-tile-l
|
|
property (list 'pixmap shadowed-vbar-tile-l
|
|
'activepixmap active-shadowed-vbar-tile-l))
|
|
(bar-make
|
|
(make-resize-plug cursor-NW
|
|
(make-tv-pixmap (- resizeBorderWidth 1)
|
|
(- mwm-resize-style-corner-size
|
|
resizeBorderWidth -1)
|
|
active 'left)))))
|
|
|
|
(: top-resize-vplug-right2
|
|
(with (fsm resize-plug.fsm
|
|
borderwidth 0
|
|
cursor (if resizeCursors cursor-E frame-cursor)
|
|
tile shadowed-vbar-tile-r
|
|
property (list 'pixmap shadowed-vbar-tile-r
|
|
'activepixmap active-shadowed-vbar-tile-r))
|
|
(bar-make
|
|
(make-resize-plug cursor-NE
|
|
(make-tv-pixmap (- resizeBorderWidth 1)
|
|
(- mwm-resize-style-corner-size
|
|
resizeBorderWidth -1)
|
|
active 'right)))))
|
|
|
|
(: top-resize-vplug-left-small
|
|
(if (> mwm-resize-style-corner-size
|
|
(+ 4 clientFontHeight resizeBorderWidth))
|
|
(make-resize-plug cursor-NW
|
|
(make-tv-pixmap resizeBorderWidth
|
|
(- mwm-resize-style-corner-size
|
|
resizeBorderWidth
|
|
clientFontHeight 4)
|
|
active ()))))
|
|
|
|
(: top-resize-vplug-right-small
|
|
(if (> mwm-resize-style-corner-size
|
|
(+ 4 clientFontHeight resizeBorderWidth))
|
|
(make-resize-plug cursor-NE
|
|
(make-tv-pixmap resizeBorderWidth
|
|
(- mwm-resize-style-corner-size
|
|
resizeBorderWidth
|
|
clientFontHeight 4)
|
|
active ()))))
|
|
|
|
(: bottom-resize-vplug-left
|
|
(make-resize-plug cursor-SW
|
|
(make-bv-pixmap resizeBorderWidth
|
|
(- mwm-resize-style-corner-size
|
|
resizeBorderWidth)
|
|
active)))
|
|
|
|
(: bottom-resize-vplug-right
|
|
(make-resize-plug cursor-SE
|
|
(make-bv-pixmap resizeBorderWidth
|
|
(- mwm-resize-style-corner-size
|
|
resizeBorderWidth)
|
|
active)))
|
|
|
|
(: bottom-resize-hplug-left
|
|
(make-resize-plug cursor-SW
|
|
(make-bl-pixmap mwm-resize-style-corner-size
|
|
resizeBorderWidth
|
|
active t)))
|
|
|
|
(: bottom-resize-hplug-right
|
|
(make-resize-plug cursor-SE
|
|
(make-br-pixmap mwm-resize-style-corner-size
|
|
resizeBorderWidth
|
|
active t)))
|
|
|
|
(: top-resize-hplug-left
|
|
(make-resize-plug cursor-NW
|
|
(make-tl-pixmap mwm-resize-style-corner-size
|
|
resizeBorderWidth
|
|
active t ())))
|
|
|
|
(: top-resize-hplug-right
|
|
(make-resize-plug cursor-NE
|
|
(make-tr-pixmap mwm-resize-style-corner-size
|
|
resizeBorderWidth
|
|
active t ())))
|
|
|
|
(: top-resize-hplug-left2
|
|
(make-resize-plug cursor-NW
|
|
(make-tl-pixmap mwm-resize-style-corner-size
|
|
(- resizeBorderWidth 1)
|
|
active t t)))
|
|
|
|
(: top-resize-hplug-right2
|
|
(make-resize-plug cursor-NE
|
|
(make-tr-pixmap mwm-resize-style-corner-size
|
|
(- resizeBorderWidth 1)
|
|
active t t)))
|
|
|
|
; THE BARS :
|
|
; ========
|
|
|
|
(: border-v-bar
|
|
(with (
|
|
fsm border.fsm
|
|
borderwidth 0
|
|
cursor frame-cursor
|
|
tile border-vbar-tile
|
|
property (list 'pixmap border-vbar-tile
|
|
'activepixmap active-border-vbar-tile)
|
|
)
|
|
(bar-make)
|
|
)
|
|
)
|
|
|
|
(: border-v-bar-l
|
|
(with (
|
|
fsm border.fsm
|
|
borderwidth 0
|
|
cursor frame-cursor
|
|
tile border-vbar-tile-l
|
|
property (list 'pixmap border-vbar-tile-l
|
|
'activepixmap active-border-vbar-tile-l)
|
|
)
|
|
(bar-make)
|
|
)
|
|
)
|
|
|
|
(: border-v-bar-r
|
|
(with (
|
|
fsm border.fsm
|
|
borderwidth 0
|
|
cursor frame-cursor
|
|
tile border-vbar-tile-r
|
|
property (list 'pixmap border-vbar-tile-r
|
|
'activepixmap active-border-vbar-tile-r)
|
|
)
|
|
(bar-make)
|
|
)
|
|
)
|
|
|
|
(: border-top-bar
|
|
(with (
|
|
fsm border.fsm
|
|
borderwidth 0
|
|
cursor frame-cursor
|
|
tile border-hbar-tile
|
|
property (list 'pixmap border-hbar-tile
|
|
'activepixmap active-border-hbar-tile)
|
|
)
|
|
(bar-make border-plug-tl () border-plug-tr)
|
|
)
|
|
|
|
)
|
|
|
|
(: border-top-bar2
|
|
(with (
|
|
fsm border.fsm
|
|
borderwidth 0
|
|
cursor frame-cursor
|
|
tile border-hbar-tile-t
|
|
property (list 'pixmap border-hbar-tile-t
|
|
'activepixmap active-border-hbar-tile-t)
|
|
)
|
|
(bar-make border-plug-tl2 () border-plug-tr2)
|
|
)
|
|
|
|
)
|
|
|
|
(: border-bottom-bar
|
|
(with (
|
|
fsm border.fsm
|
|
borderwidth 0
|
|
cursor frame-cursor
|
|
tile border-hbar-tile
|
|
property (list 'pixmap border-hbar-tile
|
|
'activepixmap active-border-hbar-tile)
|
|
)
|
|
(bar-make border-plug-bl () border-plug-br)
|
|
)
|
|
|
|
)
|
|
|
|
(defun left-bar ()
|
|
(if deco.border
|
|
(if deco.resizeh
|
|
(with (
|
|
fsm resize-plug.fsm
|
|
borderwidth 0
|
|
cursor (if resizeCursors cursor-W frame-cursor)
|
|
tile shadowed-vbar-tile
|
|
property (list 'pixmap shadowed-vbar-tile
|
|
'activepixmap active-shadowed-vbar-tile)
|
|
)
|
|
(bar-make (if (not deco.title)
|
|
top-resize-vplug-left
|
|
top-resize-vplug-left-small)
|
|
()
|
|
bottom-resize-vplug-left ))
|
|
border-v-bar)))
|
|
|
|
(defun right-bar ()
|
|
(if deco.border
|
|
(if deco.resizeh
|
|
(with (
|
|
fsm resize-plug.fsm
|
|
borderwidth 0
|
|
cursor (if resizeCursors cursor-E frame-cursor)
|
|
tile shadowed-vbar-tile
|
|
property (list 'pixmap shadowed-vbar-tile
|
|
'activepixmap active-shadowed-vbar-tile)
|
|
)
|
|
(bar-make (if (not deco.title)
|
|
top-resize-vplug-right
|
|
top-resize-vplug-right-small)
|
|
()
|
|
bottom-resize-vplug-right))
|
|
border-v-bar)))
|
|
|
|
(defun bottom-bar ()
|
|
(if deco.border
|
|
(if deco.resizeh
|
|
(with (
|
|
fsm resize-plug.fsm
|
|
borderwidth 0
|
|
cursor (if resizeCursors cursor-S frame-cursor)
|
|
tile shadowed-hbar-tile
|
|
plug-separator 0
|
|
property (list 'pixmap shadowed-hbar-tile
|
|
'activepixmap active-shadowed-hbar-tile)
|
|
)
|
|
(bar-make bottom-resize-hplug-left
|
|
()
|
|
bottom-resize-hplug-right))
|
|
border-bottom-bar)))
|
|
|
|
(defun top-bar ()
|
|
(if deco.border
|
|
(if deco.resizeh
|
|
(if deco.title
|
|
(with (
|
|
fsm resize-plug.fsm
|
|
borderwidth 0
|
|
cursor (if resizeCursors cursor-N frame-cursor)
|
|
tile shadowed-hbar-tile-t
|
|
plug-separator 0
|
|
property (list 'pixmap shadowed-hbar-tile-t
|
|
'activepixmap active-shadowed-hbar-tile-t)
|
|
)
|
|
(bar-make top-resize-hplug-left2
|
|
()
|
|
top-resize-hplug-right2))
|
|
(with (
|
|
fsm resize-plug.fsm
|
|
borderwidth 0
|
|
cursor (if resizeCursors cursor-N frame-cursor)
|
|
tile shadowed-hbar-tile
|
|
plug-separator 0
|
|
property (list 'pixmap shadowed-hbar-tile
|
|
'activepixmap active-shadowed-hbar-tile)
|
|
)
|
|
(bar-make top-resize-hplug-left
|
|
()
|
|
top-resize-hplug-right)))
|
|
(if deco.title
|
|
border-top-bar2
|
|
border-top-bar))))
|
|
|
|
|
|
;============================================================================
|
|
|
|
|
|
; FSM of the text field :
|
|
; =====================
|
|
(: edit-fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on (user-event 'focus-in)
|
|
(progn
|
|
(: wob-background clientActiveBackground)
|
|
(wob-tile (with (foreground clientActiveForeground)
|
|
(active-label-make window-name clientFontList)))
|
|
) )
|
|
(on (user-event 'focus-out)
|
|
(progn
|
|
(: wob-background clientBackground)
|
|
(wob-tile (with (foreground clientForeground)
|
|
(active-label-make window-name clientFontList)))
|
|
) )
|
|
(on (user-event 'name-change)
|
|
(progn
|
|
(wob-tile
|
|
(with (foreground ;(if (# 'got-focus (property-of-wob window))
|
|
(if (= wob-background clientActiveBackground)
|
|
clientActiveForeground clientForeground))
|
|
(active-label-make window-name clientFontList)))
|
|
))
|
|
(on (buttonpress 1 alone)
|
|
(progn (send-user-event 'press wob-parent)
|
|
(do-binding-button 1 alone 'press '(title frame))
|
|
(with (cursor cross-cursor) (move-window))
|
|
(send-user-event 'release wob-parent)))
|
|
(do-bindings-state '(title frame))
|
|
)
|
|
))
|
|
|
|
|
|
; THE TITLE-BAR :
|
|
; =============
|
|
|
|
(: title-bar.width (+ 6 clientFontHeight))
|
|
|
|
(: shadowed-title-bar-tile
|
|
(make-hbar-tile title-bar.width () ()))
|
|
|
|
(: active-shadowed-title-bar-tile
|
|
(make-hbar-tile title-bar.width t ()))
|
|
|
|
(: shadowed-title-bar-tile2
|
|
(make-hbar-tile (- title-bar.width 2) () 'title))
|
|
|
|
(: active-shadowed-title-bar-tile2
|
|
(make-hbar-tile (- title-bar.width 2) t 'title))
|
|
|
|
(with (tmp clientActiveTopShadowColor
|
|
clientActiveTopShadowColor clientActiveBottomShadowColor
|
|
clientActiveBottomShadowColor tmp)
|
|
(: pressed-title-bar-tile2 (make-hbar-tile (- title-bar.width 2) t 'title))
|
|
)
|
|
|
|
(: titlebar-fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on (user-event 'focus-in)
|
|
(: wob-tile (# 'activepixmap wob-property)) )
|
|
(on (user-event 'focus-out)
|
|
(: wob-tile (# 'pixmap wob-property)) )
|
|
(on (user-event 'press)
|
|
(: wob-tile (# 'pressedpixmap wob-property)) )
|
|
(on (user-event 'release)
|
|
(: wob-tile (# 'activepixmap wob-property)) )
|
|
(on (buttonpress 1 alone)
|
|
(progn (send-user-event 'press wob)
|
|
(do-binding-button 1 alone 'press '(title frame))
|
|
(with (cursor cross-cursor) (move-window))
|
|
(send-user-event 'release wob)))
|
|
(do-bindings-state '(title frame))
|
|
)))
|
|
|
|
|
|
(: editable-plug '(with (borderwidth 0
|
|
background clientBackground
|
|
foreground clientForeground
|
|
font clientFontList
|
|
menu ()
|
|
property (list 'name window-name)
|
|
fsm edit-fsm)
|
|
(plug-make (label-make window-name))))
|
|
|
|
(defun title-seam-pixmap (col)
|
|
(with (tile ()
|
|
foreground col)
|
|
(pixmap-make 1 (- title-bar.width 2))))
|
|
|
|
(defun inner-titlebar ()
|
|
(with (
|
|
fsm titlebar-fsm
|
|
property (list 'pixmap shadowed-title-bar-tile2
|
|
'activepixmap active-shadowed-title-bar-tile2
|
|
'pressedpixmap pressed-title-bar-tile2)
|
|
lseam (title-seam-pixmap clientTopShadowColor)
|
|
rseam (title-seam-pixmap clientBottomShadowColor)
|
|
alseam (title-seam-pixmap clientActiveTopShadowColor)
|
|
arseam (title-seam-pixmap clientActiveBottomShadowColor)
|
|
tile shadowed-title-bar-tile2
|
|
bar-min-width (- title-bar.width 2)
|
|
bar-max-width bar-min-width
|
|
)
|
|
(bar-make
|
|
(with (property (list 'pixmap lseam 'activepixmap alseam
|
|
'pressedpixmap arseam))
|
|
(plug-make lseam))
|
|
()
|
|
editable-plug
|
|
()
|
|
(with (property (list 'pixmap rseam 'activepixmap arseam
|
|
'pressedpixmap alseam))
|
|
(plug-make rseam))
|
|
)))
|
|
|
|
(defun make-title-row ()
|
|
(with (bar-min-width (if deco.border
|
|
(- title-bar.width 1)
|
|
title-bar.width)
|
|
bar-max-width bar-min-width
|
|
params1 (+
|
|
(if deco.menu (list button-of-menu))
|
|
(list (bar-make () (inner-titlebar) ()))
|
|
(if deco.minimize (list button-iconify))
|
|
(if deco.maximize (list button-zoom)))
|
|
params2 (+
|
|
(if deco.border
|
|
(if deco.resizeh
|
|
(list top-resize-vplug-left2)
|
|
(list border-v-bar-l)))
|
|
(list (bar-make (eval (+ '(bar-make) params1))))
|
|
(if deco.border
|
|
(if deco.resizeh
|
|
(list top-resize-vplug-right2)
|
|
(list border-v-bar-r)))
|
|
))
|
|
(eval (+ '(bar-make) params2))))
|
|
|
|
(defun titlebar ()
|
|
(if deco.title
|
|
(with (menu ()
|
|
cursor frame-cursor
|
|
borderwidth 0
|
|
background clientBackground
|
|
fsm ()
|
|
plug-separator 0
|
|
pixmap shadowed-title-bar-tile
|
|
activepixmap active-shadowed-title-bar-tile
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap)
|
|
tile pixmap)
|
|
(if deco.border
|
|
(bar-make (bar-make (top-bar)
|
|
(make-title-row)))
|
|
(make-title-row))
|
|
)
|
|
(if deco.border (top-bar))
|
|
)
|
|
)
|
|
|
|
(df mwm-window-fsm ()
|
|
(fsm-make
|
|
(state-make
|
|
(# 0 (# 'window keyBindings))
|
|
(# 'wfsm (menu-wob menu))
|
|
window-std-behavior
|
|
(do-bindings-state '(window))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
; THE MWM-LIKE WINDOW :
|
|
; ===================
|
|
|
|
|
|
(df mwm-win-deco-make ()
|
|
(with (inner-borderwidth 1
|
|
menu (eval (atom (get-res-value 'windowMenu)))
|
|
fsm (mwm-window-fsm)
|
|
cursor frame-cursor
|
|
borderwidth mwm-ed-borderwidth
|
|
borderpixel white
|
|
property (list 'resize-corner-size
|
|
(if deco.resizeh
|
|
mwm-resize-style-corner-size 1) )
|
|
grabs
|
|
(+ (# 1 (# 'window keyBindings))
|
|
(# 'app-grabs buttonBindings)
|
|
(# 'wgrabs (menu-wob menu))
|
|
window-std-grabs
|
|
)
|
|
)
|
|
(window-make (titlebar) (left-bar)
|
|
(right-bar) (bottom-bar) ())
|
|
)
|
|
)
|
|
|
|
(defname 'mwm-win.data screen. ())
|
|
|
|
(: default-deco ())
|
|
|
|
(: mwm-win
|
|
'(with (deco-string (get-res-value "clientDecoration")
|
|
deco-list ())
|
|
(if window-is-transient-for (: deco-list transientDecoration)
|
|
(if (= deco-string "all")
|
|
(: deco-list '(border maximize minimize resizeh menu title))
|
|
|
|
(= deco-string "none") (: deco-list ())
|
|
(: deco-list (listify-string deco-string))))
|
|
(get-deco-ctxt deco-list)
|
|
(mwm-win-deco-make)))
|
|
|
|
(: all '(maximize minimize menu resizeh border title))
|
|
|
|
(de get-deco-ctxt (theDeco)
|
|
(: deco.title ())
|
|
(: deco.border ())
|
|
(: deco.maximize ())
|
|
(: deco.minimize ())
|
|
(: deco.menu ())
|
|
(: deco.resizeh ())
|
|
|
|
(if (= theDeco 'none) ()
|
|
(= theDeco 'all) (get-deco-ctxt (eval theDeco))
|
|
(while theDeco
|
|
(set (atom (+ "deco." (# 0 theDeco))) t)
|
|
(: theDeco (sublist 1 (length theDeco) theDeco))
|
|
)
|
|
)
|
|
)
|