home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / term-icon.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  2KB  |  89 lines
  1. ; ICON WITH COMPUTER LOOK
  2. ; =======================
  3.  
  4. ;;File: term-icon.gwm -- little computer whith name in screen
  5. ;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
  6. ;;Revision: 1.0 -- Feb 1 1989
  7. ;;State: Exp
  8. ;;GWM Version: 1.4
  9.  
  10.  
  11. ;;=============================================================================
  12. ;;                    define the screen-dependent resources
  13. ;;=============================================================================
  14.  
  15. (if (not (boundp 'term-icon))    ;define only once
  16.   (with (wob wob)            ; saves current wob
  17.     (declare-screen-dependent
  18.       term-icon.screen-data
  19.       term-icon.foreground
  20.       term-icon.background
  21.       term-icon.borderpixel)
  22.       ;; user-settable defaults
  23.     (for screen (list-of-screens)
  24.       (defaults-to
  25.     term-icon.foreground black
  26.     term-icon.background white
  27.     term-icon.borderpixel black)
  28. )))
  29.  
  30. (defaults-to
  31.   term-icon.borderwidth 0
  32.   term-icon.font small-font)
  33.  
  34. (setq term-icon.context
  35.   '(font term-icon.font         
  36.     foreground term-icon.foreground
  37.     background term-icon.background
  38.     borderwidth term-icon.borderwidth
  39.     borderpixel term-icon.borderpixel))
  40.  
  41. (de corner (name) 
  42.   (plug-make (pixmap-make name)))
  43.  
  44. ;; fsm
  45. ;;====
  46.  
  47. (: icon-plug-fsm
  48.   (fsm-make
  49.     (state-make
  50.       icon-behavior
  51.       (on (user-event 'get-title) (update-plug-in-icon update-icon.title))
  52.       (on (user-event 'get-icon) (update-plug-in-icon window-icon-name))
  53.       standard-behavior
  54. )))
  55.  
  56.  
  57. ;;=============================================================================
  58. ;;                    The deco
  59. ;;=============================================================================
  60.  
  61. (defun term-icon args
  62.   (with-eval
  63.     (+ term-icon.context
  64.       (get-context (std-resource-get 'TermIcon 'term-icon))
  65.       args
  66.     )
  67.     (with (fsm icon-fsm
  68.     context (context-save term-icon.context)
  69.     grabs icon-grabs menu 'icon-pop
  70.     property (+ property (list 'context context)))
  71.       (window-make 
  72.     (with (tile (pixmap-make "xterm-t")
  73.         bar-min-width 0 bar-max-width 32)
  74.       (bar-make   (corner "xterm-tl") () (corner "xterm-tr")))
  75.     (with (tile (pixmap-make "xterm-l")
  76.         bar-min-width 8 bar-max-width 8)
  77.       (bar-make  ))
  78.     (with (tile (pixmap-make "xterm-r")
  79.         bar-min-width 8 bar-max-width 8)
  80.       (bar-make  ))
  81.     (with (tile (pixmap-make "xterm-b")
  82.         bar-min-width 0 bar-max-width 32)
  83.       (bar-make  (corner "xterm-bl") () (corner "xterm-br")))
  84.     (with (fsm icon-plug-fsm)
  85.       (plug-make 
  86.         (label-make window-icon-name))))
  87. )))
  88.  
  89.