900 lines
26 KiB
Plaintext
900 lines
26 KiB
Plaintext
|
|
;;File: mwm-icon.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
|
|
|
|
|
|
|
|
(: icon.size.width (+ (# 0 iconImageMaximum) 12))
|
|
|
|
(df icon-menu-open ()
|
|
(if iconClick
|
|
(with (theIcon window
|
|
window window-window
|
|
theMenu (window-menu)
|
|
theMenuWob (menu-wob theMenu)
|
|
window theIcon
|
|
x window-x
|
|
y (- window-y (height theMenuWob))
|
|
)
|
|
(if (< y 0) (: y (+ window-y window-height)))
|
|
(if (> (+ x (width theMenuWob)) screen-width)
|
|
(: x (- screen-width (width theMenuWob))))
|
|
(move-window theMenuWob x y)
|
|
(menu.pop (window-menu) 1 'here)
|
|
(with (wob theMenuWob) (## 'current-valid-item wob 0))
|
|
(send-user-event 'goto-activable theMenuWob)
|
|
(if (# 0 (valid-items theMenuWob))
|
|
(send-user-event 'select-item (# 0 (valid-items theMenuWob))))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
; MWM-ICON-FSM :
|
|
; ============
|
|
(: icon-standard-behavior
|
|
(state-make
|
|
(on focus-out (progn ;(? "focus leaving icon " window-name "\n")
|
|
(maintain-focus-out)))
|
|
(on focus-in (progn ;(? "focus in icon " window-name "\n")
|
|
(maintain-focus-in)))
|
|
(on (buttonrelease 1 alone)
|
|
(progn
|
|
(: double-click-required window)
|
|
(: time-of-last-release (current-event-time))
|
|
(icon-menu-open)
|
|
)
|
|
)
|
|
(if (= keyboardFocusPolicy 'explicit)
|
|
(on (buttonpress 1 alone)
|
|
(progn
|
|
(if (not (# 'got-focus window-property))
|
|
(progn
|
|
(set-focus)
|
|
(: resize-flag ())
|
|
(if passSelectButton
|
|
(ungrab-server-and-replay-event ())
|
|
(allow-event-processing))
|
|
(unset-grabs (buttonpress 1 alone))
|
|
)
|
|
(progn
|
|
(allow-event-processing)
|
|
(if (= double-click-required window)
|
|
(progn
|
|
(if (< (- (current-event-time) time-of-last-release)
|
|
doubleClickTime)
|
|
(send-user-event 'double-click
|
|
double-click-required))
|
|
(: double-click-required ()))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(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 (not (= keyboardFocusPolicy 'explicit))
|
|
(on leave-window (send-user-event 'leave-window)))
|
|
(if (not (= keyboardFocusPolicy 'explicit))
|
|
(on (user-event 'leave-window)
|
|
(if (or (not completeIconNameOnFocusIn)
|
|
(in-menu-name-test))
|
|
(if (not (current-event-from-grab))
|
|
(progn ;(? "Should be leaving.\n")
|
|
(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)))
|
|
(progn ;(? "Should be leaving2.")
|
|
(set-focus ()))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
))
|
|
(on (user-event 'test-in-icon)
|
|
(with (cmp (current-mouse-position) x (# 0 cmp) y (# 1 cmp))
|
|
(: in-icon (and (> x window-x) (> y window-y)
|
|
(< x (+ window-x window-width))
|
|
(< y (+ window-y window-height))
|
|
)
|
|
)
|
|
))
|
|
(on (user-event 'double-click) (mwm-de-iconify-window))
|
|
)
|
|
)
|
|
|
|
(df in-menu-name-test ()
|
|
(if (# 'focus-in-menu-name-placed window)
|
|
(with (cmp (current-mouse-position) x (# 0 cmp) y (# 1 cmp))
|
|
(: in-menu-name ())
|
|
(send-user-event 'test-in-menu-name
|
|
(menu-wob (# 'focus-in-menu-name window)))
|
|
(not in-menu-name))
|
|
t))
|
|
|
|
(df mwm-icon-fsm ()
|
|
(fsm-make
|
|
(state-make
|
|
(# 0 (# 'icon keyBindings))
|
|
(# 'wfsm (menu-wob menu))
|
|
icon-standard-behavior
|
|
(do-bindings-state '(icon))
|
|
)
|
|
)
|
|
)
|
|
|
|
; MWM-ICON-FRAME-FSM :
|
|
; ------------------
|
|
(: mwm-icon-frame-fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on (user-event 'focus-in) (: wob-tile (# 'activepixmap wob)) )
|
|
(on (user-event 'focus-out) (: wob-tile (# 'pixmap wob)) )
|
|
(on (buttonpress 1 alone)
|
|
(progn
|
|
(if (= double-click-required window)
|
|
(progn
|
|
(if (< (- (current-event-time) time-of-last-release)
|
|
doubleClickTime)
|
|
(send-user-event 'double-click double-click-required)
|
|
(do-binding-button 1 alone 'press '(icon))
|
|
)
|
|
(: double-click-required ())
|
|
)
|
|
(progn
|
|
(: double-click-required ())
|
|
(do-binding-button 1 alone 'press '(icon))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(on (buttonrelease 1 alone)
|
|
(progn
|
|
(: double-click-required window)
|
|
(: time-of-last-release (current-event-time))
|
|
(icon-menu-open)
|
|
)
|
|
)
|
|
(do-bindings-state '(icon))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
; THE BARS :
|
|
; ========
|
|
|
|
(: fimn-height (+ 3 iconFontList.height (* 2 label-vertical-margin)))
|
|
(de shadow-focus-in-menu-name-pixmap.make (top)
|
|
(with (
|
|
foreground iconActiveBottomShadowColor
|
|
h fimn-height
|
|
theTile (pixmap-make 2 h)
|
|
)
|
|
(if top
|
|
(with (foreground iconActiveTopShadowColor)
|
|
(draw-line theTile 0 0 0 (- h 1))
|
|
(draw-line theTile 1 0 1 (- h 2))
|
|
)
|
|
(progn
|
|
(with (foreground iconActiveTopShadowColor)
|
|
(draw-line theTile 0 0 0 1)
|
|
)
|
|
(with (foreground iconActiveBottomShadowColor)
|
|
(draw-line theTile 0 1 1 1)
|
|
)
|
|
)
|
|
)
|
|
theTile
|
|
)
|
|
)
|
|
|
|
|
|
(: left-focus-in-menu-name-plug
|
|
(with (
|
|
cursor frame-cursor
|
|
fsm () ;mwm-icon-frame-fsm
|
|
tile (shadow-focus-in-menu-name-pixmap.make t)
|
|
borderwidth 0
|
|
menu ()
|
|
)
|
|
(plug-make tile)
|
|
)
|
|
)
|
|
|
|
(: right-focus-in-menu-name-plug
|
|
(with (
|
|
cursor frame-cursor
|
|
fsm () ;mwm-icon-frame-fsm
|
|
tile (shadow-focus-in-menu-name-pixmap.make ())
|
|
borderwidth 0
|
|
menu ()
|
|
)
|
|
(plug-make tile)
|
|
)
|
|
)
|
|
|
|
(: focus-in-menu-name-tile
|
|
(with (foreground iconActiveBackground
|
|
h fimn-height
|
|
w (+ icon.size.width (/ icon.size.width 2))
|
|
theTile (pixmap-make w h)
|
|
)
|
|
(with (foreground iconActiveTopShadowColor)
|
|
(draw-line theTile 0 0 (- w 1) 0)
|
|
;(draw-line theTile 0 1 (- w 1) 1)
|
|
)
|
|
(with (foreground iconActiveBottomShadowColor)
|
|
(draw-line theTile 0 (- h 1) (- w 1) (- h 1))
|
|
(draw-line theTile 0 (- h 2) (- w 1) (- h 2))
|
|
)
|
|
theTile
|
|
)
|
|
)
|
|
|
|
(: focus-in-menu-min-width-bar
|
|
(with (
|
|
foreground iconActiveTopShadowColor
|
|
fsm ()
|
|
borderwidth 0
|
|
)
|
|
(bar-make (plug-make (pixmap-make (+ icon.size.width (/ icon.size.width 2)) 1) ) ())
|
|
)
|
|
)
|
|
|
|
|
|
(: icon-right-bar
|
|
(with (
|
|
cursor frame-cursor
|
|
fsm mwm-icon-frame-fsm
|
|
pixmap (pixmap-make iconBackground
|
|
"mwm-icrt" iconTopShadowColor
|
|
"mwm-icrb" iconBottomShadowColor
|
|
)
|
|
activepixmap (pixmap-make iconActiveBackground
|
|
"mwm-icrt" iconActiveTopShadowColor
|
|
"mwm-icrb" iconActiveBottomShadowColor
|
|
)
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap)
|
|
tile pixmap
|
|
borderwidth 0
|
|
bar-min-width 5
|
|
)
|
|
(bar-make)
|
|
)
|
|
)
|
|
|
|
(: icon-left-bar
|
|
(with (
|
|
cursor frame-cursor
|
|
fsm mwm-icon-frame-fsm
|
|
pixmap (pixmap-make iconBackground
|
|
"mwm-iclt" iconTopShadowColor
|
|
"mwm-iclb" iconBottomShadowColor
|
|
)
|
|
activepixmap (pixmap-make iconActiveBackground
|
|
"mwm-iclt" iconActiveTopShadowColor
|
|
"mwm-iclb" iconActiveBottomShadowColor
|
|
)
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap)
|
|
tile pixmap
|
|
borderwidth 0
|
|
bar-min-width 5
|
|
)
|
|
(bar-make)
|
|
)
|
|
)
|
|
|
|
|
|
(: icon-tl-plug
|
|
(with (
|
|
pixmap (pixmap-make iconBackground
|
|
"mwm-ictlt" iconTopShadowColor
|
|
"mwm-ictlb" iconBottomShadowColor)
|
|
activepixmap (pixmap-make iconActiveBackground
|
|
"mwm-ictlt" iconActiveTopShadowColor
|
|
"mwm-ictlb" iconActiveBottomShadowColor)
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap)
|
|
fsm mwm-icon-frame-fsm
|
|
borderwidth 0
|
|
cursor frame-cursor
|
|
)
|
|
(plug-make pixmap)
|
|
)
|
|
)
|
|
|
|
(: icon-tr-plug
|
|
(with (
|
|
cursor frame-cursor
|
|
pixmap (pixmap-make iconBackground
|
|
"mwm-ictrt" iconTopShadowColor
|
|
"mwm-ictrb" iconBottomShadowColor)
|
|
activepixmap (pixmap-make iconActiveBackground
|
|
"mwm-ictrt" iconActiveTopShadowColor
|
|
"mwm-ictrb" iconActiveBottomShadowColor)
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap)
|
|
fsm mwm-icon-frame-fsm
|
|
borderwidth 0
|
|
)
|
|
(plug-make pixmap)
|
|
)
|
|
)
|
|
|
|
(: icon-top-bar
|
|
(with (
|
|
cursor frame-cursor
|
|
pixmap (pixmap-make iconBackground
|
|
"mwm-ictt" iconTopShadowColor
|
|
"mwm-ictb" iconBottomShadowColor)
|
|
activepixmap (pixmap-make iconActiveBackground
|
|
"mwm-ictt" iconActiveTopShadowColor
|
|
"mwm-ictb" iconActiveBottomShadowColor)
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap)
|
|
tile pixmap
|
|
fsm mwm-icon-frame-fsm
|
|
borderwidth 0
|
|
bar-min-width 5
|
|
bar-max-width 5)
|
|
(bar-make icon-tl-plug () icon-tr-plug)
|
|
)
|
|
)
|
|
|
|
(: icon-bottom-bar-width (+ 12 iconFontHeight))
|
|
|
|
(de pixmap-make-icon-bl (active)
|
|
(with (tSC (if active iconActiveTopShadowColor iconTopShadowColor)
|
|
bSC (if active iconActiveBottomShadowColor iconBottomShadowColor)
|
|
foreground (if active iconActiveBackground iconBackground)
|
|
theTile (pixmap-make 5 icon-bottom-bar-width)
|
|
)
|
|
(with (foreground tSC)
|
|
(draw-line theTile 0 0 0 (- icon-bottom-bar-width 1))
|
|
(draw-line theTile 1 0 1 (- icon-bottom-bar-width 1))
|
|
(draw-line theTile 4 0 4 1)
|
|
(draw-line theTile 0 4 4 4)
|
|
)
|
|
(with (foreground bSC)
|
|
(draw-line theTile 1 3 4 3)
|
|
(draw-line theTile 1 (- icon-bottom-bar-width 1) 4 (- icon-bottom-bar-width 1))
|
|
(draw-line theTile 2 (- icon-bottom-bar-width 2) 4 (- icon-bottom-bar-width 2))
|
|
)
|
|
(with (foreground (if active iconActiveBackground iconBackground))
|
|
(draw-line theTile 3 1 4 1)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
|
|
(: icon-bl-plug
|
|
(with (
|
|
cursor frame-cursor
|
|
fsm mwm-icon-frame-fsm
|
|
pixmap (pixmap-make-icon-bl ())
|
|
activepixmap (pixmap-make-icon-bl t)
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap)
|
|
borderwidth 0
|
|
)
|
|
(plug-make pixmap)
|
|
)
|
|
)
|
|
|
|
(de pixmap-make-icon-br (active)
|
|
(with (tSC (if active iconActiveTopShadowColor iconTopShadowColor)
|
|
bSC (if active iconActiveBottomShadowColor iconBottomShadowColor)
|
|
foreground (if active iconActiveBackground iconBackground)
|
|
theTile (pixmap-make 5 icon-bottom-bar-width)
|
|
)
|
|
(with (foreground bSC)
|
|
(draw-line theTile 4 0 4 (- icon-bottom-bar-width 1))
|
|
(draw-line theTile 3 0 3 (- icon-bottom-bar-width 1))
|
|
(draw-line theTile 0 (- icon-bottom-bar-width 1) 4 (- icon-bottom-bar-width 1))
|
|
(draw-line theTile 0 (- icon-bottom-bar-width 2) 4 (- icon-bottom-bar-width 2))
|
|
(draw-line theTile 0 3 4 3)
|
|
)
|
|
(with (foreground tSC)
|
|
(draw-line theTile 0 0 0 1)
|
|
(draw-line theTile 0 4 3 4)
|
|
)
|
|
(with (foreground (if active iconActiveBackground iconBackground))
|
|
(draw-line theTile 0 1 1 1)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
(: icon-br-plug
|
|
(with (
|
|
cursor frame-cursor
|
|
fsm mwm-icon-frame-fsm
|
|
pixmap (pixmap-make-icon-br ())
|
|
activepixmap (pixmap-make-icon-br t)
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap)
|
|
borderwidth 0
|
|
)
|
|
(plug-make pixmap)
|
|
)
|
|
)
|
|
|
|
(de tile-make-icon-bottom-bar (active)
|
|
(with (tSC (if active iconActiveTopShadowColor iconTopShadowColor)
|
|
bSC (if active iconActiveBottomShadowColor iconBottomShadowColor)
|
|
foreground (if active iconActiveBackground iconBackground)
|
|
theTile (pixmap-make 2 icon-bottom-bar-width)
|
|
)
|
|
(with (foreground tSC)
|
|
(draw-line theTile 0 0 1 0)
|
|
(draw-line theTile 0 4 1 4)
|
|
)
|
|
(with (foreground bSC)
|
|
(draw-line theTile 0 3 1 3)
|
|
(draw-line theTile 0 (- icon-bottom-bar-width 1) 1 (- icon-bottom-bar-width 1))
|
|
(draw-line theTile 0 (- icon-bottom-bar-width 2) 1 (- icon-bottom-bar-width 2))
|
|
)
|
|
)
|
|
)
|
|
|
|
(: icon-tile-bottom-bar (tile-make-icon-bottom-bar ()))
|
|
(: icon-active-tile-bottom-bar (tile-make-icon-bottom-bar t))
|
|
|
|
|
|
|
|
; THE LABEL-PLUG :
|
|
; ==============
|
|
(: icon-label-plug
|
|
'(with (borderwidth 0
|
|
fsm (fsm-make
|
|
(state-make
|
|
(on (user-event 'focus-in)
|
|
(progn
|
|
(: wob-background iconActiveBackground)
|
|
(wob-tile (with (foreground iconActiveForeground)
|
|
(active-label-make (# 'theLabel wob) iconFontList)))
|
|
) )
|
|
(on (user-event 'focus-out)
|
|
(progn
|
|
(: wob-background iconBackground)
|
|
(wob-tile (with (foreground iconForeground)
|
|
(active-label-make (# 'theLabel wob) iconFontList)))
|
|
) )
|
|
(on (user-event 'name-change)
|
|
(progn
|
|
(## 'theLabel wob window-icon-name)
|
|
(wob-tile
|
|
(with (foreground
|
|
(if (= wob-background iconActiveBackground)
|
|
iconActiveForeground iconForeground))
|
|
(active-label-make window-icon-name iconFontList))
|
|
)
|
|
)
|
|
)
|
|
(on (buttonpress 1 alone)
|
|
(progn
|
|
(if (= double-click-required window)
|
|
(progn
|
|
(if (< (- (current-event-time)
|
|
time-of-last-release)
|
|
doubleClickTime)
|
|
(send-user-event 'double-click
|
|
double-click-required)
|
|
(do-binding-button 1 alone 'press '(icon))
|
|
)
|
|
(: double-click-required ())
|
|
)
|
|
(progn
|
|
(do-binding-button 1 alone 'press '(icon))
|
|
(: double-click-required ())
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(on (buttonrelease 1 alone)
|
|
(progn
|
|
(: double-click-required window)
|
|
(: time-of-last-release (current-event-time))
|
|
(icon-menu-open)
|
|
)
|
|
)
|
|
(do-bindings-state '(icon))
|
|
))
|
|
|
|
background iconBackground
|
|
foreground iconForeground
|
|
font iconFontList
|
|
property (list 'theLabel window-icon-name)
|
|
)
|
|
(plug-make (label-make window-icon-name)))
|
|
)
|
|
|
|
(: icon-bottom-bar
|
|
(with (
|
|
cursor frame-cursor
|
|
foreground iconForeground
|
|
pixmap icon-tile-bottom-bar
|
|
activepixmap icon-active-tile-bottom-bar
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap)
|
|
tile pixmap
|
|
fsm mwm-icon-frame-fsm
|
|
bar-min-width icon-bottom-bar-width
|
|
borderwidth 0
|
|
)
|
|
(bar-make icon-bl-plug () icon-label-plug () icon-br-plug))
|
|
)
|
|
|
|
(: focus-in-menu-name-bar
|
|
(with (
|
|
cursor frame-cursor
|
|
tile focus-in-menu-name-tile
|
|
fsm () ;mwm-icon-frame-fsm
|
|
bar-min-width fimn-height
|
|
borderwidth 0
|
|
menu ()
|
|
)
|
|
(bar-make left-focus-in-menu-name-plug () icon-label-plug
|
|
() right-focus-in-menu-name-plug)
|
|
)
|
|
)
|
|
|
|
|
|
(df center-icon-blank-pixmap ()
|
|
(with (foreground iconImageBackground
|
|
MaxX (+ (# 0 iconImageMaximum) 1)
|
|
MaxY (+ (# 1 iconImageMaximum) 1)
|
|
theTile (pixmap-make (+ MaxX 1) (+ MaxY 1))
|
|
)
|
|
(with (foreground iconImageTopShadowColor)
|
|
(draw-line theTile 0 0 MaxX 0 )
|
|
(draw-line theTile 0 0 0 MaxY)
|
|
)
|
|
(with (foreground iconImageBottomShadowColor)
|
|
(draw-line theTile 0 MaxY MaxX MaxY)
|
|
(draw-line theTile MaxX 1 MaxX MaxY)
|
|
)
|
|
theTile
|
|
)
|
|
)
|
|
|
|
(df anonymous-icon-pixmap ()
|
|
(pixmap-make iconImageBackground
|
|
(center-icon-blank-pixmap) iconImageBackground
|
|
"X.xbm" iconImageForeground
|
|
)
|
|
)
|
|
|
|
|
|
; Fsm of the center plug :
|
|
(: icon-center-plug-fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on (user-event 'icon-pixmap-change)
|
|
(wob-tile
|
|
(with (iconImageBackground (color-make
|
|
(get-res-value 'iconImageBackground))
|
|
iconImageForeground (color-make
|
|
(get-res-value 'iconImageForeground))
|
|
iconImageBottomShadowColor (color-make (get-res-value
|
|
'iconImageBottomShadowColor))
|
|
iconImageTopShadowColor (color-make (get-res-value
|
|
'iconImageTopShadowColor))
|
|
simple-icon-decoration.wip (window-icon-pixmap)
|
|
)
|
|
(pixmap-make iconImageBackground
|
|
(center-icon-blank-pixmap) iconImageBackground
|
|
simple-icon-decoration.wip iconImageBackground
|
|
))))
|
|
(on (buttonpress 1 alone)
|
|
(progn
|
|
(if (= double-click-required window)
|
|
(progn
|
|
(if (< (- (current-event-time) time-of-last-release)
|
|
doubleClickTime)
|
|
(send-user-event 'double-click
|
|
double-click-required)
|
|
(do-binding-button 1 alone 'press '(icon)))
|
|
(: double-click-required ()))
|
|
(progn
|
|
(do-binding-button 1 alone 'press '(icon))
|
|
(: double-click-required ())))))
|
|
(on (buttonrelease 1 alone)
|
|
(progn
|
|
(: double-click-required window)
|
|
(: time-of-last-release (current-event-time))
|
|
(icon-menu-open)
|
|
)
|
|
)
|
|
(do-bindings-state '(icon))
|
|
)
|
|
)
|
|
)
|
|
|
|
(: focus-in-menu-name-fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on (user-event 'test-in-menu-name)
|
|
(: in-menu-name (and (> x (- wob-x 1)) (> y (- wob-y 1))
|
|
(< x (+ wob-x wob-width))
|
|
(< y (+ wob-y wob-height))))
|
|
)
|
|
(on (user-event 'focus-out)
|
|
(unpop-menu))
|
|
(on leave-window
|
|
(with (cmp (current-mouse-position) x (# 0 cmp) y (# 1 cmp))
|
|
;(? "Leaving the blowup.")
|
|
(: in-icon ())
|
|
(send-user-event 'test-in-icon (# 'icon-father wob))
|
|
(if (not in-icon) (send-user-event 'leave-window))))
|
|
(on (buttonpress 1 alone)
|
|
(progn
|
|
(if (= double-click-required window)
|
|
(progn
|
|
(if (< (- (current-event-time) time-of-last-release)
|
|
doubleClickTime)
|
|
(send-user-event 'double-click double-click-required)
|
|
(do-binding-button 1 alone 'press '(icon))
|
|
)
|
|
(: double-click-required ())
|
|
)
|
|
(progn
|
|
(: double-click-required ())
|
|
(do-binding-button 1 alone 'press '(icon))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(on (buttonrelease 1 alone)
|
|
(progn
|
|
(: double-click-required window)
|
|
(: time-of-last-release (current-event-time))
|
|
(icon-menu-open)
|
|
)
|
|
)
|
|
(do-bindings-state '(icon))
|
|
)
|
|
)
|
|
)
|
|
|
|
; MWM-ICON.DATA :
|
|
; =============
|
|
(: mwm-icon
|
|
'(with (
|
|
; client specific resources :
|
|
iconImageBackground (color-make (get-res-value
|
|
'iconImageBackground))
|
|
iconImageForeground (color-make
|
|
(get-res-value 'iconImageForeground))
|
|
iconImageBottomShadowColor (color-make
|
|
(get-res-value
|
|
'iconImageBottomShadowColor))
|
|
iconImageTopShadowColor (color-make (get-res-value
|
|
'iconImageTopShadowColor))
|
|
|
|
menu (eval (atom (get-res-value 'windowMenu)))
|
|
property (list 'X () 'Y ()
|
|
'focus-in-menu-name
|
|
(with (
|
|
fsm focus-in-menu-name-fsm
|
|
borderwidth 0
|
|
menu ()
|
|
cursor ()
|
|
property ()
|
|
bar-separator 0
|
|
)
|
|
(menu-make focus-in-menu-min-width-bar
|
|
focus-in-menu-name-bar)
|
|
)
|
|
'focus-in-menu-name-placed ()
|
|
)
|
|
grabs
|
|
(+ (# 1 (# 'icon keyBindings))
|
|
(# 'wgrabs (menu-wob menu))
|
|
)
|
|
cursor frame-cursor
|
|
background iconImageBackground
|
|
foreground iconImageForeground
|
|
borderwidth 0
|
|
simple-icon-decoration.wip (window-icon-pixmap)
|
|
tmp (if (not (= (get-res-value 'iconImage) ""))
|
|
(pixmap-make (get-res-value 'iconImage))
|
|
()
|
|
)
|
|
fsm icon-center-plug-fsm
|
|
center-plug
|
|
(if (window-icon-window)
|
|
(window-icon-window)
|
|
simple-icon-decoration.wip
|
|
(plug-make
|
|
(pixmap-make iconImageBackground
|
|
(center-icon-blank-pixmap) iconImageBackground
|
|
simple-icon-decoration.wip iconImageBackground
|
|
)
|
|
)
|
|
tmp
|
|
(plug-make (pixmap-make iconImageBackground
|
|
(center-icon-blank-pixmap) iconImageBackground
|
|
tmp iconImageForeground
|
|
))
|
|
(plug-make (anonymous-icon-pixmap))
|
|
)
|
|
|
|
fsm (mwm-icon-fsm)
|
|
)
|
|
|
|
(window-make
|
|
icon-top-bar
|
|
icon-left-bar
|
|
icon-right-bar
|
|
icon-bottom-bar
|
|
center-plug
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
; Cutting of the screen in boxes to tidy away icons :
|
|
; -------------------------------------------------
|
|
|
|
(: icon.size.width (+ (# 0 iconImageMaximum) 12))
|
|
(: icon.size.height (+ (# 1 iconImageMaximum) 6 icon-bottom-bar-width))
|
|
|
|
(: nb-icons.w (/ screen-width (+ icon.size.width iconPlacementMargin)))
|
|
(: nb-icons.h (/ screen-height (+ icon.size.height iconPlacementMargin)))
|
|
|
|
(: icon-box.w (+ icon.size.width iconPlacementMargin
|
|
(/ (% screen-width (+ icon.size.width iconPlacementMargin))
|
|
nb-icons.w
|
|
)))
|
|
(: icon-box.h (+ icon.size.height iconPlacementMargin
|
|
(/ (% screen-height (+ icon.size.height iconPlacementMargin))
|
|
nb-icons.h
|
|
)))
|
|
(: icon-array (list-make (* nb-icons.w nb-icons.h)))
|
|
(: xmax (* icon-box.w (- nb-icons.w 1)))
|
|
(: ymax (* icon-box.h (- nb-icons.h 1)))
|
|
|
|
; Convert pixel-coords into array-coords :
|
|
; --------------------------------------
|
|
(de xy-to-XY (x y)
|
|
(list
|
|
(if (> x xmax) (- nb-icons.w 1) (/ x icon-box.w))
|
|
(if (> y ymax) (- nb-icons.h 1) (/ y icon-box.h))
|
|
)
|
|
)
|
|
|
|
; Convert array-coords into pixel-coords :
|
|
; --------------------------------------
|
|
(de XY-to-xy (X Y)
|
|
(list
|
|
(+ (* X icon-box.w) iconPlacementMargin)
|
|
(+ (* Y icon-box.h) iconPlacementMargin)
|
|
)
|
|
)
|
|
|
|
; Get the value (icon-wob) located at (X,Y) of the icon-array :
|
|
; -----------------------------------------------------------
|
|
(de get-icon-from-array (X Y)
|
|
(if (or (< X 0)
|
|
(< Y 0)
|
|
(> X (- nb-icons.w 1))
|
|
(> Y (- nb-icons.h 1))
|
|
)
|
|
'out
|
|
(# (+ (* Y nb-icons.w) X) icon-array)
|
|
)
|
|
)
|
|
|
|
; Set the value (icon-wob) located at (X,Y) of the icon-array :
|
|
; -----------------------------------------------------------
|
|
(de set-icon-of-array (X Y value)
|
|
(if (or (< X 0)
|
|
(< Y 0)
|
|
(> X (- nb-icons.w 1))
|
|
(> Y (- nb-icons.h 1))
|
|
)
|
|
'out
|
|
(## (+ (* Y nb-icons.w) X) icon-array value)
|
|
)
|
|
)
|
|
|
|
; Get the "icon-zone" : top-left = (-1 -1)
|
|
; ------------------- top-right = (-1 +1)
|
|
; bottom-left = (+1 -1)
|
|
; bottom-right = (+1 +1)
|
|
(de areaInBoxCoords (x y)
|
|
(list
|
|
(if (> (% x icon-box.w) (/ icon-box.w 2)) 1 -1)
|
|
(if (> (% y icon-box.h) (/ icon-box.h 2)) 1 -1)
|
|
)
|
|
)
|
|
|
|
|
|
; Get the neighbors of an "icon-box" in the icon-array,
|
|
; respencting the 'iconPlacement preferences :
|
|
; ------------------------------------------
|
|
(de neighbors (x y)
|
|
(with (theBox (xy-to-XY x y)
|
|
X (# 0 theBox)
|
|
Y (# 1 theBox)
|
|
areaInBox (areaInBoxCoords x y)
|
|
incX (# 0 areaInBox)
|
|
incY (# 1 areaInBox)
|
|
theSide (# 1 iconPlacement)
|
|
)
|
|
(if (or (= theSide 'bottom) (= theSide 'top))
|
|
(list
|
|
(list (get-icon-from-array (+ X incX) Y) (+ X incX) Y)
|
|
(list (get-icon-from-array X (+ Y incY)) X (+ Y incY))
|
|
)
|
|
(list
|
|
(list (get-icon-from-array X (+ Y incY)) X (+ Y incY))
|
|
(list (get-icon-from-array (+ X incX) Y) (+ X incX) Y)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(: right (list 'v (- nb-icons.w 1) 0 -1))
|
|
(: left (list 'v 0 nb-icons.w 1))
|
|
(: bottom (list 'h (- nb-icons.h 1) 0 -1))
|
|
(: top (list 'h 0 nb-icons.h 1))
|
|
|
|
; Get the first free box in the icon-array,
|
|
; respencting the 'iconPlacement preferences :
|
|
; ------------------------------------------
|
|
(de auto-get-place ()
|
|
(with (
|
|
theSide (eval (# 1 iconPlacement))
|
|
thePlace (eval (# 0 iconPlacement))
|
|
theSide.index (# 1 theSide)
|
|
theSide.inc (# 3 theSide)
|
|
theSide.direction (# 0 theSide)
|
|
theSide.limit (# 2 theSide)
|
|
theSide.test.limit
|
|
(if (= 1 theSide.inc)
|
|
(list '< 'theSide.index theSide.limit)
|
|
(list '> 'theSide.index (- theSide.limit 1))
|
|
)
|
|
thePlace.inc (# 3 thePlace)
|
|
thePlace.direction (# 0 thePlace)
|
|
thePlace.limit (# 2 thePlace)
|
|
thePlace.test.limit
|
|
(if (= 1 thePlace.inc)
|
|
(list '< 'thePlace.index thePlace.limit)
|
|
(list '> 'thePlace.index (- thePlace.limit 1))
|
|
)
|
|
theRes ()
|
|
)
|
|
(while (and (eval theSide.test.limit) (not theRes))
|
|
(with (thePlace.index (# 1 thePlace))
|
|
(while (and (eval thePlace.test.limit) (not theRes))
|
|
(with (
|
|
X (if (= 'v theSide.direction) theSide.index thePlace.index)
|
|
Y (if (= 'h theSide.direction) theSide.index thePlace.index)
|
|
theIcon (get-icon-from-array X Y)
|
|
)
|
|
(if (not theIcon) (: theRes (list X Y)))
|
|
)
|
|
(: thePlace.index (+ thePlace.index thePlace.inc))
|
|
)
|
|
)
|
|
(: theSide.index (+ theSide.index theSide.inc))
|
|
)
|
|
theRes
|
|
)
|
|
)
|
|
|
|
|