;; fvwm-window.gwm --- FVWM style windows.
;;
;; Author: Anders Holst  (aho@sans.kth.se)  
;; Copyright (C) 1996  Anders Holst
;; Last change: 14/8 1996
;;
;; This file is copyrighted under the same terms as the rest of GWM
;; (see the X Inc license for details). There is no warranty that it
;; works. 
;;
;; ---------------------------------------------------------------------
;;
;; This file defines a FVWM style window that should work together with
;; (at least) the standard profile and the VTWM profile in GWM.
;;
;; It may not be a complete FVWM window, but I think it is quite close.
;; 
;; This window style cooperates with (but does not require) the virtual
;; screen package. If you use a specific color for "nailed" ("sticky")
;; windows, you should call 'fvwm-nail-window', 'fvwm-unnail-window' and
;; 'fvwm-toggle-nail-window' instead of the corresponding functions in
;; the virtual package.
;; In general, since it is possible to specify any strange conditions on
;; what colors a window should have, the function `fvwm-update-color'
;; could be called for a window whenever these conditions have changed
;; for it.
;;
;; NOTE: This window style consumes bitmaps. There is a huge number of
;; bitmaps involved for each window, and since each window can have its
;; own proportions and colors, bitmaps are not shared between windows.
;; 
;; You probably want to change the variables under "USER CUSTOMIZABLE
;; VARIABLES", so copy them to your own profile and set them there.
;; 

(declare-screen-dependent
    fvwm-left-plugs
    fvwm-right-plugs
    fvwm-corner-action
    fvwm-side-action
    fvwm-border-action
    fvwm-title-action
    fvwm-color  
    fvwm-active-color
    fvwm-title-color
    fvwm-active-title-color
    fvwm-title-font
    fvwm-title-width
    fvwm-frame-width
    fvwm-corner-size
    fvwm-inner-border
    fvwm-outer-border
    fvwm-has-frame
    fvwm-has-resize
    fvwm-has-title
    fvwm-wide-shadow
    fvwm-color-styles
    fvwm-window-styles
    fvwm-virtual-colors
)

;;
;;    USER CUSTOMIZABLE VARIABLES
;;    ---------------------------  
;;    Adjust these in your own profile
;;
(with (wob wob)
  (for screen (list-of-screens)
     (defaults-to
       fvwm-color "tan"                  ; Main color of window
       fvwm-active-color "palevioletred" ; Color when in focus, as above if ()
       fvwm-title-color "black"          ; Color of title text
       fvwm-active-title-color ()        ; Color of text when in focus
       fvwm-title-font (font-make "6x13bold")  ; Font of title text
       fvwm-title-width ()         ; Title width. If (), set from font.
       fvwm-frame-width 6          ; Frame width.
       fvwm-corner-size ()         ; Resize corner size. If (), set automatic.
       fvwm-has-frame t            ; Window has border or resize handles
       fvwm-has-resize t           ; Window has resize handles
       fvwm-has-title t            ; Window has title bar
       fvwm-wide-shadow ()         ; Slightly wider shadows around title bar
       fvwm-inner-border -1        ; Use of inner border
       fvwm-outer-border ()        ; Use of outer border
       fvwm-left-plugs '((horizontal-rectangle (fvwm-pop-menu window-pop) press))
       fvwm-right-plugs '((up-triangle (zoom-window))
                          (down-triangle (iconify-window) release))
           ; Left and right plugs in the titlebar, a list of pairs
           ; or triplets:  ( <button-graphic> <action> [<action-type>] )
           ; The optional third element <action-type> can be `press' or
           ; `release', if the action should be all done on the button press
           ; (good for menus) or executed on the button release (good for
           ; eg. iconification and deletion of the window).
           ; Possible graphics are: small-square, medium-square,
           ; large-square, horizontal-rectangle, vertical-rectangle,
           ; medium-circle, medium-diamond, down-triangle, and up-triangle.
           ; Check how these are defined if you like to do your own.
       fvwm-border-action '(move-window)
       fvwm-corner-action '(fvwm-resize-window)
       fvwm-side-action '(fvwm-resize-window)
       fvwm-title-action '(raise-lower-move-window)
           ; Actions to execute when pressing the border, the resize corner,
           ; the resize side, or the title bar.
           ; These actions, and the <action> components for the left and right
           ; plugs above, can actually also be lists of pairs or triplets:
           ; ( <button-spec> <action> [<action-type>] ), where <button-spec>
           ; is a mouse button number or a list with a mouse button number
           ; followed by any number of modifiers.
       fvwm-color-styles '(((virtual-nailed) "palegreen")
                           (XTerm "grey")
                           (Emacs "lightblue"))
           ; List of (<win-spec> <color> <active-color> <title-color>
           ; <active-title-color>) specifications, to get different colors
           ; on different windows. <win-spec> can be an atom (matching the
           ; client class), a string (regexp matching title), or an
           ; arbitrary expression (giving nil or non-nil).
       fvwm-window-styles '(((matches-list '(XClock XLoad XBiff Gwm))
                             resize () title () color "tan" active-color ()
                             frame-width 5 inner-border ()))
           ; List of (<win-spec> <prop1> <val1> ...) specifications, to
           ; get individual appearances on windows. The possible <prop_i>
           ; for which individual values can be specified are:
           ; color, active-color, title-color, active-title-color,
           ; title-font, title-width, frame-width, corner-size, frame,
           ; resize, title, wide-shadow, inner-border, outer-border,
           ; left-plugs, right-plugs, border-action, corner-action,
           ; side-action, title-action.
           ; A window can match several of the <win-spec> in the list (unlike
           ; `fvwm-color-styles' where only the first hit applies).
       fvwm-virtual-colors t       ; Affect colors in virtual map.
)))

;;--------------------------------------------------------------------------
;;   End of user customizable things. Here starts the real code.
;;--------------------------------------------------------------------------

(setq fvwm-resize-cursors t)
(declare-screen-dependent fvwm-frame-cursor)
(with (wob wob)
  (for screen (list-of-screens)
     (progn 
       (setq cursor-NW (cursor-make 134))
       (setq cursor-NE (cursor-make 136))
       (setq cursor-SW (cursor-make 12))
       (setq cursor-SE (cursor-make 14))
       (setq cursor-N  (cursor-make 138))
       (setq cursor-S  (cursor-make 16))
       (setq cursor-W  (cursor-make 70))
       (setq cursor-E  (cursor-make 96))
       (setq fvwm-frame-cursor (cursor-make 68)))))


;; First some prerequisites from other places.

