92 lines
2.5 KiB
Plaintext
92 lines
2.5 KiB
Plaintext
; ICON WITH COMPUTER LOOK
|
|
; =======================
|
|
|
|
;;File: term-icon.gwm -- little computer whith name in screen
|
|
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
|
|
;;Revision: 1.0 -- Feb 1 1989
|
|
;;State: Exp
|
|
;;GWM Version: 1.4
|
|
|
|
;;=============================================================================
|
|
;; define the screen-dependent resources
|
|
;;=============================================================================
|
|
|
|
(declare-screen-dependent
|
|
term-icon.screen-data
|
|
term-icon.context
|
|
term-icon.foreground
|
|
term-icon.background
|
|
term-icon.borderpixel)
|
|
|
|
(defaults-to
|
|
term-icon.borderwidth 0
|
|
term-icon.font small-font)
|
|
|
|
(if (not (boundp 'term-icon)) ;define only once
|
|
(with (wob wob) ; saves current wob
|
|
(for screen (list-of-screens)
|
|
|
|
;; user-settable defaults
|
|
(defaults-to
|
|
term-icon.foreground black
|
|
term-icon.background white
|
|
term-icon.borderpixel black)
|
|
|
|
(setq term-icon.context
|
|
'(font term-icon.font
|
|
foreground term-icon.foreground
|
|
background term-icon.background
|
|
borderwidth term-icon.borderwidth
|
|
borderpixel term-icon.borderpixel))
|
|
|
|
)))
|
|
|
|
(de corner (name)
|
|
(plug-make (pixmap-make name)))
|
|
|
|
;; fsm
|
|
;;====
|
|
|
|
(: icon-plug-fsm
|
|
(fsm-make
|
|
(state-make
|
|
icon-behavior
|
|
(on (user-event 'get-title) (update-plug-in-icon update-icon.title))
|
|
(on (user-event 'get-icon) (update-plug-in-icon window-icon-name))
|
|
standard-behavior
|
|
)))
|
|
|
|
|
|
;;=============================================================================
|
|
;; The deco
|
|
;;=============================================================================
|
|
|
|
(defun term-icon args
|
|
(with-eval
|
|
(+ term-icon.context
|
|
(get-context (std-resource-get 'TermIcon 'term-icon))
|
|
args
|
|
)
|
|
(with (fsm icon-fsm
|
|
context (context-save term-icon.context)
|
|
grabs icon-grabs menu 'icon-pop
|
|
property (+ property (list 'context context)))
|
|
(window-make
|
|
(with (tile (pixmap-make "xterm-t")
|
|
bar-min-width 0 bar-max-width 32)
|
|
(bar-make (corner "xterm-tl") () (corner "xterm-tr")))
|
|
(with (tile (pixmap-make "xterm-l")
|
|
bar-min-width 8 bar-max-width 8)
|
|
(bar-make ))
|
|
(with (tile (pixmap-make "xterm-r")
|
|
bar-min-width 8 bar-max-width 8)
|
|
(bar-make ))
|
|
(with (tile (pixmap-make "xterm-b")
|
|
bar-min-width 0 bar-max-width 32)
|
|
(bar-make (corner "xterm-bl") () (corner "xterm-br")))
|
|
(with (fsm icon-plug-fsm)
|
|
(plug-make
|
|
(label-make window-icon-name))))
|
|
)))
|
|
|