home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / vb-bar.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  10KB  |  387 lines
  1. ; ======================================================================
  2. ;             BAR PACKAGE
  3. ; ======================================================================
  4.  
  5.  
  6. ; =========
  7. ; Utilities
  8. ; =========
  9.  
  10. ; Pixmap list creation 
  11.  
  12. (de pixmap-list-make (file-name suffixes make)
  13.     (with (res ())
  14.       (for i suffixes
  15.            (setq res (+ res
  16.                 (list ((eval make)  (+ file-name i))))))
  17.       res))
  18.  
  19. (setq suffixes.9. '( ".tl" ".t" ".tr"  ".l"  "."   ".r" ".bl" ".b" ".br"))
  20. (setq suffixes.8. '( ".tl" ".t" ".tr"  ".l"        ".r" ".bl" ".b" ".br"))
  21. (setq suffixes.3-vertical.   '( ".t" "." ".b"))
  22. (setq suffixes.3-horizontal. '( ".l" "." ".r"))
  23.  
  24. (setq suffixes.9_ '( "_tl" "_t" "_tr"  "_l"  "_"   "_r" "_bl" "_b" "_br"))
  25. (setq suffixes.8_ '( "_tl" "_t" "_tr"  "_l"        "_r" "_bl" "_b" "_br"))
  26. (setq suffixes.3-vertical_   '( "_t" "_" "_b"))
  27. (setq suffixes.3-horizontal_ '( "_l" "_" "_r"))
  28.  
  29.  
  30.  
  31. ; Does a list contains an item ?
  32.         
  33. (de contains-item (gwm.list gwm.item)
  34.     (if (not gwm.list)             ; empty list
  35.     ()
  36.     (if (= gwm.item (# 0 gwm.list))    ; it's first item
  37.         t
  38.         (contains-item         ; otherwise recursion
  39.         (sublist 1 (- (length gwm.list) 1) gwm.list)
  40.         gwm.item)
  41.     )))
  42.  
  43.  
  44. ; =============
  45. ; Some defaults
  46. ; =============
  47.  
  48. (setq bar.default-pixmap (label-make "X"))
  49.  
  50.  
  51.  
  52. ; =============
  53. ; Main function     bar.make
  54. ; =============
  55.  
  56. ; Context:
  57. ;     bar.plugs
  58. ;     bar.focus-sensitive        t or ()  change aspect if focus in ?
  59. ;     bar.borderwidth        borderwidth default 0
  60. ;     borderpixel
  61. ;     bordertile
  62. ;     plug-separator
  63. ;     menu
  64. ;     cursor
  65. ;     property            (appended for intern usage)
  66. ;     bar-min-width            (may be increased)
  67. ;     bar-max-width            (may be decreased)
  68. ;     bar.size-adjust-on        'plugs (default) or 'pixmap 
  69. ; 
  70. (de bar.make()
  71.     (with(
  72.       bar.appearance-make (default bar.appearance-make 
  73.                   bar.color-appearance-make)
  74.       bar.focus-sensitive (default bar.focus-sensitive t)
  75.       fsm (if bar.focus-sensitive 
  76.           bar.focus-sensitive-fsm
  77.           bar.focus-insensitive-fsm)
  78.       bar.size-adjust-on (default bar.size-adjust-on 'plugs)
  79.       
  80.       
  81.       ; ---------------------------------------------------
  82.       ; And we duplicate some variable wich may be modified 
  83.       ; by bar.appearance-make to avoid border effects
  84.       ; ---------------------------------------------------
  85.       borderwidth (default bar.borderwidth 0)    
  86.       property     (default property ())        
  87.       bar-min-width (max 1(default bar-min-width 1))
  88.       bar-max-width (default bar-max-width 100)    
  89.       bar.plugs     (default bar.plugs ())        
  90.      )
  91.      (if (boundp 'bar.thickness) 
  92.          (progn 
  93.             (setq bar-min-width bar.thickness)
  94.             (setq bar-max-width bar.thickness)))
  95.      (bar.appearance-make)        
  96.      
  97.      ; border effect on property, bar-min-width, and bar-max-width
  98.      (setq property (+ property (list 'initializer bar.initializer)))
  99.      
  100.      (eval (+ '(bar-make) bar.plugs))))
  101.  
  102.  
  103.  
  104. (setq bar.focus-sensitive-behaviour
  105.     (state-make
  106.     (on (user-event 'initialize)
  107.         (eval (# 'initializer wob-property)))
  108.     (on (user-event 'focus-in)
  109.         (eval (# 'active-drawer wob-property)))
  110.     (on (user-event 'focus-out)
  111.         (eval (# 'normal-drawer wob-property)))))
  112. (setq bar.focus-sensitive-fsm (fsm-make bar.focus-sensitive-behaviour))
  113.  
  114. (setq bar.focus-insensitive-behaviour
  115.     (state-make
  116.     (on (user-event 'initialize)
  117.         (eval (# 'initializer wob-property)))))
  118. (setq bar.focus-insensitive-fsm (fsm-make bar.focus-insensitive-behaviour))
  119.  
  120. (setq bar.initializer 
  121.     '(eval (# 'normal-drawer wob-property)))
  122.  
  123.  
  124.  
  125.  
  126. ; ====================
  127. ; Appearance functions
  128. ; ====================
  129. ; 
  130. ; All these functions override some context variables
  131. ; but doesn't retrun any value
  132.  
  133.  
  134. ; Appareance described by color
  135. ; -----------------------------
  136. ; 
  137. ; Context:
  138. ;     bar.normal-color
  139. ;     bar.active-color    if bar.focus-sensitive is true
  140. ; Border effects on context variable: 
  141. ;    property
  142. ; 
  143. (de bar.color-appearance-make()
  144.     (with (
  145.        bar.normal-color (default bar.normal-color background)
  146.        bar.active-color (default bar.active-color foreground)
  147.       )
  148.       ; BORDER EFFECTS
  149.       (setq property
  150.         (+ (list 'normal-drawer
  151.              (list 'wob-background bar.normal-color))
  152.            (if bar.focus-sensitive
  153.                (list 'active-drawer
  154.                  (list 'wob-background bar.active-color))
  155.                ())
  156.            property
  157.         ))))
  158.  
  159.  
  160. ; Appareance described by pixmap
  161. ; ------------------------------
  162. ; 
  163. ; Context
  164. ;     bar.normal-pixmap
  165. ;     bar.active-pixmap    if bar.focus-sensitive is true
  166. ;    bar.orientation        'vertical  or  'horizontal (default) 
  167. ; Border effects on context variables:
  168. ;    property
  169. ;     bar-min-width    (only increase)
  170. ;     bar-max-width    (only decrease)
  171. ;     borderwidth      (set to 0)
  172. ; 
  173. (de bar.pixmap-appearance-make()
  174.     (with (
  175.        bar.normal-pixmap (default bar.normal-pixmap bar.default-pixmap)
  176.        bar.active-pixmap (default bar.active-pixmap bar.default-pixmap)
  177.        bar.orientation   (default bar.orientation 'horizontal)
  178.        thickness (if (= 'horizontal bar.orientation)
  179.              (height bar.normal-pixmap)
  180.              (width bar.normal-pixmap))
  181.       )
  182.       ; BORDER EFFECTS
  183.       (setq borderwidth 0)
  184.       (setq property
  185.         (+ (list 'normal-drawer
  186.              (list 'wob-tile bar.normal-pixmap))
  187.            (if bar.focus-sensitive
  188.                (list 'active-drawer
  189.                  (list 'wob-tile bar.active-pixmap))
  190.                ())
  191.            property           
  192.         ))
  193.       (if (= 'pixmap bar.size-adjust-on)
  194.           (progn
  195.             (setq bar-min-width (max bar-min-width thickness))
  196.             (setq bar-max-width (min bar-max-width thickness))))
  197.     ))
  198.  
  199.  
  200. ; Appareance described by 3 pixmap (a stretchable center and 2 borders)
  201. ; --------------------------------
  202. ; 
  203. ; Context:
  204. ;     bar.normal-pixmap-list
  205. ;     bar.active-pixmap-list
  206. ;     bar.focus-sensitive
  207. ; Border effect on:
  208. ;     property
  209. ;     bar-min-width
  210. ;     bar-max-width
  211. ;     bar.plugs
  212. ; 
  213. (de bar.3-pixmaps-appearance-make ()
  214.     (with (
  215.        ; context treatment
  216.        bar.normal-pixmap-list
  217.        (if (and (boundp 'bar.normal-pixmap-list)
  218.             (= 3 (length bar.normal-pixmap-list)))
  219.            bar.normal-pixmap-list
  220.            (progn
  221.              (? "Warning: bar.normal-pixmap-list incorrect, "
  222.             bar.normal-pixmap-list "\n")
  223.              bar.default-normal-pixmap-list))
  224.        
  225.        bar.active-pixmap-list
  226.        (if bar.focus-sensitive
  227.            (if (and (boundp 'bar.active-pixmap-list)
  228.             (= 3 (length bar.active-pixmap-list)))
  229.            bar.active-pixmap-list
  230.            (progn
  231.              (? "Warning: bar.active-pixmap-list incorrect, "
  232.                 bar.active-pixmap-list "\n")
  233.              bar.normal-pixmap-list)))
  234.        
  235.        ; intern variables
  236.        bar.normal-pixmap (# 1 bar.normal-pixmap-list)
  237.        bar.active-pixmap (# 1 bar.active-pixmap-list)
  238.       ) 
  239.       ; BORDER EFFECTS
  240.       (setq bar.plugs
  241.         (+ 
  242.            ; A plug for the first edge
  243.            (with (
  244.               normal-pixmap (# 0 bar.normal-pixmap-list)
  245.               active-pixmap (if bar.focus-sensitive
  246.                         (# 0 bar.active-pixmap-list)
  247.                         ())
  248.              )
  249.              (list (bar.plug-make)))
  250.            
  251.            ; The plugs of user
  252.            bar.plugs
  253.            
  254.            ; If necessary a space to make sure that 
  255.            ; the last plug will be on the right (or bottom)
  256.  
  257.            (if (member () bar.plugs)  ; (contains-item bar.plugs ())
  258.                ()
  259.                '(()))
  260.            
  261.            ; A plug for the last edge
  262.            (with (
  263.               normal-pixmap (# 2 bar.normal-pixmap-list)
  264.               active-pixmap (if bar.focus-sensitive
  265.                         (# 2 bar.active-pixmap-list)
  266.                         ())
  267.              )
  268.              (list (bar.plug-make)))
  269.         ))
  270.       (bar.pixmap-appearance-make)
  271.     )))
  272.  
  273.  
  274.  
  275. (setq bar.default-normal-pixmap-list 
  276.     (list bar.default-pixmap bar.default-pixmap bar.default-pixmap))
  277.  
  278. ; Context:
  279. ;     bar.focus-sensitive
  280. ;     normal-pixmap
  281. ;     active-pixmap
  282. (de bar.plug-make ()
  283.     (with (
  284.        fsm bar.plug-fsm
  285.        borderwidth 0
  286.        property (if bar.focus-sensitive
  287.             (list
  288.                  'normal-drawer
  289.                  (list 'wob-tile normal-pixmap)
  290.                  'active-drawer
  291.                  (list 'wob-tile active-pixmap)
  292.             )
  293.             ())
  294.       )
  295.       (plug-make normal-pixmap)
  296.     ))
  297.   
  298. (setq bar.plug-behaviour
  299.     (state-make             
  300.     (on (user-event 'focus-out) (eval (# 'normal-drawer wob-property)))
  301.     (on (user-event 'focus-in) (eval (# 'active-drawer wob-property)))))
  302.  
  303. (setq bar.plug-fsm (fsm-make bar.plug-behaviour))
  304.  
  305.  
  306.  
  307.  
  308. ; Appareance described by the prefix name of 3 pixmap 
  309. ; ---------------------------------------------------
  310. ; (a stretchable center and 2 borders)
  311. ; 
  312. ; Context:
  313. ;     bar.normal-pixmap-file-name
  314. ;     bar.active-pixmap-file-name
  315. ;     bar.orientation        'vertical or 'horizontal
  316. ;     bar.suffixes        for instance: '( "_l"  "_"  "_r")
  317. ;     bar.pixmap-make        default: pixmap-make
  318. ;     bar.focus-sensitive
  319. ; Border effect on:
  320. ;     property
  321. ;     bar-min-width
  322. ;     bar-max-width
  323. ;     bar.plugs
  324. ; 
  325. (de bar.3-pixmap-files-appearance-make ()
  326.     (with (
  327.        bar.normal-pixmap-file-name (default bar.normal-pixmap-file-name 
  328.                        "default")
  329.        bar.active-pixmap-file-name (default bar.active-pixmap-file-name 
  330.                        "default")
  331.        bar.orientation (default bar.orientation 'horizontal)
  332.        bar.suffixes (default bar.suffixes
  333.                 (if (= 'vertical bar.orientation)
  334.                 suffixes.3-vertical_
  335.                 suffixes.3-horizontal_ ))
  336.        bar.pixmap-make (default bar.pixmap-make pixmap-make)
  337.        
  338.        ; local variables
  339.        bar.normal-pixmap-list (pixmap-list-make
  340.                       bar.normal-pixmap-file-name
  341.                       bar.suffixes
  342.                       bar.pixmap-make)
  343.        bar.active-pixmap-list (if bar.focus-sensitive
  344.                       (pixmap-list-make
  345.                       bar.active-pixmap-file-name
  346.                       bar.suffixes
  347.                       bar.pixmap-make)
  348.                       ())
  349.       )
  350.       (bar.3-pixmaps-appearance-make)
  351.     ))
  352.  
  353.  
  354. ; Appareance described by the prefix name of 3 pixmap 
  355. ; ---------------------------------------------------
  356. ; (a stretchable center and 2 borders)
  357. ; As bar.3-pixmap-files-appearance-make    but use paxmap-make and other suffixes
  358. ;           ^                                    ^
  359. ;           |                                    |
  360. ; 
  361. ; Context:
  362. ;     bar.normal-pixmap-file-name
  363. ;     bar.active-pixmap-file-name
  364. ;     bar.orientation        'vertical or 'horizontal
  365. ;     bar.suffixes        default: '( ".l"  "."  ".r")
  366. ;     bar.focus-sensitive
  367. ; Border effect on:
  368. ;     property
  369. ;     bar-min-width
  370. ;     bar-max-width
  371. ;     bar.plugs
  372. ; 
  373. (de bar.3-paxmap-files-appearance-make ()
  374.     (with (
  375.        bar.orientation (default bar.orientation 'horizontal)
  376.        bar.suffixes (default bar.suffixes
  377.                 (if (= 'vertical bar.orientation)
  378.                 suffixes.3-vertical.
  379.                 suffixes.3-horizontal. ))
  380.        bar.pixmap-make paxmap-make
  381.       )
  382.       (bar.3-pixmap-files-appearance-make)))
  383.     
  384. ; ======================================================================
  385.  
  386. (provide 'vb-bar)
  387.