(if (not (boundp 'deltabutton))
    (load "deltabutton"))

(if (or (not (boundp 'raise-lower-move-window))
        (not (boundp 'window-obscured))
        (not (boundp 'windows-overlap)))
    (progn

(defun windows-overlap (w1 w2)
    (with (window w1
         w1l window-x
         w1t window-y
         w1r (+ window-width w1l)
         w1b (+ window-height w1t)
         window w2
         w2l window-x
         w2t window-y
         w2r (+ window-width w2l)
         w2b (+ window-height w2t))
       (and (< w2l w1r)
          (< w2t w1b)
          (> w2b w1t)
          (> w2r w1l))))

(defun window-obscured ()
  (with (unobscured t
         might-obscure ())
    (for w (list-of-windows 'stacking-order 'mapped)
         (if (and might-obscure
                  (not (= (# 'float w) 'up)) ; ignore floating windows
                  (windows-overlap window w))
              (setq unobscured ()))
          (if (= w window) (setq might-obscure t)))
    (not unobscured)))

(defun raiselower-window ()
  (if (window-obscured)
      (raise-window)
    (lower-window)))

(defun raise-lower-move-window ()
  (set-focus)
  (if (deltabutton)
      (move-window)
    (window-obscured)
      (raise-window)
      (lower-window)))

))

(if (not (boundp 'zoom-window))
    (progn
      
      (if (not (boundp 'virtual-nailed))
          (progn
            (defun virtual-nailed () ())
            (defun virtual-x (x) x)
            (defun virtual-y (y) y)
            ))

      (if (not (boundp 'pop-to-window))
          (setq pop-to-window raise-window))

      (load "vtwm-zoom")

      (setq zoom-window-method-list '((XTerm zoom-window-vert) 
                                      (XVroot zoom-window-prop)
                                      (t zoom-window-full)))
))

;; Specific menus are not written yet. Find some good alternative.
(setq fvwm-pop-menu (or (eval (boundp 'std-pop-menu))
                        (eval (boundp 'vtwm-pop-menu))
                        pop-menu))

;; Redefinition to make colors in the virtual map follow the windows
(defun virt-get-color ()
  (with (res (if (= window root-window)
                 (with (ele (# 0 virtual-fancy-colors))
                   (if (and ele
                            (or (not (# 0 ele))
                                (= (type (# 0 ele)) 'number)))
                       ele))
               (and fvwm-virtual-colors
                    (# 'virt-col window))
                 (list () (# 'virt-col window))
                 (matches-cond virtual-fancy-colors)))
    (if (not res)
        (list virtual-foreground 
              (if virtual-show-filled
                  virtual-background
                ()))
      (not (# 0 res))
        (list virtual-foreground
              (# 1 res))
        res)))


;; COLORS 
;; =======

(defun darken-color (col)
  (with (rgb (color-components col))
    (color-make-rgb (/ (* (# 0 rgb) 2) 3)
                    (/ (* (# 1 rgb) 2) 3)
                    (/ (* (# 2 rgb) 2) 3))))

(defun lighten-color (col)
  (with (rgb (color-components col)
         wht (color-components white))
    (color-make-rgb (/ (+ (# 0 wht) (# 0 rgb)) 2)
                    (/ (+ (# 1 wht) (# 1 rgb)) 2)
                    (/ (+ (# 2 wht) (# 2 rgb)) 2))))

(defun make-color-scheme (bg fg)
  (with (bg (if (= (type bg) 'number) bg (color-make bg))
         fg (if (= (type fg) 'number) fg (color-make fg))
         dark (darken-color bg)
         light (lighten-color bg))
    (list light bg dark fg)))

; THE TILES :
; =========

(defun fvwm-vbar-tile (size active spec)
  (with (cols (if active active-color-scheme color-scheme)
         foreground (# 1 cols)
         tile ()
         theTile (pixmap-make size 1))
        (with (foreground (# 0 cols)) 
          (draw-line theTile 0 0 (if (eq spec 'right) 0 1) 0))
        (with (foreground (# 2 cols)) 
          (draw-line theTile (- size 1) 0 (- size (if (eq spec 'left) 1 2)) 0))
        theTile
	))

(defun fvwm-hbar-tile (size active spec)
  (with (cols (if active active-color-scheme color-scheme)
         foreground (# 1 cols)
         tile ()
         theTile (pixmap-make 1 size))
        (with (foreground (# 0 cols))
          (draw-line theTile 0 0 0 (if (eq spec 'title) 0 1)))
        (with (foreground (# 2 cols))
          (draw-line theTile 0 (- size 1) 0 (- size (if spec 1 2))))
        theTile
	))

(defun fvwm-tl-pixmap (w h active seam spec)
  (with (cols (if active active-color-scheme color-scheme)
         foreground (# 1 cols)
         tile ()
         theTile (pixmap-make w h))
        (with (foreground (# 0 cols))
          (draw-line theTile 0 0 (- w 1) 0)
          (draw-line theTile 0 1 (- w 1) 1)
          (draw-line theTile 0 0 0 (- h 1))
          (draw-line theTile 1 0 1 (- h 1))
          (if seam (draw-line theTile (- w 1) 0 (- w 1) (- h 2)))
          )
        (with (foreground (# 2 cols))
          (if spec
              (draw-line theTile (- h 1) (- h 1) (- w 1) (- h 1))
            (progn
              (draw-line theTile (- h 2) (- h 2) (- w 2) (- h 2))
              (draw-line theTile (- h 2) (- h 1) (- w 1) (- h 1))))
          (if seam (draw-line theTile (- w 2) 1 (- w 2) (- h 1)))
          )
        theTile
        ))

(defun fvwm-tr-pixmap (w h active seam spec)
  (with (cols (if active active-color-scheme color-scheme)
         foreground (# 1 cols)
         tile ()
         theTile (pixmap-make w h))
        (with (foreground (# 0 cols))
          (draw-line theTile 0 0 (- w 1) 0)
          (draw-line theTile 0 1 (- w 2) 1)
          (if seam (draw-line theTile 1 0 1 (- h 2)))
          (if (not spec)
              (draw-line theTile (+ (- w h) 1) (- h 1) (+ (- w h) 1) (- h 1)))
         )
        (with (foreground (# 2 cols))
          (if seam (draw-line theTile 0 1 0 (- h 1)))
          (draw-line theTile (- w 1) 1 (- w 1) (- h 1))
          (draw-line theTile (- w 2) 2 (- w 2) (- h 1))
          (if (not spec)
              (draw-line theTile 0 (- h 1) (- w h) (- h 1))
            (if (> w h)
                (draw-line theTile 0 (- h 1) (- w h 1) (- h 1))))
          (if (not spec)
              (draw-line theTile (if seam 2 0) (- h 2) (+ (- w h) 1) (- h 2)))
          )
        theTile
        ))

(defun fvwm-bl-pixmap (w h active seam)
  (with (cols (if active active-color-scheme color-scheme)
         foreground (# 1 cols)
         tile ()
         theTile (pixmap-make w h))
        (with (foreground (# 0 cols))
	  (draw-line theTile 0 0 0 (- h 1))
          (draw-line theTile 1 0 1 (- h 2))
          (draw-line theTile h 0 (- w 1) 0)
          (draw-line theTile (- h 1) 1 (- w 1) 1)
	  (if seam (draw-line theTile (- w 1) 0 (- w 1) (- h 2)))
          )
        (with (foreground (# 2 cols))
          (draw-line theTile 1 (- h 1) (- w 1) (- h 1))
          (draw-line theTile 2 (- h 2) (- w (if seam 2 1)) (- h 2))
          (draw-line theTile (- h 2) 0 (- h 1) 0)
          (draw-line theTile (- h 2) 1 (- h 2) 1)
          (if seam (draw-line theTile (- w 2) 1 (- w 2) (- h 1)))
	 )
	 theTile
	))

(defun fvwm-br-pixmap (w h active seam)
  (with (cols (if active active-color-scheme color-scheme)
         foreground (# 1 cols)
         tile ()
         theTile (pixmap-make w h))
        (with (foreground (# 0 cols))
          (draw-line theTile 0 0 (+ (- w h) 1) 0)
          (draw-line theTile 0 1 (+ (- w h) 1) 1)
          (if seam (draw-line theTile 1 0 1 (- h 2)))
          )
        (with (foreground (# 2 cols))
          (draw-line theTile 0 (- h 1) (- w 1) (- h 1))
          (draw-line theTile (if seam 2 0) (- h 2) (- w 1) (- h 2))
          (draw-line theTile (- w 1)  0 (- w 1) (- h 1))
          (draw-line theTile (- w 2)  0 (- w 2) (- h 2))
          (if seam (draw-line theTile 0 1 0 (- h 1)))
          )
        theTile
	))

(defun fvwm-bv-pixmap (w h active)
  (with (cols (if active active-color-scheme color-scheme)
         foreground (# 1 cols)
         tile ()
         theTile (pixmap-make w h))
        (with (foreground (# 0 cols))
          (draw-line theTile 0 1 (- w 1) 1)
          (draw-line theTile 0 0 0 (- h 1))
          (draw-line theTile 1 1 1 (- h 1))
          )
        (with (foreground (# 2 cols))
          (draw-line theTile 1 0 (- w 1) 0)
          (draw-line theTile (- w 1) 0 (- w 1) (- h 1))
          (draw-line theTile (- w 2) 2 (- w 2) (- h 1))
          )
        theTile
	))

(defun fvwm-tv-pixmap (w h active spec)
  (with (cols (if active active-color-scheme color-scheme)
         foreground (# 1 cols)
         tile ()
         theTile (pixmap-make w h))
        (with (foreground (# 0 cols))
          (draw-line theTile 0 0 0 (- h 1))
          (if (not (eq spec 'right))
              (draw-line theTile 1 0 1 (- h 1)))
          (draw-line theTile 0 (- h 1) (- w 2) (- h 1))
          )
        (with (foreground (# 2 cols))
          (if (not (eq spec 'left))
              (draw-line theTile (- w 2) 0 (- w 2) (- h 2)))
          (draw-line theTile (- w 1) 0 (- w 1) (- h 1))
          (draw-line theTile 1 (- h 2) (- w 1) (- h 2))
          )
        theTile
	))


; Frame Behavior
; ===============

(setq fvwm-frame-behavior
  (state-make
	(on (user-event 'focus-in)
            (wob-tile (# 'activepixmap wob-property)) )
        (on (user-event 'focus-out)
            (wob-tile (# 'pixmap wob-property)) )
        (on (user-event 're-color)
            (with (redo-expr (# 'redo-expr wob-property)
                   ntile (with (active ()) (eval redo-expr))
                   atile (with (active t) (eval redo-expr)))
              (if (eq (wob-tile) (# 'activepixmap wob-property))
                  (wob-tile atile)
                  (wob-tile ntile))
              (## 'pixmap wob ntile)
              (## 'activepixmap wob atile))))
)

; Title Behavior
; ===============

(setq fvwm-title-behavior
  (state-make
	(on (user-event 'focus-in)
            (wob-tile (# 'activepixmap wob-property)) )
        (on (user-event 'focus-out)
            (wob-tile (# 'pixmap wob-property)) )
	(on (user-event 'press)
            (wob-tile (# 'pressedpixmap wob-property)) )
	(on (user-event 'release)
            (wob-tile (# 'activepixmap wob-property)) )
        (on (user-event 'pre-color)
            (with (redo-expr (# 'redo-expr wob-property)
                   ntile (with (active () pressed ()) (eval redo-expr))
                   atile (with (active t pressed ()) (eval redo-expr))
                   ptile (with (active t pressed t) (eval redo-expr)))
              (## 'new-npm wob ntile)
              (## 'new-apm wob atile)
              (## 'new-ppm wob ptile)))
        (on (user-event 're-color)
            (with (redo-expr (# 'redo-expr wob-property)
                   ntile (# 'new-npm wob)
                   atile (# 'new-apm wob)
                   ptile (# 'new-ppm wob))
              (if (eq (wob-tile) (# 'activepixmap wob-property))
                  (wob-tile atile)
                  (eq (wob-tile) (# 'pressedpixmap wob-property))
                  (wob-tile ptile)
                  (wob-tile ntile))
              (## 'pixmap wob ntile)
              (## 'activepixmap wob atile)
              (## 'pressedpixmap wob ptile))))
)

(setq fvwm-title-plug-behavior
  (state-make
	(on (user-event 'focus-in)
            (wob-tile (# 'activepixmap wob-property)))
        (on (user-event 'focus-out)
            (wob-tile (# 'pixmap wob-property)))
        (on (user-event 're-color)
            (with (label-vertical-margin 0
                   label-horizontal-margin 0
                   font (# 'font wob-property)
                   name (eval (# 'name-expr wob-property))
                   background (# 1 active-color-scheme)
                   foreground (# 3 active-color-scheme)
                   atile (label-make name)
                   background (# 1 color-scheme)
                   foreground (# 3 color-scheme)
                   ntile (label-make name))
              (wob-tile (if (eq (wob-tile) (# 'activepixmap wob-property))
                            atile ntile))
              (## 'pixmap wob ntile)
              (## 'activepixmap wob atile)
              (## 'bg wob (# 1 color-scheme))
              (## 'abg wob (# 1 active-color-scheme))
              (## 'fg wob (# 3 color-scheme))
              (## 'afg wob (# 3 active-color-scheme))))
        (on (user-event 'name-change)
            (with (label-vertical-margin 0
                   label-horizontal-margin 0
                   font (# 'font wob-property)
                   name (eval (# 'name-expr wob-property))
                   background (# 'abg wob-property)
                   foreground (# 'afg wob-property)
                   atile (label-make name)
                   background (# 'bg wob-property)
                   foreground (# 'fg wob-property)
                   ntile (label-make name))
              (wob-tile (if (eq (wob-tile) (# 'activepixmap wob-property))
                            atile ntile))
              (## 'pixmap wob ntile)
              (## 'activepixmap wob atile))))
)



; THE PLUGS :
; =========

(defunq fvwm-border-plug (pix-expr)
  (with (borderwidth 0
         fsm (fsm-make (state-make fvwm-frame-behavior 
                                   (fvwm-button-behavior fvwm-border-action ())))
         tile ()
         pixmap (with (active ()) (eval pix-expr))
         activepixmap (with (active t) (eval pix-expr))
         property (list 'pixmap pixmap 'activepixmap activepixmap
                        'redo-expr pix-expr))
    (plug-make pixmap)))

(defunq fvwm-resize-plug (cur pix-expr)
  (with (borderwidth 0
         cursor (if fvwm-resize-cursors (eval cur) fvwm-frame-cursor)
         fsm (fsm-make (state-make fvwm-frame-behavior 
                                   (fvwm-button-behavior fvwm-corner-action ())))
         tile ()
         pixmap (with (active ()) (eval pix-expr))
         activepixmap (with (active t) (eval pix-expr))
         property (list 'pixmap pixmap 'activepixmap activepixmap
                        'redo-expr pix-expr))
    (plug-make pixmap)))


(defun fvwm-border-plug-tl (small)
  (if small
      (fvwm-border-plug (fvwm-tl-pixmap frame-width (- frame-width 1)
                                        active () t))
    (fvwm-border-plug (fvwm-tl-pixmap frame-width frame-width
                                      active () ()))))

(defun fvwm-border-plug-tr (small)
  (if small
      (fvwm-border-plug (fvwm-tr-pixmap frame-width (- frame-width 1)
                                        active () t))
    (fvwm-border-plug (fvwm-tr-pixmap frame-width frame-width
                                      active () ()))))
(defun fvwm-border-plug-bl ()
   (fvwm-border-plug (fvwm-bl-pixmap frame-width frame-width
                                     active ())))

(defun fvwm-border-plug-br ()
   (fvwm-border-plug (fvwm-br-pixmap frame-width frame-width
                                     active ())))

(defun fvwm-resize-vplug-tl ()
   (fvwm-resize-plug cursor-NW 
                     (fvwm-tv-pixmap frame-width 
                                     (- corner-size frame-width)
                                     active ())))

(defun fvwm-resize-vplug-tr ()
   (fvwm-resize-plug cursor-NE 
                     (fvwm-tv-pixmap frame-width 
                                     (- corner-size frame-width)
                                     active ())))

(defun fvwm-resize-vplug-tl2 (wide)
   (with (fsm (fsm-make (state-make fvwm-frame-behavior
                                    (fvwm-button-behavior fvwm-side-action ())))
          borderwidth 0
          bar-min-width 0
          bar-max-width 1000
          cursor (if fvwm-resize-cursors cursor-W fvwm-frame-cursor)
          redo-expr (if wide
                        '(fvwm-vbar-tile frame-width active ())
                      '(fvwm-vbar-tile (- frame-width 1) active 'left))
          tile (with (active ()) (eval redo-expr))
          atile (with (active t) (eval redo-expr))
          property (list 'pixmap tile 'activepixmap atile
                         'redo-expr redo-expr))
     (bar-make 
      (if wide
          (fvwm-resize-plug cursor-NE 
                          (fvwm-tv-pixmap frame-width
                                          (- corner-size frame-width)
                                          active ()))
        (fvwm-resize-plug cursor-NW 
                            (fvwm-tv-pixmap (- frame-width 1)
                                            (- corner-size frame-width -1)
                                            active 'left))))))

(defun fvwm-resize-vplug-tr2 (wide)
   (with (fsm (fsm-make (state-make fvwm-frame-behavior
                                    (fvwm-button-behavior fvwm-side-action ())))
          borderwidth 0
          bar-min-width 0
          bar-max-width 1000
          cursor (if fvwm-resize-cursors cursor-E fvwm-frame-cursor)
          redo-expr (if wide
                        '(fvwm-vbar-tile frame-width active ())
                      '(fvwm-vbar-tile (- frame-width 1) active 'right))
          tile (with (active ()) (eval redo-expr))
          atile (with (active t) (eval redo-expr))
          property (list 'pixmap tile 'activepixmap atile
                         'redo-expr redo-expr))
     (bar-make 
      (if wide
          (fvwm-resize-plug cursor-NE 
                          (fvwm-tv-pixmap frame-width
                                          (- corner-size frame-width)
                                          active ()))
        (fvwm-resize-plug cursor-NE 
                            (fvwm-tv-pixmap (- frame-width 1)
                                            (- corner-size frame-width -1)
                                            active 'right))))))

(defun fvwm-resize-vplug-tl-small (wide)
   (if (> corner-size 
          (+ title-width frame-width (if wide 2 0)))
       (if wide
           (fvwm-resize-plug cursor-NW 
                             (fvwm-tv-pixmap frame-width 
                                             (- corner-size frame-width title-width 2)
                                             active ()))
         (fvwm-resize-plug cursor-NW 
                           (fvwm-tv-pixmap frame-width 
                                           (- corner-size frame-width title-width)
                                           active ())))))

(defun fvwm-resize-vplug-tr-small (wide)
   (if (> corner-size 
          (+ title-width frame-width (if wide 2 0)))
       (if wide
           (fvwm-resize-plug cursor-NE 
                             (fvwm-tv-pixmap frame-width 
                                             (- corner-size frame-width title-width 2)
                                             active ()))
         (fvwm-resize-plug cursor-NE 
                           (fvwm-tv-pixmap frame-width 
                                           (- corner-size frame-width title-width)
                                           active ())))))

(defun fvwm-resize-vplug-bl ()
   (fvwm-resize-plug cursor-SW
                     (fvwm-bv-pixmap frame-width 
                                     (- corner-size frame-width)
                                     active)))

(defun fvwm-resize-vplug-br ()
   (fvwm-resize-plug cursor-SE
                     (fvwm-bv-pixmap frame-width 
                                     (- corner-size frame-width)
                                     active)))

(defun fvwm-resize-hplug-bl ()
   (fvwm-resize-plug cursor-SW
                     (fvwm-bl-pixmap corner-size frame-width active t)))

(defun fvwm-resize-hplug-br ()
   (fvwm-resize-plug cursor-SE
                     (fvwm-br-pixmap corner-size frame-width active t)))

(defun fvwm-resize-hplug-tl ()
   (fvwm-resize-plug cursor-NW
                     (fvwm-tl-pixmap corner-size frame-width active t ())))

(defun fvwm-resize-hplug-tr ()
   (fvwm-resize-plug cursor-NE
                     (fvwm-tr-pixmap corner-size frame-width active t ())))

(defun fvwm-resize-hplug-tl2 ()
   (fvwm-resize-plug cursor-NW
                     (fvwm-tl-pixmap corner-size (- frame-width 1) active t t)))

(defun fvwm-resize-hplug-tr2 ()
   (fvwm-resize-plug cursor-NE
                     (fvwm-tr-pixmap corner-size (- frame-width 1) active t t)))

; THE BARS :
; ========


(defun fvwm-border-vertical-bar (dir)
  (with (
        fsm (fsm-make (state-make fvwm-frame-behavior
                                  (fvwm-button-behavior fvwm-border-action ())))
        borderwidth 0
        bar-min-width 0
        bar-max-width 1000
        cursor fvwm-frame-cursor
        redo-expr (if (= dir 'left)
                      '(fvwm-vbar-tile (- frame-width 1) active 'left)
                      (= dir 'right)
                      '(fvwm-vbar-tile (- frame-width 1) active 'right)
                      '(fvwm-vbar-tile frame-width active ()))
        tile (with (active ()) (eval redo-expr))
        atile (with (active t) (eval redo-expr))
        property (list 'pixmap tile 'activepixmap atile
                       'redo-expr redo-expr)
       )
   (bar-make)
  ))
  

(defun fvwm-border-top-bar (small)
  (with (
        fsm (fsm-make (state-make fvwm-frame-behavior
                                  (fvwm-button-behavior fvwm-border-action ())))
        borderwidth 0
        bar-min-width 0
        bar-max-width 1000
        cursor fvwm-frame-cursor
        redo-expr (if small
                      '(fvwm-hbar-tile (- frame-width 1) active t)
                    '(fvwm-hbar-tile frame-width active ()))
        tile (with (active ()) (eval redo-expr))
        atile (with (active t) (eval redo-expr))
        property (list 'pixmap tile 'activepixmap atile
                       'redo-expr redo-expr)
       )
   (bar-make (fvwm-border-plug-tl small) () (fvwm-border-plug-tr small))
  ))

(defun fvwm-border-bottom-bar ()
  (with (
        fsm (fsm-make (state-make fvwm-frame-behavior
                                  (fvwm-button-behavior fvwm-border-action ())))
        borderwidth 0
        bar-min-width 0
        bar-max-width 1000
        cursor fvwm-frame-cursor
        redo-expr '(fvwm-hbar-tile frame-width active ())
        tile (with (active ()) (eval redo-expr))
        atile (with (active t) (eval redo-expr))
        property (list 'pixmap tile 'activepixmap atile
                       'redo-expr redo-expr)
       )
   (bar-make (fvwm-border-plug-bl) () (fvwm-border-plug-br))
  ))
	 
(defun fvwm-resize-left-bar (title wide)
  (with (
         fsm (fsm-make (state-make fvwm-frame-behavior
                                   (fvwm-button-behavior fvwm-side-action ())))
         borderwidth 0
         bar-min-width 0
         bar-max-width 1000
         cursor (if fvwm-resize-cursors cursor-W fvwm-frame-cursor)
         redo-expr '(fvwm-vbar-tile frame-width active ())
         tile (with (active ()) (eval redo-expr))
         atile (with (active t) (eval redo-expr))
         property (list 'pixmap tile 'activepixmap atile
                        'redo-expr redo-expr)
         )
     (bar-make (if title
                   (fvwm-resize-vplug-tl-small wide)
                 (fvwm-resize-vplug-tl))
               ()
               (fvwm-resize-vplug-bl) )))

(defun fvwm-resize-right-bar (title wide)
  (with (
         fsm (fsm-make (state-make fvwm-frame-behavior
                                   (fvwm-button-behavior fvwm-side-action ())))
         borderwidth 0
         bar-min-width 0
         bar-max-width 1000
         cursor (if fvwm-resize-cursors cursor-E fvwm-frame-cursor)
         redo-expr '(fvwm-vbar-tile frame-width active ())
         tile (with (active ()) (eval redo-expr))
         atile (with (active t) (eval redo-expr))
         property (list 'pixmap tile 'activepixmap atile
                        'redo-expr redo-expr)
         )
     (bar-make (if title
                   (fvwm-resize-vplug-tr-small wide)
                 (fvwm-resize-vplug-tr))
               ()
               (fvwm-resize-vplug-br))))

(defun fvwm-resize-bottom-bar ()
  (with (
         fsm (fsm-make (state-make fvwm-frame-behavior
                                   (fvwm-button-behavior fvwm-side-action ())))
         borderwidth 0
         bar-min-width 0
         bar-max-width 1000
         cursor (if fvwm-resize-cursors cursor-S fvwm-frame-cursor)
         plug-separator 0
         redo-expr '(fvwm-hbar-tile frame-width active ())
         tile (with (active ()) (eval redo-expr))
         atile (with (active t) (eval redo-expr))
         property (list 'pixmap tile 'activepixmap atile
                        'redo-expr redo-expr)
         )
     (bar-make (fvwm-resize-hplug-bl) 
               () 
               (fvwm-resize-hplug-br))))

(defun fvwm-resize-top-bar (small)
  (with (
         fsm (fsm-make (state-make fvwm-frame-behavior
                                   (fvwm-button-behavior fvwm-side-action ())))
         borderwidth 0
         bar-min-width 0
         bar-max-width 1000
         cursor (if fvwm-resize-cursors cursor-N fvwm-frame-cursor)
         plug-separator 0
         redo-expr (if small
                       '(fvwm-hbar-tile (- frame-width 1) active t)
                     '(fvwm-hbar-tile frame-width active ()))
         tile (with (active ()) (eval redo-expr))
         atile (with (active t) (eval redo-expr))
         property (list 'pixmap tile 'activepixmap atile
                        'redo-expr redo-expr)
         )
    (if small 
        (bar-make (fvwm-resize-hplug-tl2) 
                  ()
                  (fvwm-resize-hplug-tr2))
      (bar-make (fvwm-resize-hplug-tl) 
                ()
                (fvwm-resize-hplug-tr)))))

(defun fvwm-left-bar ()
  (if has-frame
      (if has-resize
          (fvwm-resize-left-bar has-title wide-shadow)
        (fvwm-border-vertical-bar ()))))

(defun fvwm-right-bar ()
  (if has-frame
      (if has-resize
          (fvwm-resize-right-bar has-title wide-shadow)
        (fvwm-border-vertical-bar ()))))

(defun fvwm-bottom-bar ()
  (if has-frame
      (if has-resize
          (fvwm-resize-bottom-bar)
        (fvwm-border-bottom-bar))))

(defun fvwm-top-bar ()
  (if has-frame
      (if has-resize
          (fvwm-resize-top-bar (and (not wide-shadow) has-title))
        (fvwm-border-top-bar (and (not wide-shadow) has-title)))))


; THE TITLE-BAR :
; =============

(defun fvwm-title-plug (name-expr)
  (with (borderwidth 0
         label-vertical-margin 0
         label-horizontal-margin 0
         font title-font
         name (eval name-expr)
         background (# 1 active-color-scheme)
         foreground (# 3 active-color-scheme)
         atile (label-make name)
         background (# 1 color-scheme)
         foreground (# 3 color-scheme)
         ntile (label-make name)
         fsm (fsm-make fvwm-title-plug-behavior)
         property (list 'pixmap ntile
                        'activepixmap atile
                        'font title-font
                        'name-expr name-expr
                        'bg (# 1 color-scheme)
                        'abg (# 1 active-color-scheme)
                        'fg (# 3 color-scheme)
                        'afg (# 3 active-color-scheme)))
     (plug-make ntile)))

(defun fvwm-title-seam-pixmap (col wd)
  (with (tile ()
         foreground col)
    (pixmap-make 1 wd)))
         
(defun fvwm-inner-titlebar ()
  (with (
         fsm (fsm-make (state-make fvwm-title-behavior 
                                   (fvwm-button-behavior fvwm-title-action 'press)))
         lseam (fvwm-title-seam-pixmap (# 0 color-scheme) title-width)
         rseam (fvwm-title-seam-pixmap (# 2 color-scheme) title-width)
         alseam (fvwm-title-seam-pixmap (# 0 active-color-scheme) title-width)
         arseam (fvwm-title-seam-pixmap (# 2 active-color-scheme) title-width)
         lredo '(fvwm-title-seam-pixmap 
                 (# (if pressed 2 0)
                    (if active active-color-scheme color-scheme)) title-width)
         rredo '(fvwm-title-seam-pixmap
                 (# (if pressed 0 2)
                    (if active active-color-scheme color-scheme)) title-width)
         redo-expr '(if pressed 
                        (with (active-color-scheme
                               (list (# 2 active-color-scheme)
                                     (# 1 active-color-scheme)
                                     (# 0 active-color-scheme)))
                          (fvwm-hbar-tile title-width active 'title))
                      (fvwm-hbar-tile title-width active 'title))
         tile (with (active () pressed ()) (eval redo-expr))
         atile (with (active t pressed ()) (eval redo-expr))
         ptile (with (active t pressed t) (eval redo-expr))
         property (list 'pixmap tile
                        'activepixmap atile
                        'pressedpixmap ptile
                        'redo-expr redo-expr)
         bar-min-width title-width
         bar-max-width bar-min-width
         )
    (bar-make
     (with (property (list 'pixmap lseam 'activepixmap alseam
                           'pressedpixmap arseam 'redo-expr lredo))
       (plug-make lseam))
     () 
     (fvwm-title-plug 'window-name) 
     () 
     (with (property (list 'pixmap rseam 'activepixmap arseam
                           'pressedpixmap alseam 'redo-expr rredo))
       (plug-make rseam))
     )))

(defun small-square (pixmap size light dark)
  (with (x1 (/ (+ size 2) 3)
         x2 (- size x1 1))
    (with (foreground light)
      (draw-line pixmap x1 x1 x1 x2)
      (draw-line pixmap x1 x1 x2 x1))
    (with (foreground dark)
      (draw-line pixmap x1 x2 x2 x2)
      (draw-line pixmap x2 x1 x2 x2))
    pixmap))
         
(defun medium-square (pixmap size light dark)
  (with (x1 (/ (+ size 4) 4)
         x2 (- size x1 1))
    (with (foreground light)
      (draw-line pixmap x1 x1 x1 x2)
      (draw-line pixmap x1 x1 x2 x1))
    (with (foreground dark)
      (draw-line pixmap x1 x2 x2 x2)
      (draw-line pixmap x2 x1 x2 x2))
    pixmap))

(defun large-square (pixmap size light dark)
  (with (x1 (/ (+ size 6) 6)
         x2 (- size x1 1))
    (with (foreground light)
      (draw-line pixmap x1 x1 x1 x2)
      (draw-line pixmap x1 x1 x2 x1))
    (with (foreground dark)
      (draw-line pixmap x1 x2 x2 x2)
      (draw-line pixmap x2 x1 x2 x2))
    pixmap))

(defun horizontal-rectangle (pixmap size light dark)
  (with (x1 (/ (+ size 6) 6)
         x2 (- size x1 1)
         y1 (/ (+ size 2) 3)
         y2 (- size y1 1))
    (with (foreground light)
      (draw-line pixmap x1 y1 x1 y2)
      (draw-line pixmap x1 y1 x2 y1))
    (with (foreground dark)
      (draw-line pixmap x1 y2 x2 y2)
      (draw-line pixmap x2 y1 x2 y2))
    pixmap))

(defun vertical-rectangle (pixmap size light dark)
  (with (y1 (/ (+ size 6) 6)
         y2 (- size y1 1)
         x1 (/ (+ size 2) 3)
         x2 (- size x1 1))
    (with (foreground light)
      (draw-line pixmap x1 y1 x1 y2)
      (draw-line pixmap x1 y1 x2 y1))
    (with (foreground dark)
      (draw-line pixmap x1 y2 x2 y2)
      (draw-line pixmap x2 y1 x2 y2))
    pixmap))

(defun medium-circle (pixmap size light dark)
  (with (x1 (/ (+ size 6) 5)
         x2 (- size x1 1)
         o1 (/ (* (+ size 2) 3) 8)
         o2 (- size o1 1))
    (with (foreground light)
      (draw-line pixmap o1 x1 o2 x1)
      (draw-line pixmap o1 x1 x1 o1)
      (draw-line pixmap x1 o1 x1 o2))
    (with (foreground dark)
      (draw-line pixmap x2 o1 x2 o2)
      (draw-line pixmap x2 o2 o2 x2)
      (draw-line pixmap o1 x2 o2 x2))
    pixmap))

(defun medium-diamond (pixmap size light dark)
  (with (x1 (/ (+ size 6) 6)
         x2 (- size x1 (% size 2))
         h (/ size 2))
    (with (foreground dark)
      (draw-line pixmap h x1 x2 h)
      (draw-line pixmap x2 h h x2))
    (with (foreground light)
      (draw-line pixmap h x1 x1 h)
      (draw-line pixmap x1 h h x2))
    pixmap))

(defun down-triangle (pixmap size light dark)
  (with (x1 (/ (+ size 4) 4)
         x2 (- size x1 (% size 2) -1)
         h (/ size 2))
    (with (foreground light)
      (draw-line pixmap x1 x1 x2 x1)
      (draw-line pixmap x1 x1 h x2))
    (with (foreground dark)
      (draw-line pixmap x2 x1 h x2))
    pixmap))

(defun up-triangle (pixmap size light dark)
  (with (x1 (/ (- size 4) 4)
         x2 (- size x1 (% size 2) 2)
         h (/ (- size 2) 2))
    (with (foreground dark)
      (draw-line pixmap x1 x2 x2 x2)
      (draw-line pixmap x2 x2 h x1))
    (with (foreground light)
      (draw-line pixmap x1 x2 h x1))
    pixmap))

(defun fvwm-button-pixmap (size active pressed draw-func)
  (with (cols (if active active-color-scheme color-scheme)
         foreground (# 1 cols)
         tile ()
         last (- size 1)
         pixmap (pixmap-make size size))
    (with (foreground (# (if pressed 2 0) cols))
      (draw-line pixmap 0 0 last 0)
      (draw-line pixmap 0 1 0 last))
    (with (foreground (# (if pressed 0 2) cols))
      (draw-line pixmap last 0 last last)
      (draw-line pixmap 1 last last last))
    (eval (list draw-func pixmap size (# 0 cols) (# 2 cols)))
    pixmap))

(defun fvwm-interpret-event (event relp)
  (with (ecode (if (= (type event) 'list)
                   (# 0 event)
                 (= event t)
                   any
                   event)
         emod (if (= (type event) 'list)
                  (eval (+ '(together) (sublist 1 (length event) event)))
                any))
    (if (= (type ecode) 'string)
        ((if relp keyrelease keypress) (key-make ecode) emod)
      (= (type ecode) 'number)
        ((if relp buttonrelease buttonpress) ecode emod)
        ())))

(setq fvwm-button-event-code ())

(defun fvwm-button-action-arc (evdesc action atype relp)
  (on-eval (fvwm-interpret-event evdesc relp)
    (if (not relp)
        (list 'progn
              '(if (and (boundp 'autofocus) (not autofocus))
                   (set-focus window))
              '(send-user-event 'press wob)
              (if (not (= atype 'release))
                  action
                '(setq fvwm-button-event-code (current-event-code)))
              (if (= atype 'press) 
                  '(send-user-event 'release wob)))
      (list 'progn
            '(send-user-event 'release wob)
            '(setq fvwm-button-rev (list  (current-event-code) (current-event-modifier)))
            (if (= atype 'release) 
                (list 'if '(= fvwm-button-event-code (current-event-code))
                      action))))))

(defun fvwm-button-behavior (action atype)
  (if (not action)
      (state-make ())
    (= (type action) 'fsm-state)
      action
    (and action (= (type action) 'list) (= (type (# 0 action)) 'list))
      (eval (+ '(state-make)
               (mapfor ele action
                 (fvwm-button-action-arc (# 0 ele) (# 1 ele) (# 2 ele) ()))
               (mapfor ele action
                 (fvwm-button-action-arc (# 0 ele) (# 1 ele) (# 2 ele) t))))
      (state-make 
        (fvwm-button-action-arc t action atype ())
        (fvwm-button-action-arc t action atype t))))
        
(defun fvwm-button-plug (draw action atype)
  (with (redo-expr (list 'fvwm-button-pixmap 'title-width 'active 'pressed draw)
         ntile (with (active () pressed ()) (eval redo-expr))
         atile (with (active t pressed ()) (eval redo-expr))
         ptile (with (active t pressed t) (eval redo-expr))
         property (list 'pixmap ntile
                        'activepixmap atile
                        'pressedpixmap ptile
                        'redo-expr redo-expr)
         fsm (fsm-make (state-make fvwm-title-behavior 
                                   (fvwm-button-behavior action atype))))
    (plug-make ntile)))
         
(defun fvwm-title-row (border resize shadow)
  (with (fsm (fsm-make fvwm-frame-behavior)
         plug-separator 0
         lseam-expr '(fvwm-title-seam-pixmap 
                      (# 0 (if active active-color-scheme color-scheme))
                      (+ title-width 2))
         rseam-expr '(fvwm-title-seam-pixmap
                      (# 2 (if active active-color-scheme color-scheme))
                      (+ title-width 2))
         seams (or shadow (not border))
         lseam (if seams (with (active ()) (eval lseam-expr)))
         alseam (if seams (with (active t) (eval lseam-expr)))
         rseam (if seams (with (active ()) (eval rseam-expr)))
         arseam (if seams (with (active t) (eval rseam-expr)))
         lseam-prop (list 'pixmap lseam 'activepixmap alseam
                          'redo-expr lseam-expr)
         rseam-prop (list 'pixmap rseam 'activepixmap arseam
                          'redo-expr rseam-expr)
         redo-expr '(fvwm-hbar-tile (+ title-width 2) active ())
         tile (with (active ()) (eval redo-expr))
         atile (with (active t) (eval redo-expr))
         property (list 'pixmap tile 'activepixmap atile
                        'redo-expr redo-expr)
         bar-min-width (if (and (not wide-shadow) border) 
                           (+ title-width 1)
                         (+ title-width 2))
         bar-max-width bar-min-width
         params1 (+
                  (if seams (with (property lseam-prop)
                              (list (plug-make lseam))))
                  (mapfor descr fvwm-left-plugs
                    (fvwm-button-plug (# 0 descr) (# 1 descr) (# 2 descr)))
                  (list (bar-make () (fvwm-inner-titlebar) ()))
                  (mapfor descr fvwm-right-plugs
                    (fvwm-button-plug (# 0 descr) (# 1 descr) (# 2 descr)))
                  (if seams (with (property rseam-prop)
                              (list (plug-make rseam)))))
         params2 (+ 
                 (if border
                     (if resize
                         (list (fvwm-resize-vplug-tl2 shadow))
                       (list (fvwm-border-vertical-bar (if (not shadow) 'left)))))
                 (list (bar-make (eval (+ '(bar-make) params1))))
                 (if border
                     (if resize
                         (list (fvwm-resize-vplug-tr2 shadow))
                       (list (fvwm-border-vertical-bar (if (not shadow) 'right)))))
                 ))
    (eval (+ '(bar-make) params2))))

(defun fvwm-titlebar ()
  (if has-title
      (with (menu ()
             fsm ()
             plug-separator 0
             cursor fvwm-frame-cursor
             borderwidth 0
             bar-min-width 0
             bar-max-width 1000)
        (if has-frame
            (bar-make (bar-make (fvwm-top-bar)
                                (fvwm-title-row has-frame has-resize wide-shadow)))
          (fvwm-title-row has-frame has-resize wide-shadow)))
    (if has-frame (fvwm-top-bar))))


; INTERNAL BEHAVIOR OF WINDOWS :
; ============================
(setq fvwm-window-behavior
   (state-make
        (on focus-out
            (maintain-focus-out))
        (on focus-in
            (progn
              (maintain-focus-in)
              (if (eval (boundp 'autocolormap))
                  (set-colormap-focus))))
        (on leave-window-not-from-grab 
            (progn
              (if (or (not (boundp 'autofocus)) autofocus)
                  (set-focus ()))
              (if (and (eval (boundp 'autofocus)) (eval (boundp 'autocolormap)))
                  (set-colormap-focus ()))))
        (on enter-window 
            (if (or (not (boundp 'autofocus)) autofocus)
                (set-focus)))
        (on name-change 
            (progn
              (send-user-event 'name-change)
              (if (window-icon?)
                  (progn
                   (send-user-event 'name-change window-icon)
                   (if (boundp 'update-placements)
                       (with (wob window-icon)
                         (update-placements)))))
              (if (boundp 'icon-mgr-update)
                  (icon-mgr-update))))
	(on (property-change "WM_ICON_NAME")
            (progn
              (if (window-icon?)
                  (progn
                   (send-user-event 'name-change window-icon)
                   (if (boundp 'update-placements)
                       (with (wob window-icon)
                         (update-placements)))))
              (if (boundp 'icon-mgr-update)
                  (icon-mgr-update))))
        (on window-icon-pixmap-change
	    (if (window-icon?)
                (send-user-event 'icon-pixmap-change window-icon)))
        )
)

(defun maintain-focus-in ()
  (send-user-event 'focus-in window)
  (## 'virt-col window (# 'virt-col2 window))
  (## 'virt-act window t)
  (if (boundp 'icon-mgr-focusin)
      (icon-mgr-focusin))
  (if (eval (boundp 'autoraise))
      (raise-window)
    (if (and fvwm-virtual-colors
             (boundp 'virtual-update)
             (not (= (# 'virt-col1 window) (# 'virt-col2 window))))
        (virtual-update)))
;  (if (eval (boundp 'autocolormap))
;      (set-colormap-focus))
)

(defun maintain-focus-out ()
  (send-user-event 'focus-out window)
  (## 'virt-col window (# 'virt-col1 window))
  (## 'virt-act window ())
  (if (boundp 'icon-mgr-focusout)
      (icon-mgr-focusout))
  (if (and fvwm-virtual-colors
           (boundp 'virtual-update)
           (not (= (# 'virt-col1 window) (# 'virt-col2 window))))
      (virtual-update))
;  (if (eval (boundp 'autocolormap))
;      (set-colormap-focus ()))
)

(defunq fvwm-get-style (plist prop def)
  (with (plist (eval plist)
         prop (eval prop))
    (if (member prop plist)
        (# prop plist)
      (eval def))))

(defun fvwm-get-colors (styles props)
  (with (col (or (fvwm-get-style props 'color ())
                 (# 0 styles) fvwm-color)
         acol (or (fvwm-get-style props 'active-color
                                         (or (# 1 styles) fvwm-active-color))
                  col)
         tcol (or (fvwm-get-style props 'title-color ())
                  (# 2 styles) fvwm-title-color "black")
         atcol (or (fvwm-get-style props 'active-title-color
                                          (or (# 3 styles) fvwm-active-title-color))
                   tcol))
    (list col acol tcol atcol)))

(defun fvwm-resize-window  ()
  (with (resize-style 1
         mwm-resize-style-corner-size (or (# 'resize-corner-size window) 1)
         mwm-resize-style-catch-corners 1)
    (resize-window)))

(defun fvwm-update-color ()
  (with (props (matches-cond-all fvwm-window-styles)
         cols (fvwm-get-colors (matches-cond fvwm-color-styles) props)
         corner-size (# 'resize-corner-size window)
         frame-width (# 'frame-width window)
         title-width (# 'title-width window)
         is-active (# 'virt-act window)
         color-scheme (make-color-scheme (# 0 cols) (# 2 cols))
         active-color-scheme (make-color-scheme (# 1 cols) (# 3 cols)))
    (send-user-event 'pre-color window)
    (send-user-event 're-color window)
    (if (window-icon?)
        (send-user-event 'update-color window-icon))
    (## 'virt-col window (# 0 (if is-active active-color-scheme color-scheme)))
    (## 'virt-col1 window (# 0 color-scheme))
    (## 'virt-col2 window (# 0 active-color-scheme))
    (if (and fvwm-virtual-colors (boundp 'virtual-update))
        (virtual-update))))

(defun fvwm-nail-window ()
  (virtual-nail)
  (fvwm-update-color))

(defun fvwm-unnail-window ()
  (virtual-unnail)
  (fvwm-update-color))

(defun fvwm-toggle-nail-window ()
  (virtual-toggle-nail)
  (fvwm-update-color))


(defun fvwm-window ()
  (with (fsm (fsm-make (state-make fvwm-window-behavior standard-behavior))
         cursor fvwm-frame-cursor
         props (matches-cond-all fvwm-window-styles)
         cols (fvwm-get-colors (matches-cond fvwm-color-styles) props)
         has-frame (fvwm-get-style props 'frame fvwm-has-frame)
         has-resize (fvwm-get-style props 'resize fvwm-has-resize)
         has-title (fvwm-get-style props 'title fvwm-has-title)
         wide-shadow (fvwm-get-style props 'wide-shadow fvwm-wide-shadow)
         title-font (fvwm-get-style props 'title-font fvwm-title-font)
         fonthgt (with (font title-font
                        label-vertical-margin 0
                        label-horizontal-margin 0)
                   (# 3 (dimensions " ")))
         title-width (or (fvwm-get-style props 'title-width fvwm-title-width)
                         (+ 4 fonthgt))
         frame-width (fvwm-get-style props 'frame-width fvwm-frame-width)
         corner-size (max (or (fvwm-get-style props 'corner-size
                                              fvwm-corner-size)
                              (+ title-width frame-width (if wide-shadow 2 0)))
                          (+ frame-width 2))
         fvwm-left-plugs (fvwm-get-style props 'left-plugs fvwm-left-plugs)
         fvwm-right-plugs (fvwm-get-style props 'right-plugs fvwm-right-plugs)
         fvwm-border-action (fvwm-get-style props 'border-action fvwm-border-action)
         fvwm-side-action (fvwm-get-style props 'side-action fvwm-side-action)
         fvwm-corner-action (fvwm-get-style props 'corner-action fvwm-corner-action)
         fvwm-title-action (fvwm-get-style props 'title-action fvwm-title-action)
         inner-border (fvwm-get-style props 'inner-border fvwm-inner-border)
         outer-border (fvwm-get-style props 'outer-border fvwm-outer-border)
         color-scheme (make-color-scheme (# 0 cols) (# 2 cols))
         active-color-scheme (make-color-scheme (# 1 cols) (# 3 cols))
         inner-borderwidth (if inner-border
                               (if (= (type inner-border) 'number)
                                   inner-border 1) 0)
         borderwidth (if outer-border
                         (if (= (type outer-border) 'number)
                             outer-border 1) 0)
         borderpixel black
         property (list 'resize-corner-size (if has-resize corner-size 1)
                        'frame-width frame-width
                        'title-width title-width
                        'virt-col (# 0 color-scheme)
                        'virt-col1 (# 0 color-scheme)
                        'virt-col2 (# 0 active-color-scheme)
                        'virt-act ()))
     (window-make (fvwm-titlebar) (fvwm-left-bar)
                  (fvwm-right-bar) (fvwm-bottom-bar) ())))