home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / vtwm-window.gwm < prev    next >
Text File  |  1995-07-03  |  13KB  |  424 lines
  1. ;; vtwm-window.gwm --- Default windows and icons for VTWM profile.
  2. ;;
  3. ;; Author: Anders Holst  (aho@sans.kth.se)  
  4. ;; Copyright (C) 1995  Anders Holst
  5. ;; Version: vtwm-1.0
  6. ;; Last change: 31/5 1995
  7. ;;
  8. ;; This file is copyrighted under the same terms as the rest of GWM
  9. ;; (see the X Inc license for details). There is no warranty that it
  10. ;; works. 
  11. ;;
  12. ;; --------------------------------------------------------------------- 
  13. ;;
  14. ;; This file defines the normal windows and icons for the VTWM profile.
  15. ;;
  16. ;; This file is highly inspired by, and in large parts stolen
  17. ;; directly from, the file "twm-titled-win.gwm" by Arup Mukherjee.
  18. ;; 
  19.  
  20. (declare-screen-dependent
  21.     vtwm-borderwidth
  22.     vtwm-bordercolor
  23.     vtwm-active-bordercolor
  24.     vtwm-title-background
  25.     vtwm-title-foreground
  26.     vtwm-title-font
  27.     vtwm-icon-foreground
  28.     vtwm-icon-background
  29.     vtwm-fancy-colors
  30.     vtwm-notitle-list
  31.     vtwm-left-plugs
  32.     vtwm-right-plugs
  33.     iconify-pixmap-name
  34.     resize-pixmap-name
  35.     hilite-pixmap-name
  36.     default-icon-pixmap-name
  37. )
  38.  
  39. ;;
  40. ;;    USER CUSTOMIZABLE VARIABLES
  41. ;;    ---------------------------  
  42. ;;    Adjust these in your own profile
  43. ;;
  44. (for screen (list-of-screens)
  45.      (defaults-to
  46.        vtwm-borderwidth 2             ; Borderwidth of most windows
  47.        vtwm-bordercolor black         ; Color of border (inactive window)
  48.        vtwm-active-bordercolor white  ; Color of active window border
  49.        vtwm-title-background white    ; Default background of titlebar
  50.        vtwm-title-foreground black    ; Default foreground of titlebar
  51.        vtwm-title-font (font-make "9x15")   ; Font in titlebar
  52.        vtwm-icon-foreground black     ; Default background of icons
  53.        vtwm-icon-background white     ; Default foreground of icons
  54.        vtwm-fancy-colors ()           ; List of (wintype fg bg) specifications
  55.        vtwm-notitle-list '(Gwm (window-is-transient-for)) ; Untitled windows
  56.        default-icon-pixmap-name ()    ; Pixmap filename for default icon
  57.        hilite-pixmap-name "gray"      ; Filename for active titlebar pattern
  58.        vtwm-left-plugs '(("iconify2" (iconify-window)))
  59.        vtwm-right-plugs '(("resize2" (twm-resize-window) t))
  60.            ; Left and right plugs in the titlebar, a list of pairs
  61.            ; or tripplets:  ( <pixmap-file> <action> [<on-press>] )
  62.            ; The optional third element <on-press> signals that the action
  63.            ; should be run on button-press, rather than button-release.
  64.        )
  65. )
  66.  
  67. ;; 
  68. ;;    USER CUSTOMIZABLE BEHAVIORS
  69. ;;    ---------------------------
  70. ;;    Adjust these in your own profile
  71. ;;    
  72.  
  73. (if (not (boundp 'standard-title-behavior))
  74.     (: standard-title-behavior
  75.        ()))
  76.  
  77. (if (not (boundp 'window-behavior))
  78.     (: window-behavior
  79.        ()))
  80.  
  81. (if (not (boundp 'icon-behavior))
  82.     (: icon-behavior
  83.        (state-make
  84.            (on (buttonpress any alone) (iconify-window))
  85.            )))
  86.  
  87. (if (not (boundp 'standard-behavior))
  88.     (: standard-behavior
  89.        (state-make
  90.            (on (buttonpress 1 any) (raise-lower-move-window))
  91.            (on (buttonpress 2 any) (move-window))
  92.            (on (buttonpress 3 any) (lower-window))
  93.            )))
  94.  
  95.  
  96. ;;--------------------------------------------------------------------------
  97. ;;   End of user customizable things. Here starts the real code.
  98. ;;--------------------------------------------------------------------------
  99.  
  100.  
  101. ;; VTWM Titled Window
  102.  
  103. (: vtwm-window-behavior
  104.     (state-make
  105.     (on name-change 
  106.             (progn
  107.               (send-user-event 'name-change)
  108.               (icon-mgr-update)
  109.               (if (window-icon?)
  110.                   (send-user-event 'icon-name-change window-icon))))
  111.         (on focus-in
  112.             (progn 
  113.               (if autoraise (raise-window))
  114.               (send-user-event 'focus-in)
  115.               (wob-borderpixel vtwm-active-bordercolor)
  116.               (icon-mgr-focusin)))
  117.         (on focus-out
  118.             (progn 
  119.               (send-user-event 'focus-out)
  120.               (wob-borderpixel vtwm-bordercolor)
  121.               (icon-mgr-focusout)))
  122.     (on enter-window 
  123.             (if (not autofocus)
  124.                 (if autoraise (raise-window))
  125.               (progn (if autoraise (raise-window))
  126.                      (set-focus)
  127.                      (if autocolormap (set-colormap-focus)))))
  128.     (on leave-window (if autofocus
  129.                              (set-focus ())))
  130.     (on (property-change "WM_ICON_NAME")
  131.             (progn
  132.               (icon-mgr-update)
  133.               (if (window-icon?)
  134.                   (send-user-event 'icon-name-change window-icon))))
  135.     (on window-icon-pixmap-change 
  136.         (if (window-icon?)
  137.         (send-user-event 'icon-pixmap-change window-icon)))
  138.         ))
  139.  
  140. (defun vtwm-get-color ()
  141.   (if vtwm-fancy-colors
  142.       (with (wob window-window)
  143.         (matches-cond vtwm-fancy-colors))))
  144.  
  145. (defun vtwm-hilite-pixmap ()
  146.   (or (# 'hp wob)
  147.       (# 'hp (## 'hp wob
  148.                (pixmap-make vtwm-title-background
  149.                             hilite-pixmap-name
  150.                             vtwm-title-foreground)))))
  151.  
  152. (defun vtwm-no-hilite-pixmap ()
  153.   (or (# 'np wob)
  154.       (# 'np (## 'np wob
  155.                (pixmap-make vtwm-title-background
  156.                             hilite-pixmap-name
  157.                             vtwm-title-background)))))
  158.  
  159. (defun vtwm-titlebar-plug (pixmap-file expr press)
  160.   (with (pixmap (if (= (type pixmap-file) 'pixmap)
  161.                     pixmap-file
  162.                   (pixmap-make vtwm-title-background
  163.                                (eval pixmap-file)
  164.                                vtwm-title-foreground))
  165.          fsm (if (= (type expr) 'fsm)
  166.                  expr
  167.                (fsm-make 
  168.                  (state-make
  169.                    (eval (list 'on
  170.                                (if press 
  171.                                    '(buttonpress any alone)
  172.                                  '(buttonrelease any alone))
  173.                                expr)))))
  174.          borderwidth 0
  175.          background vtwm-title-background)
  176.     (plug-make pixmap)))
  177.  
  178. (defun vtwm-make-pluglist (lst)
  179.   (mapfor ele lst
  180.     (vtwm-titlebar-plug (# 0 ele) (# 1 ele) (# 2 ele))))
  181.  
  182. (: vtwm-name-fsm  
  183.     (fsm-make 
  184.        (state-make
  185.          (on (user-event 'name-change)
  186.              (progn
  187.                (with (borderwidth 0 
  188.               background (or (# 'bg wob-parent) vtwm-title-background)
  189.                       foreground (or (# 'fg wob-parent) vtwm-title-foreground)
  190.                       font vtwm-title-font
  191.                       label-horizontal-margin 6
  192.                       label-vertical-margin 1)
  193.                  (wob-tile (label-make window-name)))
  194.                )))))
  195.  
  196. (defun vtwm-name-plug ()
  197.   (with (background vtwm-title-background 
  198.          foreground vtwm-title-foreground
  199.          font vtwm-title-font
  200.          fsm vtwm-name-fsm
  201.          borderwidth 0 
  202.          label-horizontal-margin 6
  203.          label-vertical-margin 1)
  204.     (plug-make (label-make window-name))))
  205.  
  206. (defun vtwm-space-plug (wdt)
  207.   (with (background vtwm-title-background 
  208.          foreground vtwm-title-background
  209.          borderwidth 0
  210.          bar-min-width wdt
  211.          fsm ())
  212.     (bar-make )))
  213.         
  214.     
  215. (: vtwm-titlebar-behavior 
  216.    (state-make
  217.     (on (user-event 'focus-in)
  218.         (wob-borderpixel vtwm-active-bordercolor))
  219.     (on (user-event 'focus-out)
  220.         (wob-borderpixel vtwm-bordercolor))))
  221.     
  222. (defun vtwm-titlebar-fsm  ()
  223.   (fsm-make
  224.     (state-make
  225.      vtwm-titlebar-behavior
  226.      standard-title-behavior)))
  227.  
  228. (: vtwm-titlebar-inner-behavior
  229.    (state-make
  230.     (on (user-event 'focus-in)
  231.         (with (vtwm-title-background (or (# 'bg wob) vtwm-title-background)
  232.                vtwm-title-foreground (or (# 'fg wob) vtwm-title-foreground))
  233.           (wob-tile (vtwm-hilite-pixmap))))
  234.     (on (user-event 'focus-out)
  235.         (with (vtwm-title-background (or (# 'bg wob) vtwm-title-background)
  236.                vtwm-title-foreground (or (# 'fg wob) vtwm-title-foreground))
  237.           (wob-tile (vtwm-no-hilite-pixmap))))
  238.     ))
  239.  
  240. (defun vtwm-titlebar-inner-fsm  ()
  241.   (fsm-make
  242.      vtwm-titlebar-inner-behavior))
  243.  
  244.     
  245. (defun vtwm-middle-bar ()
  246.   (with (borderwidth 0
  247.          property ()
  248.          background vtwm-title-background
  249.          fsm ())
  250.     (bar-make (bar-make (vtwm-space-plug 5)
  251.                         (vtwm-name-plug) 
  252.                         (vtwm-space-plug 3)
  253.                         (bar-make (with (borderwidth 3
  254.                                          borderpixel vtwm-title-background
  255.                                          fsm (vtwm-titlebar-inner-fsm))
  256.                                     (bar-make ())))
  257.                         (vtwm-space-plug 3)))))
  258.  
  259. (defun vtwm-titlebar ()
  260.   (with (borderwidth vtwm-borderwidth
  261.          cols (vtwm-get-color)
  262.          vtwm-title-foreground (or (# 0 cols) vtwm-title-foreground)
  263.          vtwm-title-background (or (# 1 cols) vtwm-title-background)
  264.          property (+ (list 'fg vtwm-title-foreground
  265.                            'bg vtwm-title-background)
  266.                      property)
  267.          background vtwm-title-background
  268.          fsm (vtwm-titlebar-fsm) 
  269.          plug-separator 0
  270.          borderpixel vtwm-bordercolor
  271.          bar-min-width 1 bar-max-width 30
  272.          bar-list (+ (vtwm-make-pluglist vtwm-left-plugs)
  273.                      (list (vtwm-middle-bar))
  274.                      (vtwm-make-pluglist vtwm-right-plugs)))
  275.     (apply bar-make bar-list)))
  276.  
  277. (: vtwm-borderbar-behavior
  278.    (state-make
  279.       (on (user-event 'focus-in)
  280.           (wob-background vtwm-active-bordercolor))
  281.       (on (user-event 'focus-out)
  282.           (wob-background vtwm-bordercolor))))
  283.  
  284. (defun vtwm-borderbar-fsm ()
  285.   (fsm-make
  286.     (state-make
  287.      vtwm-borderbar-behavior
  288.      standard-title-behavior)))
  289.  
  290. (defun vtwm-borderbar ()
  291.   (with (borderwidth 0
  292.          background vtwm-bordercolor
  293.          fsm (vtwm-borderbar-fsm)
  294.          plug-separator 0
  295.          bar-min-width vtwm-borderwidth
  296.          bar-max-width vtwm-borderwidth)
  297.     (bar-make )))
  298.  
  299. (defun vtwm-titled-window-fsm ()
  300.   (fsm-make
  301.     (state-make
  302.      window-behavior
  303.      standard-behavior
  304.      vtwm-window-behavior
  305.      )))
  306.  
  307. (defun vtwm-titled-window ()
  308.   (with (inner-borderwidth 0
  309.          borderwidth 0
  310.          fsm (vtwm-titled-window-fsm)
  311.          borderpixel vtwm-bordercolor)
  312.     (window-make (vtwm-titlebar)
  313.                  (vtwm-borderbar)
  314.                  (vtwm-borderbar)
  315.                  (vtwm-borderbar)
  316.                  ())))
  317.  
  318.  
  319. ;; VTWM Simple Window
  320.  
  321. (defun vtwm-simple-window-fsm ()
  322.   (fsm-make
  323.     (state-make
  324.      window-behavior
  325.      standard-behavior
  326.      vtwm-window-behavior
  327.      )))
  328.  
  329. (defun vtwm-simple-window ()
  330.   (with (inner-borderwidth 0
  331.          borderwidth vtwm-borderwidth
  332.          fsm (vtwm-simple-window-fsm)
  333.          borderpixel vtwm-bordercolor)
  334.     (window-make () () () () ())))
  335.  
  336.  
  337. ;; VTWM Simple Icon
  338.  
  339. (: vtwm-icon-behavior
  340.     (state-make
  341.       ()  ; Nothing, as for now. Most things are handled from the window.
  342.       ))
  343.  
  344. (defun vtwm-smart-icon-name ()
  345.   (if (= window-icon-name "icon") ; Means that no icon name was specified
  346.       window-name
  347.     window-icon-name))
  348.  
  349. (defun vtwm-simple-icon-fsm ()
  350.   (fsm-make
  351.     (state-make
  352.      icon-behavior
  353.      standard-behavior
  354.      vtwm-icon-behavior
  355.      )))
  356.  
  357. (: vtwm-icon-label-fsm
  358.    (fsm-make
  359.      (state-make
  360.        (on (user-event 'icon-name-change)
  361.            (with (foreground vtwm-icon-foreground
  362.                   background vtwm-icon-background)
  363.              (wob-tile (label-make (vtwm-smart-icon-name))))))))
  364.  
  365. (: vtwm-icon-pixmap-fsm
  366.    (fsm-make
  367.      (state-make
  368.        (on (user-event 'icon-pixmap-change)
  369.            (with (foreground vtwm-icon-foreground
  370.                   background vtwm-icon-background)
  371.              (wob-tile (window-icon-pixmap)))))))
  372.  
  373. (defun vtwm-icon-get-plug ()
  374.   (or (window-icon-window)
  375.       (with (foreground vtwm-icon-foreground
  376.              background vtwm-icon-background
  377.              borderwidth 0
  378.              pm ()
  379.              fsm vtwm-icon-pixmap-fsm)
  380.         (if (setq pm (std-resource-get 'GwmIconPixmap))
  381.             (plug-make (pixmap-make pm))
  382.           (setq pm (window-icon-pixmap))
  383.             (plug-make pm)
  384.           default-icon-pixmap-name
  385.             (plug-make (pixmap-make default-icon-pixmap-name))
  386.             ()))))
  387.  
  388. (defun vtwm-icon-get-label ()
  389.   (with (foreground vtwm-icon-foreground
  390.          background vtwm-icon-background
  391.          borderwidth 0
  392.          fsm vtwm-icon-label-fsm)
  393.     (plug-make (label-make (vtwm-smart-icon-name)))))
  394.  
  395. (defun vtwm-simple-icon ()
  396.   (with (borderwidth 0
  397.          inner-borderwidth vtwm-borderwidth
  398.          cols (vtwm-get-color)
  399.          vtwm-icon-foreground (or (# 0 cols) vtwm-icon-foreground)
  400.          vtwm-icon-background (or (# 1 cols) vtwm-icon-background)
  401.          foreground vtwm-icon-foreground
  402.          background vtwm-icon-background
  403.          borderpixel vtwm-bordercolor
  404.          fsm (vtwm-simple-icon-fsm)
  405.          center-plug (vtwm-icon-get-plug)
  406.          label-plug (vtwm-icon-get-label))
  407.     (if center-plug
  408.         (with (tile t)
  409.           (window-make ()
  410.                        (bar-make ())
  411.                        (bar-make ())
  412.                        (bar-make () label-plug ())
  413.                        center-plug))
  414.       (window-make () () () () label-plug))))
  415.  
  416.  
  417. ;; VTWM Window 
  418.  
  419. (defun vtwm-window ()
  420.   (if (matches-list vtwm-notitle-list)
  421.       (vtwm-simple-window)
  422.     (vtwm-titled-window)))
  423.  
  424.