; 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))))
))))