home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / mwm-icon.gwm < prev    next >
Text File  |  1995-07-03  |  26KB  |  900 lines
  1.  
  2. ;;File: mwm-icon.gwm --
  3. ;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
  4. ;;Author: Frederic CHARTON
  5. ;;Revision: 1.0 -- Sep 12 1989
  6. ;;State: Exp
  7. ;;GWM Version: 1.4
  8.  
  9.  
  10.  
  11. (: icon.size.width (+ (# 0 iconImageMaximum) 12))
  12.  
  13. (df icon-menu-open ()
  14.  (if iconClick
  15.          (with (theIcon    window
  16.                 window     window-window
  17.                 theMenu    (window-menu)
  18.                 theMenuWob (menu-wob theMenu)
  19.                 window     theIcon
  20.                 x          window-x
  21.                 y          (- window-y (height theMenuWob))
  22.                )
  23.           (if (< y 0) (: y (+ window-y window-height)))
  24.           (if (> (+ x (width theMenuWob)) screen-width)
  25.                  (: x (- screen-width (width theMenuWob))))
  26.           (move-window theMenuWob x y)
  27.           (menu.pop (window-menu) 1 'here)
  28.           (with (wob  theMenuWob) (## 'current-valid-item wob 0))
  29.           (send-user-event 'goto-activable  theMenuWob)
  30.       (if (# 0 (valid-items theMenuWob))
  31.           (send-user-event 'select-item (# 0 (valid-items  theMenuWob))))
  32.          )
  33.  )
  34. )
  35.  
  36.  
  37. ; MWM-ICON-FSM :
  38. ; ============
  39. (: icon-standard-behavior
  40.  (state-make
  41.         (on focus-out (progn ;(? "focus leaving icon " window-name "\n")
  42.                  (maintain-focus-out)))
  43.         (on focus-in  (progn ;(? "focus in icon "  window-name "\n")
  44.                  (maintain-focus-in)))
  45.            (on (buttonrelease 1 alone) 
  46.         (progn
  47.           (: double-click-required window)
  48.           (: time-of-last-release (current-event-time))
  49.           (icon-menu-open)
  50.           )
  51.         )
  52.         (if (= keyboardFocusPolicy 'explicit)
  53.          (on (buttonpress 1 alone)
  54.          (progn
  55.            (if (not (# 'got-focus window-property))
  56.            (progn
  57.              (set-focus)
  58.              (: resize-flag ())
  59.              (if passSelectButton 
  60.                          (ungrab-server-and-replay-event ())
  61.                        (allow-event-processing))
  62.              (unset-grabs (buttonpress 1 alone))
  63.              )
  64.          (progn
  65.                    (allow-event-processing)
  66.                    (if (= double-click-required window)
  67.                        (progn
  68.                          (if (< (- (current-event-time) time-of-last-release) 
  69.                                 doubleClickTime)
  70.                              (send-user-event 'double-click 
  71.                                               double-click-required))
  72.                          (: double-click-required ()))
  73.                      )
  74.                    )
  75.          )
  76.            )
  77.          )
  78.      )
  79.         (if (= keyboardFocusPolicy 'explicit)
  80.          (on enter-window 
  81.          (if (not (# 'got-focus window-property))
  82.          (set-grabs (replayable-event (buttonpress 1 alone)))))
  83.          (on enter-window (set-focus))
  84.      )
  85.     (if (not (= keyboardFocusPolicy 'explicit))
  86.         (on leave-window (send-user-event 'leave-window)))
  87.     (if (not (= keyboardFocusPolicy 'explicit))
  88.         (on (user-event 'leave-window)
  89.         (if (or (not completeIconNameOnFocusIn) 
  90.             (in-menu-name-test))
  91.             (if (not (current-event-from-grab)) 
  92.             (progn ;(? "Should be leaving.\n")
  93.                    (set-focus ()))
  94.               (with (cmp (current-mouse-position)
  95.                  cmpx (- (# 0 cmp) window-x)
  96.                  cmpy (- (# 1 cmp) window-y)
  97.                  )
  98.                 (if (not (and (> cmpx 0) (> cmpy 0) 
  99.                       (< cmpx window-width)
  100.                       (< cmpy window-height)))
  101.                 (progn ;(? "Should be leaving2.")
  102.                        (set-focus ()))
  103.                   )
  104.                 )
  105.               )
  106.           )
  107.         ))
  108.     (on (user-event 'test-in-icon)
  109.         (with (cmp (current-mouse-position) x (# 0 cmp) y (# 1 cmp))
  110.           (: in-icon (and (> x window-x) (> y window-y)
  111.                   (< x (+ window-x window-width))
  112.                   (< y (+ window-y window-height))
  113.                   )
  114.              )
  115.           ))
  116.     (on (user-event 'double-click) (mwm-de-iconify-window))
  117.  )
  118. )
  119.  
  120. (df in-menu-name-test ()
  121.  (if (# 'focus-in-menu-name-placed window)
  122.      (with (cmp (current-mouse-position) x (# 0 cmp) y (# 1 cmp))
  123.     (: in-menu-name ())
  124.     (send-user-event 'test-in-menu-name 
  125.              (menu-wob (# 'focus-in-menu-name window)))
  126.     (not in-menu-name))
  127.    t))
  128.  
  129. (df mwm-icon-fsm ()
  130.  (fsm-make
  131.   (state-make
  132.     (# 0 (# 'icon keyBindings))
  133.     (# 'wfsm (menu-wob menu))
  134.     icon-standard-behavior
  135.     (do-bindings-state '(icon))
  136.   )
  137.  )
  138. )
  139.  
  140. ; MWM-ICON-FRAME-FSM :
  141. ; ------------------
  142. (: mwm-icon-frame-fsm
  143.  (fsm-make
  144.   (state-make
  145.         (on (user-event 'focus-in)  (: wob-tile (# 'activepixmap wob)) )
  146.         (on (user-event 'focus-out) (: wob-tile (# 'pixmap wob)) )
  147.         (on (buttonpress 1 alone) 
  148.       (progn
  149.                 (if (= double-click-required window)
  150.          (progn
  151.                   (if (< (- (current-event-time) time-of-last-release)
  152.              doubleClickTime)
  153.                    (send-user-event 'double-click double-click-required)
  154.            (do-binding-button 1 alone 'press '(icon))
  155.            )
  156.                   (: double-click-required ())
  157.                  )
  158.          (progn
  159.                   (: double-click-required ())
  160.           (do-binding-button 1 alone 'press '(icon))
  161.           )
  162.          )
  163.         )
  164.       )
  165.         (on (buttonrelease 1 alone) 
  166.         (progn
  167.          (: double-click-required window)
  168.          (: time-of-last-release (current-event-time))
  169.          (icon-menu-open)
  170.         )
  171.     )
  172.         (do-bindings-state '(icon))
  173.   )
  174.  )
  175. )
  176.  
  177.  
  178. ; THE BARS :
  179. ; ========
  180.  
  181. (: fimn-height (+ 3 iconFontList.height (* 2 label-vertical-margin)))
  182. (de shadow-focus-in-menu-name-pixmap.make (top)
  183.  (with (
  184.     foreground iconActiveBottomShadowColor
  185.     h fimn-height
  186.     theTile (pixmap-make 2 h)
  187.        )
  188.   (if top
  189.     (with (foreground iconActiveTopShadowColor)
  190.         (draw-line theTile 0 0 0 (- h 1))
  191.         (draw-line theTile 1 0 1 (- h 2))
  192.     )
  193.     (progn
  194.     (with (foreground iconActiveTopShadowColor)
  195.         (draw-line theTile 0 0 0 1)
  196.     )
  197.     (with (foreground iconActiveBottomShadowColor)
  198.         (draw-line theTile 0 1 1 1)
  199.     )
  200.     )
  201.   )
  202.   theTile
  203.  )
  204. )
  205.     
  206.  
  207. (: left-focus-in-menu-name-plug
  208.  (with (
  209.     cursor        frame-cursor
  210.     fsm           () ;mwm-icon-frame-fsm
  211.     tile          (shadow-focus-in-menu-name-pixmap.make t)
  212.     borderwidth   0
  213.     menu ()
  214.        )
  215.   (plug-make tile)
  216.  )
  217. )
  218.  
  219. (: right-focus-in-menu-name-plug
  220.  (with (
  221.         cursor        frame-cursor
  222.         fsm           () ;mwm-icon-frame-fsm
  223.         tile          (shadow-focus-in-menu-name-pixmap.make ())
  224.         borderwidth   0
  225.     menu ()
  226.        )
  227.   (plug-make tile)
  228.  )
  229. )
  230.  
  231. (: focus-in-menu-name-tile
  232.  (with (foreground iconActiveBackground
  233.         h fimn-height
  234.     w (+ icon.size.width (/ icon.size.width 2))
  235.     theTile (pixmap-make w h)
  236.        )
  237.   (with (foreground iconActiveTopShadowColor)
  238.     (draw-line theTile 0 0 (- w 1) 0)
  239.     ;(draw-line theTile 0 1 (- w 1) 1)
  240.   )
  241.   (with (foreground iconActiveBottomShadowColor)
  242.     (draw-line theTile 0 (- h 1)  (- w 1) (- h 1))
  243.     (draw-line theTile 0 (- h 2)  (- w 1) (- h 2))
  244.   )
  245.   theTile
  246.  )
  247. )
  248.  
  249. (: focus-in-menu-min-width-bar
  250.  (with (
  251.     foreground iconActiveTopShadowColor
  252.     fsm ()
  253.     borderwidth 0
  254.        )
  255.   (bar-make (plug-make (pixmap-make (+ icon.size.width (/ icon.size.width 2)) 1) ) ())
  256.  )
  257. )
  258.  
  259.  
  260. (: icon-right-bar 
  261.     (with (
  262.            cursor        frame-cursor
  263.            fsm           mwm-icon-frame-fsm
  264.            pixmap        (pixmap-make iconBackground 
  265.                       "mwm-icrt" iconTopShadowColor
  266.                       "mwm-icrb" iconBottomShadowColor
  267.                  )
  268.            activepixmap  (pixmap-make iconActiveBackground 
  269.                       "mwm-icrt" iconActiveTopShadowColor
  270.                       "mwm-icrb" iconActiveBottomShadowColor
  271.                              )
  272.            property      (list 'pixmap pixmap 'activepixmap activepixmap)
  273.            tile          pixmap
  274.            borderwidth   0
  275.            bar-min-width 5
  276.           )
  277.     (bar-make)
  278.         )
  279. )
  280.  
  281. (: icon-left-bar 
  282.     (with (
  283.            cursor        frame-cursor
  284.            fsm           mwm-icon-frame-fsm
  285.            pixmap        (pixmap-make iconBackground 
  286.                       "mwm-iclt" iconTopShadowColor
  287.                       "mwm-iclb" iconBottomShadowColor
  288.                  )
  289.            activepixmap  (pixmap-make iconActiveBackground 
  290.                       "mwm-iclt" iconActiveTopShadowColor
  291.                       "mwm-iclb" iconActiveBottomShadowColor
  292.                  )
  293.            property      (list 'pixmap pixmap 'activepixmap activepixmap)
  294.            tile          pixmap
  295.            borderwidth   0
  296.            bar-min-width 5
  297.           )
  298.     (bar-make)
  299.         )
  300. )
  301.  
  302.  
  303. (: icon-tl-plug
  304.     (with (
  305.            pixmap       (pixmap-make iconBackground 
  306.                  "mwm-ictlt" iconTopShadowColor
  307.                      "mwm-ictlb" iconBottomShadowColor)
  308.            activepixmap (pixmap-make iconActiveBackground 
  309.                  "mwm-ictlt" iconActiveTopShadowColor
  310.                      "mwm-ictlb" iconActiveBottomShadowColor)
  311.            property     (list 'pixmap pixmap 'activepixmap activepixmap)
  312.            fsm          mwm-icon-frame-fsm
  313.            borderwidth  0
  314.            cursor       frame-cursor
  315.           )
  316.     (plug-make pixmap)
  317.     )
  318. )
  319.  
  320. (: icon-tr-plug
  321.     (with (
  322.            cursor       frame-cursor
  323.            pixmap       (pixmap-make iconBackground 
  324.                  "mwm-ictrt" iconTopShadowColor
  325.                      "mwm-ictrb" iconBottomShadowColor)
  326.            activepixmap (pixmap-make iconActiveBackground 
  327.                  "mwm-ictrt" iconActiveTopShadowColor
  328.                      "mwm-ictrb" iconActiveBottomShadowColor)
  329.            property     (list 'pixmap pixmap 'activepixmap activepixmap)
  330.            fsm          mwm-icon-frame-fsm
  331.            borderwidth  0
  332.           )
  333.     (plug-make pixmap)
  334.     )
  335. )
  336.  
  337. (: icon-top-bar 
  338.     (with (
  339.            cursor        frame-cursor
  340.            pixmap        (pixmap-make iconBackground 
  341.                       "mwm-ictt" iconTopShadowColor
  342.                       "mwm-ictb" iconBottomShadowColor)
  343.            activepixmap  (pixmap-make iconActiveBackground 
  344.                       "mwm-ictt" iconActiveTopShadowColor
  345.                       "mwm-ictb" iconActiveBottomShadowColor)
  346.            property      (list 'pixmap pixmap 'activepixmap activepixmap)
  347.                tile          pixmap
  348.            fsm           mwm-icon-frame-fsm
  349.            borderwidth   0
  350.            bar-min-width 5
  351.            bar-max-width 5)
  352.     (bar-make icon-tl-plug () icon-tr-plug)
  353.         )
  354. )
  355.  
  356. (: icon-bottom-bar-width  (+ 12 iconFontHeight))
  357.  
  358. (de pixmap-make-icon-bl (active)
  359.  (with (tSC        (if active iconActiveTopShadowColor iconTopShadowColor)
  360.         bSC        (if active iconActiveBottomShadowColor iconBottomShadowColor)
  361.         foreground (if active iconActiveBackground iconBackground)
  362.         theTile    (pixmap-make 5 icon-bottom-bar-width)
  363.        )
  364.  (with (foreground tSC)
  365.         (draw-line theTile 0 0 0 (- icon-bottom-bar-width 1))
  366.         (draw-line theTile 1 0 1 (- icon-bottom-bar-width 1))
  367.     (draw-line theTile 4 0 4 1)
  368.         (draw-line theTile 0 4 4 4)
  369.  )
  370.  (with (foreground bSC)
  371.         (draw-line theTile 1 3 4 3)
  372.         (draw-line theTile 1 (- icon-bottom-bar-width 1) 4 (- icon-bottom-bar-width 1))
  373.         (draw-line theTile 2 (- icon-bottom-bar-width 2) 4 (- icon-bottom-bar-width 2))
  374.  )
  375.  (with (foreground (if active iconActiveBackground iconBackground))
  376.     (draw-line theTile 3 1 4 1)
  377.  )
  378.  )
  379. )
  380.  
  381.  
  382.  
  383. (: icon-bl-plug
  384.         (with (
  385.            cursor       frame-cursor
  386.            fsm          mwm-icon-frame-fsm
  387.                pixmap       (pixmap-make-icon-bl ())
  388.                activepixmap (pixmap-make-icon-bl t)
  389.                property     (list 'pixmap pixmap 'activepixmap activepixmap)
  390.                borderwidth  0
  391.               )
  392.         (plug-make pixmap)
  393.         )
  394. )
  395.  
  396. (de pixmap-make-icon-br (active)
  397.  (with (tSC        (if active iconActiveTopShadowColor iconTopShadowColor)
  398.         bSC        (if active iconActiveBottomShadowColor iconBottomShadowColor)
  399.         foreground (if active iconActiveBackground iconBackground)
  400.         theTile    (pixmap-make 5 icon-bottom-bar-width)
  401.        )
  402.  (with (foreground bSC)
  403.         (draw-line theTile 4 0 4 (- icon-bottom-bar-width 1))
  404.         (draw-line theTile 3 0 3 (- icon-bottom-bar-width 1))
  405.         (draw-line theTile 0 (- icon-bottom-bar-width 1) 4 (- icon-bottom-bar-width 1))
  406.         (draw-line theTile 0 (- icon-bottom-bar-width 2) 4 (- icon-bottom-bar-width 2))
  407.         (draw-line theTile 0 3 4 3)
  408.  )
  409.  (with (foreground tSC)
  410.         (draw-line theTile 0 0 0 1)
  411.         (draw-line theTile 0 4 3 4)
  412.  )
  413.  (with (foreground (if active iconActiveBackground iconBackground))
  414.     (draw-line theTile 0 1 1 1)
  415.  )
  416.  )
  417. )
  418.  
  419.  
  420. (: icon-br-plug
  421.         (with (
  422.            cursor       frame-cursor
  423.            fsm          mwm-icon-frame-fsm
  424.                pixmap       (pixmap-make-icon-br ())
  425.                activepixmap (pixmap-make-icon-br t)
  426.                property     (list 'pixmap pixmap 'activepixmap activepixmap)
  427.                borderwidth  0
  428.               )
  429.         (plug-make pixmap)
  430.         )
  431. )
  432.  
  433. (de tile-make-icon-bottom-bar (active)
  434.  (with (tSC        (if active iconActiveTopShadowColor iconTopShadowColor)
  435.         bSC        (if active iconActiveBottomShadowColor iconBottomShadowColor)
  436.         foreground (if active iconActiveBackground iconBackground)
  437.         theTile    (pixmap-make 2 icon-bottom-bar-width)
  438.        )
  439.  (with (foreground tSC)
  440.         (draw-line theTile 0 0 1 0)
  441.         (draw-line theTile 0 4 1 4)
  442.  )
  443.  (with (foreground bSC)
  444.         (draw-line theTile 0 3 1 3)
  445.         (draw-line theTile 0 (- icon-bottom-bar-width 1) 1 (- icon-bottom-bar-width 1))
  446.         (draw-line theTile 0 (- icon-bottom-bar-width 2) 1 (- icon-bottom-bar-width 2))
  447.  )
  448.  )
  449. )
  450.  
  451. (: icon-tile-bottom-bar (tile-make-icon-bottom-bar ()))
  452. (: icon-active-tile-bottom-bar (tile-make-icon-bottom-bar t))
  453.  
  454.  
  455.  
  456. ; THE LABEL-PLUG :
  457. ; ==============
  458. (: icon-label-plug 
  459. '(with (borderwidth 0
  460.         fsm (fsm-make
  461.              (state-make
  462.                (on (user-event 'focus-in)
  463.                    (progn
  464.                          (: wob-background iconActiveBackground)
  465.                          (wob-tile (with (foreground iconActiveForeground)
  466.                                      (active-label-make (# 'theLabel wob) iconFontList)))
  467.                    ) )
  468.                (on (user-event 'focus-out)
  469.                    (progn
  470.                          (: wob-background iconBackground)
  471.                          (wob-tile (with (foreground iconForeground)
  472.                                      (active-label-make (# 'theLabel wob) iconFontList)))
  473.                    ) )
  474.                (on (user-event 'name-change)
  475.                    (progn
  476.              (## 'theLabel wob window-icon-name)
  477.                          (wob-tile
  478.                            (with (foreground 
  479.                     (if (= wob-background iconActiveBackground)
  480.                                                 iconActiveForeground iconForeground))
  481.                                 (active-label-make window-icon-name iconFontList))
  482.                         )
  483.                      )
  484.             ) 
  485.                 (on (buttonpress 1 alone)
  486.                   (progn
  487.             (if (= double-click-required window)
  488.             (progn
  489.                           (if (< (- (current-event-time)
  490.                     time-of-last-release)
  491.                  doubleClickTime)
  492.                   (send-user-event 'double-click 
  493.                            double-click-required)
  494.                 (do-binding-button 1 alone 'press '(icon))
  495.                 )
  496.                           (: double-click-required ())
  497.               )
  498.               (progn
  499.             (do-binding-button 1 alone 'press '(icon))
  500.             (: double-click-required ())
  501.             )
  502.               )
  503.             )
  504.           )
  505.             (on (buttonrelease 1 alone) 
  506.             (progn
  507.                (: double-click-required window)
  508.               (: time-of-last-release (current-event-time))
  509.               (icon-menu-open)
  510.             )
  511.         )
  512.             (do-bindings-state '(icon))
  513.         ))
  514.  
  515.               background iconBackground
  516.               foreground iconForeground
  517.               font iconFontList
  518.           property (list 'theLabel window-icon-name)
  519.           )
  520.  (plug-make (label-make window-icon-name)))
  521. )
  522.  
  523. (: icon-bottom-bar
  524.            (with (
  525.                cursor        frame-cursor
  526.                foreground    iconForeground
  527.                pixmap        icon-tile-bottom-bar
  528.                activepixmap  icon-active-tile-bottom-bar
  529.                property      (list 'pixmap pixmap 'activepixmap activepixmap)
  530.                  tile          pixmap
  531.                  fsm           mwm-icon-frame-fsm
  532.                   bar-min-width icon-bottom-bar-width
  533.            borderwidth   0
  534.                  )
  535.            (bar-make icon-bl-plug () icon-label-plug () icon-br-plug))
  536. )
  537.  
  538. (: focus-in-menu-name-bar
  539.  (with (
  540.     cursor        frame-cursor
  541.     tile          focus-in-menu-name-tile
  542.     fsm           () ;mwm-icon-frame-fsm
  543.     bar-min-width fimn-height
  544.     borderwidth   0
  545.     menu ()
  546.        )
  547.        (bar-make left-focus-in-menu-name-plug () icon-label-plug
  548.          () right-focus-in-menu-name-plug)
  549.  )
  550. )
  551.  
  552.  
  553. (df center-icon-blank-pixmap ()
  554.  (with (foreground iconImageBackground
  555.     MaxX (+ (# 0 iconImageMaximum) 1)
  556.     MaxY (+ (# 1 iconImageMaximum) 1)
  557.       theTile (pixmap-make (+ MaxX 1) (+ MaxY 1))
  558.        )
  559.   (with (foreground iconImageTopShadowColor)
  560.    (draw-line theTile 0    0    MaxX 0   )
  561.    (draw-line theTile 0    0    0    MaxY)
  562.   )
  563.   (with (foreground iconImageBottomShadowColor)
  564.    (draw-line theTile 0    MaxY MaxX MaxY)
  565.    (draw-line theTile MaxX 1    MaxX MaxY)
  566.   )
  567.  theTile
  568.  )
  569. )
  570.  
  571. (df anonymous-icon-pixmap ()
  572.  (pixmap-make iconImageBackground 
  573.               (center-icon-blank-pixmap) iconImageBackground
  574.           "X.xbm" iconImageForeground
  575.  )
  576. )
  577.  
  578.  
  579. ; Fsm of the center plug :
  580. (: icon-center-plug-fsm 
  581.  (fsm-make
  582.     (state-make
  583.      (on (user-event 'icon-pixmap-change)
  584.      (wob-tile
  585.       (with (iconImageBackground (color-make 
  586.                       (get-res-value 'iconImageBackground))
  587.          iconImageForeground (color-make
  588.                       (get-res-value 'iconImageForeground))
  589.              iconImageBottomShadowColor (color-make (get-res-value
  590.                          'iconImageBottomShadowColor))
  591.          iconImageTopShadowColor (color-make (get-res-value
  592.                       'iconImageTopShadowColor))
  593.          simple-icon-decoration.wip (window-icon-pixmap)
  594.                      )
  595.         (pixmap-make  iconImageBackground
  596.               (center-icon-blank-pixmap) iconImageBackground
  597.               simple-icon-decoration.wip iconImageBackground
  598.               ))))
  599.      (on (buttonpress 1 alone)
  600.      (progn
  601.        (if (= double-click-required window)
  602.            (progn
  603.          (if (< (- (current-event-time) time-of-last-release)
  604.             doubleClickTime)
  605.              (send-user-event 'double-click
  606.                       double-click-required)
  607.            (do-binding-button 1 alone 'press '(icon)))
  608.          (: double-click-required ()))
  609.          (progn
  610.            (do-binding-button 1 alone 'press '(icon))
  611.            (: double-click-required ())))))
  612.      (on (buttonrelease 1 alone) 
  613.     (progn
  614.       (: double-click-required window)
  615.       (: time-of-last-release (current-event-time))
  616.       (icon-menu-open)
  617.       )
  618.     )
  619.      (do-bindings-state '(icon))
  620.     )
  621.  )
  622. )
  623.  
  624. (: focus-in-menu-name-fsm
  625.  (fsm-make
  626.   (state-make 
  627.    (on (user-event 'test-in-menu-name)
  628.        (: in-menu-name (and (> x (- wob-x 1)) (> y (- wob-y 1))
  629.                 (< x (+ wob-x wob-width)) 
  630.                 (< y (+ wob-y wob-height))))
  631.        )
  632.    (on (user-event 'focus-out)
  633.        (unpop-menu))
  634.    (on leave-window 
  635.        (with (cmp (current-mouse-position) x (# 0 cmp) y (# 1 cmp))
  636.      ;(? "Leaving the blowup.")
  637.      (: in-icon ())
  638.      (send-user-event 'test-in-icon (# 'icon-father wob))
  639.      (if (not in-icon) (send-user-event 'leave-window))))
  640.    (on (buttonpress 1 alone)
  641.        (progn
  642.      (if (= double-click-required window)
  643.          (progn
  644.            (if (< (- (current-event-time) time-of-last-release)
  645.               doubleClickTime)
  646.                    (send-user-event 'double-click double-click-required)
  647.          (do-binding-button 1 alone 'press '(icon))
  648.          )
  649.            (: double-click-required ())
  650.            )
  651.        (progn
  652.          (: double-click-required ())
  653.          (do-binding-button 1 alone 'press '(icon))
  654.          )
  655.        )
  656.      )
  657.        )
  658.    (on (buttonrelease 1 alone)
  659.        (progn
  660.      (: double-click-required window)
  661.      (: time-of-last-release (current-event-time))
  662.      (icon-menu-open)
  663.      )
  664.        )
  665.    (do-bindings-state '(icon))
  666.    )
  667.   )
  668.  )
  669.  
  670. ; MWM-ICON.DATA :
  671. ; =============
  672. (: mwm-icon
  673.   '(with (
  674.        ; client specific resources :
  675.         iconImageBackground (color-make (get-res-value 
  676.                          'iconImageBackground))
  677.         iconImageForeground (color-make 
  678.                  (get-res-value 'iconImageForeground))
  679.         iconImageBottomShadowColor (color-make 
  680.                     (get-res-value 
  681.                      'iconImageBottomShadowColor))
  682.         iconImageTopShadowColor (color-make (get-res-value 
  683.                          'iconImageTopShadowColor))
  684.  
  685.         menu                       (eval (atom (get-res-value 'windowMenu)))
  686.         property                   (list 'X () 'Y ()
  687.                     'focus-in-menu-name
  688.                      (with (
  689.                             fsm focus-in-menu-name-fsm
  690.                             borderwidth 0
  691.                             menu ()
  692.                             cursor ()
  693.                             property ()
  694.                         bar-separator 0
  695.                            )
  696.                       (menu-make focus-in-menu-min-width-bar
  697.                             focus-in-menu-name-bar)
  698.                      )
  699.                     'focus-in-menu-name-placed ()
  700.                     )
  701.         grabs                      
  702.             (+ (# 1 (# 'icon keyBindings))
  703.                (# 'wgrabs (menu-wob menu))
  704.             )
  705.         cursor                     frame-cursor
  706.         background                 iconImageBackground 
  707.         foreground                 iconImageForeground 
  708.             borderwidth                0
  709.             simple-icon-decoration.wip (window-icon-pixmap)
  710.             tmp         (if (not (= (get-res-value 'iconImage) ""))
  711.                             (pixmap-make (get-res-value 'iconImage))
  712.                             ()
  713.                         )
  714.             fsm         icon-center-plug-fsm
  715.             center-plug 
  716.             (if (window-icon-window)
  717.                          (window-icon-window)
  718.                          simple-icon-decoration.wip
  719.                                (plug-make
  720.                                 (pixmap-make  iconImageBackground
  721.                                           (center-icon-blank-pixmap) iconImageBackground
  722.                                         simple-icon-decoration.wip iconImageBackground
  723.                                 )
  724.                                )
  725.                          tmp
  726.                          (plug-make (pixmap-make  iconImageBackground
  727.                                          (center-icon-blank-pixmap) iconImageBackground
  728.                                         tmp iconImageForeground
  729.                          ))
  730.                          (plug-make (anonymous-icon-pixmap))
  731.                          )
  732.  
  733.         fsm (mwm-icon-fsm)
  734.            )
  735.  
  736.           (window-make
  737.         icon-top-bar
  738.         icon-left-bar
  739.         icon-right-bar
  740.         icon-bottom-bar
  741.         center-plug
  742.     )
  743.     )
  744. )
  745.  
  746.  
  747. ; Cutting of the screen in boxes to tidy away icons :
  748. ; -------------------------------------------------
  749.  
  750. (: icon.size.width (+ (# 0 iconImageMaximum) 12))
  751. (: icon.size.height (+ (# 1 iconImageMaximum) 6 icon-bottom-bar-width))
  752.  
  753. (: nb-icons.w (/ screen-width (+ icon.size.width iconPlacementMargin)))
  754. (: nb-icons.h (/ screen-height (+ icon.size.height iconPlacementMargin)))
  755.  
  756. (: icon-box.w (+  icon.size.width iconPlacementMargin 
  757.           (/ (% screen-width (+ icon.size.width iconPlacementMargin))
  758.              nb-icons.w
  759. )))
  760. (: icon-box.h (+  icon.size.height iconPlacementMargin 
  761.           (/ (% screen-height (+ icon.size.height iconPlacementMargin))
  762.              nb-icons.h
  763. )))
  764. (: icon-array (list-make (* nb-icons.w nb-icons.h)))
  765. (: xmax (* icon-box.w (- nb-icons.w 1)))
  766. (: ymax (* icon-box.h (- nb-icons.h 1)))
  767.  
  768. ; Convert pixel-coords into array-coords :
  769. ; --------------------------------------
  770. (de xy-to-XY (x y)
  771.  (list
  772.   (if (> x xmax) (- nb-icons.w 1) (/ x icon-box.w))
  773.   (if (> y ymax) (- nb-icons.h 1) (/ y icon-box.h))
  774.  )
  775. )
  776.  
  777. ; Convert array-coords into pixel-coords :
  778. ; --------------------------------------
  779. (de XY-to-xy (X Y)
  780.  (list
  781.   (+ (* X icon-box.w) iconPlacementMargin)
  782.   (+ (* Y icon-box.h) iconPlacementMargin)
  783.  )
  784. )
  785.  
  786. ; Get the value (icon-wob) located at (X,Y) of the icon-array :
  787. ; -----------------------------------------------------------
  788. (de get-icon-from-array (X Y)
  789.  (if (or (< X 0)
  790.      (< Y 0)
  791.      (> X (- nb-icons.w 1))
  792.      (> Y (- nb-icons.h 1))
  793.      )
  794.  'out
  795.  (# (+ (* Y nb-icons.w) X) icon-array)
  796.  )
  797. )
  798.  
  799. ; Set the value (icon-wob) located at (X,Y) of the icon-array :
  800. ; -----------------------------------------------------------
  801. (de set-icon-of-array (X Y value)
  802.  (if (or (< X 0)
  803.      (< Y 0)
  804.      (> X (- nb-icons.w 1))
  805.      (> Y (- nb-icons.h 1))
  806.      )
  807.  'out
  808.  (## (+ (* Y nb-icons.w) X) icon-array value)
  809.  )
  810. )
  811.  
  812. ; Get the "icon-zone" :  top-left     = (-1 -1)
  813. ; -------------------    top-right    = (-1 +1)
  814. ;             bottom-left  = (+1 -1)
  815. ;             bottom-right = (+1 +1)
  816. (de areaInBoxCoords (x y)
  817.  (list
  818.   (if (> (% x icon-box.w) (/ icon-box.w 2)) 1 -1)
  819.   (if (> (% y icon-box.h) (/ icon-box.h 2)) 1 -1)
  820.  )
  821. )
  822.  
  823.  
  824. ; Get the neighbors of an "icon-box" in the icon-array,
  825. ; respencting the 'iconPlacement preferences :
  826. ; ------------------------------------------
  827. (de neighbors (x y)
  828.  (with (theBox    (xy-to-XY x y)
  829.     X         (# 0 theBox)
  830.     Y         (# 1 theBox)
  831.     areaInBox (areaInBoxCoords x y)
  832.     incX      (# 0 areaInBox)
  833.     incY      (# 1 areaInBox)
  834.     theSide   (# 1 iconPlacement)
  835.        )
  836.   (if (or (= theSide 'bottom) (= theSide 'top))
  837.     (list
  838.      (list (get-icon-from-array (+ X incX) Y) (+ X incX) Y)
  839.      (list (get-icon-from-array X (+ Y incY)) X (+ Y incY))
  840.     )
  841.     (list
  842.      (list (get-icon-from-array X (+ Y incY)) X (+ Y incY))
  843.      (list (get-icon-from-array (+ X incX) Y) (+ X incX) Y)
  844.     )
  845.   )
  846.  )
  847. )
  848.  
  849. (: right (list 'v (- nb-icons.w 1) 0 -1))
  850. (: left (list 'v 0 nb-icons.w 1))
  851. (: bottom (list 'h (- nb-icons.h 1) 0 -1))
  852. (: top (list 'h 0 nb-icons.h 1))
  853.  
  854. ; Get the first free box in the icon-array,
  855. ; respencting the 'iconPlacement preferences :
  856. ; ------------------------------------------
  857. (de auto-get-place ()
  858.  (with (
  859.     theSide           (eval (# 1 iconPlacement))
  860.     thePlace          (eval (# 0 iconPlacement))
  861.     theSide.index     (# 1 theSide)
  862.     theSide.inc       (# 3 theSide)
  863.     theSide.direction (# 0 theSide)
  864.     theSide.limit     (# 2 theSide)
  865.     theSide.test.limit 
  866.         (if (= 1 theSide.inc) 
  867.             (list '< 'theSide.index theSide.limit)
  868.             (list '> 'theSide.index (- theSide.limit 1))
  869.         )
  870.     thePlace.inc       (# 3 thePlace)
  871.     thePlace.direction (# 0 thePlace)
  872.     thePlace.limit     (# 2 thePlace)
  873.     thePlace.test.limit 
  874.         (if (= 1 thePlace.inc) 
  875.             (list '< 'thePlace.index thePlace.limit)
  876.             (list '> 'thePlace.index (- thePlace.limit 1))
  877.         )
  878.     theRes ()
  879.        )
  880.   (while (and (eval theSide.test.limit) (not theRes))
  881.    (with (thePlace.index (# 1 thePlace))
  882.     (while (and (eval thePlace.test.limit) (not theRes)) 
  883.      (with (
  884.         X       (if (= 'v theSide.direction) theSide.index thePlace.index)
  885.         Y       (if (= 'h theSide.direction) theSide.index thePlace.index)
  886.               theIcon (get-icon-from-array X Y)
  887.        )
  888.       (if (not theIcon) (: theRes (list X Y)))
  889.      )
  890.      (: thePlace.index (+ thePlace.index thePlace.inc))
  891.     )
  892.    )
  893.    (: theSide.index (+ theSide.index theSide.inc))
  894.   )
  895.  theRes
  896.  )
  897. )
  898.  
  899.  
  900.