home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / twm-icon-mgr.gwm < prev    next >
Text File  |  1995-07-03  |  6KB  |  204 lines
  1. ; Icon Manager Support For Twm Emulator
  2. ; =====================================
  3. ;
  4. ; Author : Arup Mukherjee (arup@grasp.cis.upenn.edu) [Dec 1989]
  5. ;
  6. ; Within the restrictions of the GWM copyright, you may do whatever you
  7. ; want with this code. It would be nice, however, if my name were to remain 
  8. ; in it somewhere.
  9. ;
  10. ; New and improved (faster) icon manager. Credit due to 
  11. ; J.K.Wight@newcastle.ac.uk for the redesign suggestion
  12. ;
  13. ; Bugs found and corrected 3/2-92 Dag Diesen
  14.  
  15.  
  16. (if (not (boundp 'icon-pixmap))
  17.     (: icon-pixmap (pixmap-make title-background
  18.                 (+ bitmaps-dir "iconify.xbm")
  19.                 title-foreground)))
  20.  
  21. (if (not (boundp 'iconify-before-icon-mgr))
  22.     (: iconify-before-icon-mgr iconify-window))
  23.  
  24. (de iconify-window ()
  25.     (if (not iconify-by-unmapping)
  26.     (iconify-before-icon-mgr)
  27.       (if (window-is-mapped)
  28.       (unmap-window)
  29.     (map-window)))
  30.     (if (and show-icon-mgr (boundp 'icon-mgr-wob))
  31.       (send-user-event 'icon-mgr-rethink icon-mgr-wob)))
  32.  
  33. (: make-iconification-mgr
  34.    (fsm-make
  35.     (state-make
  36.      (on enter-window
  37.        (set-focus (# 'window wob-property)))
  38.      (on leave-window
  39.        (set-focus ()))
  40.      (on (buttonpress any any)
  41.      (with (window (# 'window wob-property))
  42.              (iconify-window)
  43.              (set-focus))))))
  44.  
  45. (: icon-mgr-plug-fsm
  46.    (fsm-make
  47.     (state-make
  48.      (on (user-event 'icon-mgr-rethink)
  49.      (with (w1 wob)
  50.            (if (with (window (# 'window wob-property))
  51.              (window-is-mapped))
  52.            (progn (wob w1)
  53.               (wob-tile (with (foreground icon-mgr-background)
  54.                                         (pixmap-make (width icon-pixmap)
  55.                                                      (height icon-pixmap)))))
  56.          (progn (wob w1)
  57.             (wob-tile icon-pixmap))))))))
  58.  
  59. (: icon-mgr-label-plug-fsm
  60.    (fsm-make
  61.     (state-make
  62.      (on (user-event 'icon-mgr-rethink)
  63.      (with (w1 wob
  64.            borderwidth 0 background icon-mgr-background
  65.            foreground icon-mgr-foreground
  66.            borderpixel icon-mgr-background
  67.            font icon-mgr-font   
  68.            dumb-temporary     
  69.            (active-label-make (with (window (# 'window wob-property))
  70.                         window-icon-name)))
  71.            (wob w1)
  72.            (wob-tile dumb-temporary)
  73.            (move-window (icon-mgr-x-pos) (icon-mgr-y-pos)))))))
  74.            
  75.  
  76.  
  77. (df update-menu-expr extras
  78.     (: menu-expr '(menu-make))
  79.     (with (borderwidth 0 background icon-mgr-background
  80.                foreground icon-mgr-foreground
  81.                borderpixel icon-mgr-background
  82.                font icon-mgr-font
  83.                direction vertical)
  84.  
  85.       (for window (sort (+ (list-of-windows 'window))
  86.                 (lambda (w1 w2)
  87.                   (compare (with (window w1) (window-name))
  88.                        (with (window w2) (window-name)))))
  89.            (if (and (not (member (window-name) icon-mgr-exclusions))
  90.             (not (= window icon-mgr-dying-window)))
  91.            (progn
  92.              (: mgd-bar 
  93.              (with (fsm make-iconification-mgr
  94.                     font icon-mgr-font
  95.                     property (+ (list 'window window)
  96.                         property))
  97.                    (bar-make
  98.                 (with (fsm icon-mgr-plug-fsm)
  99.                       (if (and (not (window-is-mapped))
  100.                            (not (member window extras)))
  101.                       (plug-make icon-pixmap)
  102.                     (with (foreground icon-mgr-background)
  103.                           (plug-make 
  104.                                              (pixmap-make
  105.                                               (width icon-pixmap)
  106.                                               (height icon-pixmap))))))
  107.                 (with (fsm icon-mgr-label-plug-fsm)
  108.                       (plug-make (active-label-make
  109.                           (window-icon-name))))
  110.                 ())))
  111.              (: menu-expr (+ menu-expr (list mgd-bar))))))
  112.       (with (menu-max-width icon-mgr-max-width 
  113.                 menu-min-width icon-mgr-min-width
  114.                 fsm ())
  115.         (if (> (length menu-expr) 1)
  116.             (: icon-mgr-menu (eval menu-expr))
  117.           (: icon-mgr-menu ())))))
  118.           
  119.  
  120. (if (not (boundp 'icon-mgr-x-pos))
  121.     (df icon-mgr-x-pos ()
  122.     (with (wob (menu-wob icon-mgr-menu))
  123.           (if (or (> (+ icon-mgr-xpos (wob-width)) screen-width)
  124.               (> (+ icon-mgr-xpos icon-mgr-xstickyness) screen-width))
  125.           (- screen-width (+ wob-width 2))
  126.         icon-mgr-xpos))))
  127.        
  128. (if (not (boundp 'icon-mgr-y-pos))
  129.   (df icon-mgr-y-pos ()
  130.     (with (wob (menu-wob icon-mgr-menu))
  131.       (if (or (> (+ icon-mgr-ypos (wob-height)) screen-height)
  132.       (> (+ icon-mgr-ypos icon-mgr-ystickyness) screen-height))
  133.     (- screen-height (+ wob-height 2))
  134.     icon-mgr-ypos))))
  135.  
  136. (df icon-mgr-display extras
  137.   (if (boundp 'icon-mgr-wob)
  138.     (progn
  139.       (with (wob icon-mgr-wob)
  140.     (setq icon-mgr-xpos 
  141.       (+ wob-x 1))
  142.     (setq icon-mgr-ypos 
  143.       (+ (+ wob-y window-client-y) 1)))
  144.       (kill-window icon-mgr-wob)
  145.       (unbind 'icon-mgr-wob)))
  146.   (process-events)
  147.   (if (> (length (list-of-windows 'window)) 0)
  148.     (progn
  149.       (if (not (= (length extras) 0))
  150.     (eval (list 'update-menu-expr (eval extras)))
  151.     (update-menu-expr))
  152.       (with (reenter-on-opening ())
  153.     (if icon-mgr-menu
  154.       (if (or (not (boundp 'icon-mgr-xpos)) 
  155.           (not (boundp 'icon-mgr-ypos)))
  156.         (: icon-mgr-wob 
  157.           (place-menu icon-mgr-name icon-mgr-menu))
  158.         (: icon-mgr-wob (place-menu icon-mgr-name
  159.         icon-mgr-menu
  160.         (icon-mgr-x-pos)
  161.         (icon-mgr-y-pos))))
  162.       (progn
  163.         (if (boundp 'icon-mgr-menu) 
  164.           (unbind 'icon-mgr-menu))
  165.         (setq show-icon-mgr ())) )))
  166.     (progn
  167.       (if (boundp 'icon-mgr-menu)
  168.     (unbind 'icon-mgr-menu))
  169.       (setq show-icon-mgr ())) ))
  170.  
  171.  
  172. (df icon-mgr-toggle ()
  173.     (if show-icon-mgr
  174.     (progn
  175.       (setq show-icon-mgr ())
  176.       (setq iconify-by-unmapping ())
  177.       (if (boundp 'icon-mgr-wob)
  178.           (progn
  179.         (kill-window icon-mgr-wob)
  180.         (unbind 'icon-mgr-menu)
  181.         (unbind 'icon-mgr-wob))))
  182.         (if (> (length (list-of-windows 'window)) 0)
  183.       (progn (setq show-icon-mgr t)
  184.          (setq iconify-by-unmapping t)
  185.                (icon-mgr-display))
  186.             (print "Can not display empty Icon Manager!\n"))
  187.         ))
  188.  
  189. (: to-be-done-after-setup 
  190.    '(progn
  191.       (if show-icon-mgr
  192.               (if (> (length (list-of-windows 'window)) 0)
  193.       (progn
  194.         (: setup-done t)
  195.         (eval icon-mgr-font)
  196.         (icon-mgr-display)
  197.         (if show-icon-mgr
  198.         (with (wob icon-mgr-wob)
  199.               (move-window (icon-mgr-x-pos) (icon-mgr-y-pos))))
  200.                 (process-exposes))
  201.               (progn
  202.                 (setq show-icon-mgr nil)
  203.                 (print "Can not display empty Icon Manager!\n")) ))))
  204.