home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / xpm-icon.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  3KB  |  91 lines
  1. ; XPM ICON  DECORATION
  2. ; ====================
  3.  
  4. ;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
  5. ;;A simple icon: a central plug which is an XPM file
  6.  
  7. ; A simple deco: just use an xpm image, user must provide a function that will
  8. ; build the pixmap, and update it on an icon pixmap or icon name change.
  9.  
  10. ;; define here the screen-dependent resources
  11. (: xpm-icon.plug.fsm
  12.   (fsm-make
  13.     (state-make
  14.       (on (user-event 'icon-pixmap-change)
  15.     (xpm-icon.update ())
  16.       )
  17.       (on (user-event 'change-icon)
  18.     (xpm-icon.update ())
  19.       )
  20.       (on (user-event 'get-title)
  21.     (xpm-icon.update update-icon.title)
  22.       )
  23.       (on (user-event 'get-icon)
  24.     (xpm-icon.update window-icon-name)
  25.       )
  26.  
  27.       icon-behavior
  28.       standard-behavior
  29. )))
  30.  
  31. ;; the fuction to be used to build a window for set-icon-window
  32. ;; its argument is the function you define to actually choose the pixmap and 
  33. ;; return it, which will be called with its argument t at init, () when just
  34. ;; updating the icon pixmap, or a string if the icon name changed
  35. ;; the function MUST return a pixmap, or NIL if nothing should be changed
  36.  
  37. (de xpm-icon (func)
  38.   (with (fsm icon-fsm
  39.       menu 'icon-pop
  40.       grabs icon-grabs
  41.       property (+ (list 'plug-refresh func) property)
  42.     )
  43.     (window-make
  44.       ()                ;top bar
  45.       ()                ;left bar
  46.       ()                ;right bar
  47.       ()                ;base bar
  48.       ;; center plug 
  49.       (list 'eval (list 'with (list 'fsm 'xpm-icon.plug.fsm
  50.         'menu ''icon-pop
  51.         'grabs 'icon-grabs
  52.         'property (list 'list ''plug-refresh func)
  53.       )
  54.       (list 'plug-make (list func t)))
  55.       )
  56. )))
  57.  
  58. (de xpm-icon.update (arg)
  59.   (if (setq xpm-icon.res ((# 'plug-refresh wob) arg))
  60.     (progn
  61.       (wob-tile xpm-icon.res)
  62.       (update-placements)
  63. )))
  64.   
  65.  
  66. ;; a provided sample pixmap-choosing function: uses a pixmap named:
  67. ;; <class>-icon.<width>, width being the width in pixels of the application
  68. ;; provided icon:
  69. ;; for instance, in . Xdefault I have:
  70. ;;
  71. ;; xmh.noMailIconBitmap:    flagdown.xbm          # a 48-pixel wide icon
  72. ;; xmh.newMailIconBitmap:    flagup.xbm            # a 78-pixel wide icon
  73. ;;
  74. ;; in my .profile.gwm, I have:
  75. ;; (load 'xpm-icon)
  76. ;; (set-icon-window any Xmh.xmh.xmh:_inbox (xpm-icon xpm-icon-by-size))
  77. ;; 
  78. ;; in my ~/gwm directory, I have put my two nice xpm files:
  79. ;; Xmh-icon.48
  80. ;; Xmh-icon.78
  81.  
  82. (defun xpm-icon-by-size (init?)
  83.   (with (
  84.       pix (window-icon-pixmap)
  85.       w (if pix (width pix) 0)    
  86.     )
  87.     (pixmap-load (+ window-client-class "-icon." (itoa w))))
  88. ))))
  89.  
  90.  
  91.