97 lines
2.9 KiB
Plaintext
97 lines
2.9 KiB
Plaintext
; ICON with window name embedded into 8 XPM pixmaps
|
|
; =================================================
|
|
|
|
;;File: term-icon-xpm.gwm
|
|
;; usage:
|
|
;; (term-icon-xpm name-radix font text-background-color text-color)
|
|
;; builds an icon by adding 8 xpm files around the name of the icon
|
|
;; xpm files are built by appending to "name-radix" the strings
|
|
;; "-nw.xpm", "-n.xpm", "-ne.xpm", "-e.xpm" "-se.xpm", "-s.xpm", "-sw.xpm",
|
|
;; "-w.xpm" in clockwise order from top left.
|
|
;; the global variable term-icon:background can be set to a color that would
|
|
;; override the symbolic color "background" in the xpm files if present
|
|
;; text-background-color and text-color are used to create the text colors,
|
|
;; but override also the symbolic color names "fore" and "back" in the
|
|
;; pixmaps
|
|
|
|
|
|
;;=============================================================================
|
|
;; define the screen-dependent resources
|
|
;;=============================================================================
|
|
|
|
|
|
;; fsm
|
|
;;====
|
|
|
|
(: term-icon-xpm:plug-fsm
|
|
(fsm-make
|
|
(state-make
|
|
icon-behavior
|
|
(on (user-event 'get-title)
|
|
(term-icon-xpm:update-plug update-icon.title))
|
|
(on (user-event 'get-icon)
|
|
(term-icon-xpm:update-plug window-icon-name))
|
|
standard-behavior
|
|
)))
|
|
|
|
(de term-icon-xpm:update-plug (string)
|
|
(with-eval (wob-property)
|
|
(wob-tile (label-make string))
|
|
(update-placements)
|
|
))
|
|
|
|
(if (not (boundp 'term-icon:background))
|
|
(setq term-icon:background black)
|
|
)
|
|
|
|
;;=============================================================================
|
|
;; The deco
|
|
;;=============================================================================
|
|
|
|
(defun term-icon-xpm (term-icon:name term-icon:font term-icon:back
|
|
term-icon:fore
|
|
)
|
|
(with-eval
|
|
(get-context (std-resource-get 'TermIconXpm 'term-icon-xpm))
|
|
(with (fsm icon-fsm
|
|
grabs icon-grabs menu 'icon-pop
|
|
bar-min-width 0 bar-max-width 100
|
|
borderwidth 0
|
|
)
|
|
(window-make
|
|
(with (tile (term-icon:tile "n"))
|
|
(bar-make
|
|
(plug-make (term-icon:tile "nw"))
|
|
()
|
|
(plug-make (term-icon:tile "ne"))
|
|
))
|
|
(with (tile (term-icon:tile "w")) (bar-make ))
|
|
(with (tile (term-icon:tile "e")) (bar-make ))
|
|
(with (tile (term-icon:tile "s"))
|
|
(bar-make
|
|
(plug-make (term-icon:tile "sw"))
|
|
()
|
|
(plug-make (term-icon:tile "se"))
|
|
))
|
|
(with (fsm term-icon-xpm:plug-fsm
|
|
property (list 'font term-icon:font 'foreground term-icon:fore
|
|
'background term-icon:back
|
|
'label-horizontal-margin 0
|
|
'label-vertical-margin 0)
|
|
font term-icon:font
|
|
foreground term-icon:fore
|
|
background term-icon:back
|
|
label-horizontal-margin 0
|
|
label-vertical-margin 0
|
|
)
|
|
(plug-make
|
|
(label-make window-icon-name))))
|
|
)))
|
|
|
|
(defun term-icon:tile (name)
|
|
(pixmap-load (+ term-icon:name "-" name ".xpm")
|
|
'back term-icon:back
|
|
'fore term-icon:fore
|
|
'background term-icon:background
|
|
))
|