Generic_Window_Manager/data/xpm-icon.gwm

91 lines
2.4 KiB
Plaintext

; XPM ICON DECORATION
; ====================
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;A simple icon: a central plug which is an XPM file
; A simple deco: just use an xpm image, user must provide a function that will
; build the pixmap, and update it on an icon pixmap or icon name change.
;; define here the screen-dependent resources
(: xpm-icon.plug.fsm
(fsm-make
(state-make
(on (user-event 'icon-pixmap-change)
(xpm-icon.update ())
)
(on (user-event 'change-icon)
(xpm-icon.update ())
)
(on (user-event 'get-title)
(xpm-icon.update update-icon.title)
)
(on (user-event 'get-icon)
(xpm-icon.update window-icon-name)
)
icon-behavior
standard-behavior
)))
;; the fuction to be used to build a window for set-icon-window
;; its argument is the function you define to actually choose the pixmap and
;; return it, which will be called with its argument t at init, () when just
;; updating the icon pixmap, or a string if the icon name changed
;; the function MUST return a pixmap, or NIL if nothing should be changed
(de xpm-icon (func)
(with (fsm icon-fsm
menu 'icon-pop
grabs icon-grabs
property (+ (list 'plug-refresh func) property)
)
(window-make
() ;top bar
() ;left bar
() ;right bar
() ;base bar
;; center plug
(list 'eval (list 'with (list 'fsm 'xpm-icon.plug.fsm
'menu ''icon-pop
'grabs 'icon-grabs
'property (list 'list ''plug-refresh func)
)
(list 'plug-make (list func t)))
)
)))
(de xpm-icon.update (arg)
(if (setq xpm-icon.res ((# 'plug-refresh wob) arg))
(progn
(wob-tile xpm-icon.res)
(update-placements)
)))
;; a provided sample pixmap-choosing function: uses a pixmap named:
;; <class>-icon.<width>, width being the width in pixels of the application
;; provided icon:
;; for instance, in . Xdefault I have:
;;
;; xmh.noMailIconBitmap: flagdown.xbm # a 48-pixel wide icon
;; xmh.newMailIconBitmap: flagup.xbm # a 78-pixel wide icon
;;
;; in my .profile.gwm, I have:
;; (load 'xpm-icon)
;; (set-icon-window any Xmh.xmh.xmh:_inbox (xpm-icon xpm-icon-by-size))
;;
;; in my ~/gwm directory, I have put my two nice xpm files:
;; Xmh-icon.48
;; Xmh-icon.78
(defun xpm-icon-by-size (init?)
(with (
pix (window-icon-pixmap)
w (if pix (width pix) 0)
)
(pixmap-load (+ window-client-class "-icon." (itoa w))))
))))