;;File: mwm-win.gwm -- mwm-like frame
;;Author: Frederic CHARTON
;;Revision: 1.1 -- Marc 2 1990
;;Updated by Anders Holst (aho@nada.kth.se) July 22 1995

(: mwm-ed-borderwidth 0)

; STANDARD BEHAVIOR OF WINDOWS :
; ============================
(: window-std-behavior
   (state-make
        (on focus-out (progn ;(? "focus leaving window " window-name "\n") 
			     (maintain-focus-out)))
        (on focus-in (progn ;(? "focus entering window " window-name "\n")
			    (maintain-focus-in)))
        (on (user-event 'resize-by-menu)
                (progn
                (set-focus)
                (warp-pointer (/ window-width 2) (/ window-height 2) window)
                (with  (cursor cross-cursor) (grab-server window 'only))
                (: resize-flag window)))
        (if (= keyboardFocusPolicy 'explicit)
        (on leave-window
         (if (not (current-event-from-grab))
          (progn
                (if (= resize-flag window)
                (progn  (: resize-flag ())
                        (ungrab-server)
                        (with (mwm-resize-style-catch-corners 1 
			       old mwm-resize-style-corner-size)
			      (: mwm-resize-style-corner-size 
				(# 'resize-corner-size window))
			      (resize-window)
			      (: mwm-resize-style-corner-size old)
			)
                )
                             (send-user-event 'leave-window))
          )
	 )
	)
        (on leave-window
         (if (not (current-event-from-grab))
          (progn
                (if (= resize-flag window)
                 (progn  (: resize-flag ())
                         (ungrab-server)
                         (with (mwm-resize-style-catch-corners 1
				old mwm-resize-style-corner-size) 
			       (: mwm-resize-style-corner-size 
					(# 'resize-corner-size window))
				(resize-window)
			      (: mwm-resize-style-corner-size old)
			)

                 )
                )
                (set-focus ())
          )
	  (with (cmp (current-mouse-position)
		 cmpx (- (# 0 cmp) window-x) cmpy (- (# 1 cmp) window-y)
		)
	   (if (not (and (> cmpx 0) (> cmpy 0) 
			 (< cmpx window-width) 
			 (< cmpy window-height)))
		(set-focus ())
	   )
	  )
         )
        )
        )

        (if (= keyboardFocusPolicy 'explicit)
         (on enter-window
          (if (not (# 'got-focus window-property))
			(set-grabs (replayable-event (buttonpress 1 alone)))
	  )
	 )
         (on enter-window (set-focus)) 
	)

        (if (= keyboardFocusPolicy 'explicit)
         (on (buttonpress 1 alone)
               (if (not (# 'got-focus window-property))
                (progn
                 (set-focus)
                 (if (not (= resize-flag window)) (: resize-flag ()))
                 (if passSelectButton 
                     (ungrab-server-and-replay-event ())
                   (allow-event-processing))
                 (unset-grabs (buttonpress 1 alone) )
                )
                (progn ; has focus already, got this by mistake
                  (ungrab-server-and-replay-event ())
                  (unset-grabs (buttonpress 1 alone) )))
	 )
        )
        (on name-change (send-user-event 'name-change))
	(on (property-change "WM_ICON_NAME")
	    (if (window-icon?)
		(send-user-event 'name-change window-icon)))
        (on window-icon-pixmap-change
                (send-user-event 'icon-pixmap-change window-icon))
       )
)

;-------------------------------------------------------------------------


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

(defun make-vbar-tile (size active spec)
  (with (foreground (if active clientActiveBackground clientBackground)
         theTile (pixmap-make size 1))
        (with (foreground (if active clientActiveTopShadowColor
                                     clientTopShadowColor)) 
          (draw-line theTile 0 0 (if (eq spec 'right) 0 1) 0))
        (with (foreground (if active clientActiveBottomShadowColor
                                     clientBottomShadowColor)) 
          (draw-line theTile (- size 1) 0 (- size (if (eq spec 'left) 1 2)) 0))
        theTile
	))

(defun make-hbar-tile (size active spec)
  (with (foreground (if active clientActiveBackground clientBackground)
         theTile (pixmap-make 1 size))
        (with (foreground (if active clientActiveTopShadowColor
                                     clientTopShadowColor))
          (draw-line theTile 0 0 0 (if (eq spec 'title) 0 1)))
        (with (foreground (if active clientActiveBottomShadowColor
                                     clientBottomShadowColor))
          (draw-line theTile 0 (- size 1) 0 (- size (if spec 1 2))))
        theTile
	))

(: shadowed-vbar-tile 
   (make-vbar-tile resizeBorderWidth () ()))

(: active-shadowed-vbar-tile 
   (make-vbar-tile resizeBorderWidth t ()))

(: shadowed-vbar-tile-l 
   (make-vbar-tile (- resizeBorderWidth 1) () 'left))

(: active-shadowed-vbar-tile-l 
   (make-vbar-tile (- resizeBorderWidth 1) t 'left))

(: shadowed-vbar-tile-r 
   (make-vbar-tile (- resizeBorderWidth 1) () 'right))

(: active-shadowed-vbar-tile-r 
   (make-vbar-tile (- resizeBorderWidth 1) t 'right))

(: shadowed-hbar-tile 
   (make-hbar-tile resizeBorderWidth () ()))

(: active-shadowed-hbar-tile 
   (make-hbar-tile resizeBorderWidth t ()))

(: shadowed-hbar-tile-t 
   (make-hbar-tile (- resizeBorderWidth 1) () t))

(: active-shadowed-hbar-tile-t 
   (make-hbar-tile (- resizeBorderWidth 1) t t))

(: border-vbar-tile
   (make-vbar-tile frameBorderwidth () ()))

(: active-border-vbar-tile
   (make-vbar-tile frameBorderwidth t ()))

(: border-vbar-tile-l
   (make-vbar-tile (- frameBorderwidth 1) () 'left))

(: active-border-vbar-tile-l
   (make-vbar-tile (- frameBorderwidth 1) t 'left))

(: border-vbar-tile-r
   (make-vbar-tile (- frameBorderwidth 1) () 'right))

(: active-border-vbar-tile-r
   (make-vbar-tile (- frameBorderwidth 1) t 'right))

(: border-hbar-tile
   (make-hbar-tile frameBorderwidth () ()))

(: active-border-hbar-tile
   (make-hbar-tile frameBorderwidth t ()))

(: border-hbar-tile-t
   (make-hbar-tile (- frameBorderwidth 1) () t))

(: active-border-hbar-tile-t
   (make-hbar-tile (- frameBorderwidth 1) t t))


(defun make-tl-pixmap (w h active seam spec)
  (with (foreground (if active clientActiveBackground  clientBackground)
         tSC (if active clientActiveTopShadowColor clientTopShadowColor)
         bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
         theTile (pixmap-make w h))
        (with (foreground tSC)
          (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 bSC)
          (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 make-tr-pixmap (w h active seam spec)
  (with (foreground (if active clientActiveBackground  clientBackground)
         tSC (if active clientActiveTopShadowColor clientTopShadowColor)
         bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
         theTile (pixmap-make w h))
        (with (foreground tSC)
          (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 bSC)
          (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))
          (draw-line theTile 0 (- h 1) (- w h) (- h 1))
          (if (not spec)
              (if seam (draw-line theTile 2 (- h 2) (+ (- w h) 1) (- h 2))
                       (draw-line theTile 0 (- h 2) (+ (- w h) 1) (- h 2))))
          )
        theTile
        ))

(defun make-bl-pixmap (w h active seam)
  (with (foreground (if active clientActiveBackground  clientBackground)
         tSC (if active clientActiveTopShadowColor clientTopShadowColor)
         bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
         theTile (pixmap-make w h))
        (with (foreground tSC)
	  (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 bSC) 
          (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 make-br-pixmap (w h active seam)
  (with (foreground (if active clientActiveBackground  clientBackground)
         tSC (if active clientActiveTopShadowColor clientTopShadowColor)
         bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
         theTile (pixmap-make w h))
        (with (foreground tSC)
          (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 bSC) 
          (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 2 0 (- h 1)))
          )
        theTile
	))

(defun make-bv-pixmap (w h active)
  (with (foreground (if active clientActiveBackground  clientBackground)
         tSC (if active clientActiveTopShadowColor clientTopShadowColor)
         bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
         theTile (pixmap-make w h))
        (with (foreground tSC) 
          (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 bSC) 
          (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 make-tv-pixmap (w h active spec)
  (with (foreground (if active clientActiveBackground  clientBackground)
         tSC (if active clientActiveTopShadowColor clientTopShadowColor)
         bSC (if active clientActiveBottomShadowColor clientBottomShadowColor)
         theTile (pixmap-make w h))
        (with (foreground tSC)
          (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 bSC)
          (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
	))


; RESIZE HANDLE'S FSM :
; ===================

(: resize-plug.fsm
 (fsm-make 
  (state-make
	(on (user-event 'focus-in)
            (: wob-tile (# 'activepixmap wob-property)) )
        (on (user-event 'focus-out)
            (: wob-tile (# 'pixmap wob-property)) )
	(on (buttonpress 1 any)
            (progn
              (do-binding-button 1 (current-event-modifier)
				 'press '(frame border))
              (resize-window)) )
	(do-bindings-state '(frame border))
  )
 )
)


; BORDER'S FSM :
; ============

(: border.fsm
 (fsm-make
  (state-make
        (on (user-event 'focus-in) 
            (: wob-tile (# 'activepixmap wob-property)) )
        (on (user-event 'focus-out)
            (: wob-tile (# 'pixmap wob-property)) )
        (do-bindings-state '(frame border))
  )
 )
)




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

(defunq make-border-plug (pix-expr)
  (with (borderwidth 0
         fsm border.fsm
         pixmap (with (active ()) (eval pix-expr))
         activepixmap (with (active t) (eval pix-expr))
         property (list 'pixmap pixmap 'activepixmap activepixmap))
    (plug-make pixmap)))

(defunq make-resize-plug (cur pix-expr)
  (with (borderwidth 0
         cursor (if resizeCursors (eval cur) frame-cursor)
         fsm resize-plug.fsm
         tile ()
         pixmap (with (active ()) (eval pix-expr))
         activepixmap (with (active t) (eval pix-expr))
         property (list 'pixmap pixmap 'activepixmap activepixmap))
    (plug-make pixmap)))


(: border-plug-tl
   (make-border-plug (make-tl-pixmap frameBorderwidth frameBorderwidth
                                     active () ())))

(: border-plug-tr
   (make-border-plug (make-tr-pixmap frameBorderwidth frameBorderwidth
                                     active () ())))

(: border-plug-tl2
   (make-border-plug (make-tl-pixmap frameBorderwidth (- frameBorderwidth 1)
                                     active () t)))

(: border-plug-tr2
   (make-border-plug (make-tr-pixmap frameBorderwidth (- frameBorderwidth 1)
                                     active () t)))

(: border-plug-bl
   (make-border-plug (make-bl-pixmap frameBorderwidth frameBorderwidth
                                     active ())))

(: border-plug-br
   (make-border-plug (make-br-pixmap frameBorderwidth frameBorderwidth
                                     active ())))

(: top-resize-vplug-left
   (make-resize-plug cursor-NW 
                     (make-tv-pixmap resizeBorderWidth 
                                     (- mwm-resize-style-corner-size
                                        resizeBorderWidth)
                                     active ())))

(: top-resize-vplug-right
   (make-resize-plug cursor-NE 
                     (make-tv-pixmap resizeBorderWidth 
                                     (- mwm-resize-style-corner-size
                                        resizeBorderWidth)
                                     active ())))

(: top-resize-vplug-left2
   (with (fsm resize-plug.fsm
          borderwidth 0
          cursor (if resizeCursors cursor-W frame-cursor)
          tile shadowed-vbar-tile-l
          property (list 'pixmap shadowed-vbar-tile-l 
                         'activepixmap active-shadowed-vbar-tile-l))
     (bar-make 
      (make-resize-plug cursor-NW 
                        (make-tv-pixmap (- resizeBorderWidth 1)
                                        (- mwm-resize-style-corner-size
                                           resizeBorderWidth -1)
                                        active 'left)))))

(: top-resize-vplug-right2
   (with (fsm resize-plug.fsm
          borderwidth 0
          cursor (if resizeCursors cursor-E frame-cursor)
          tile shadowed-vbar-tile-r
          property (list 'pixmap shadowed-vbar-tile-r
                         'activepixmap active-shadowed-vbar-tile-r))
     (bar-make 
      (make-resize-plug cursor-NE 
                        (make-tv-pixmap (- resizeBorderWidth 1)
                                        (- mwm-resize-style-corner-size
                                           resizeBorderWidth -1)
                                        active 'right)))))

(: top-resize-vplug-left-small
   (if (> mwm-resize-style-corner-size 
          (+ 4 clientFontHeight resizeBorderWidth))
       (make-resize-plug cursor-NW 
                         (make-tv-pixmap resizeBorderWidth 
                                         (- mwm-resize-style-corner-size
                                            resizeBorderWidth
                                            clientFontHeight 4)
                                         active ()))))

(: top-resize-vplug-right-small
   (if (> mwm-resize-style-corner-size 
          (+ 4 clientFontHeight resizeBorderWidth))
       (make-resize-plug cursor-NE 
                         (make-tv-pixmap resizeBorderWidth 
                                         (- mwm-resize-style-corner-size
                                            resizeBorderWidth
                                            clientFontHeight 4)
                                         active ()))))

(: bottom-resize-vplug-left
   (make-resize-plug cursor-SW
                     (make-bv-pixmap resizeBorderWidth 
                                     (- mwm-resize-style-corner-size
                                        resizeBorderWidth)
                                     active)))

(: bottom-resize-vplug-right
   (make-resize-plug cursor-SE
                     (make-bv-pixmap resizeBorderWidth 
                                     (- mwm-resize-style-corner-size
                                        resizeBorderWidth)
                                     active)))

(: bottom-resize-hplug-left
   (make-resize-plug cursor-SW
                     (make-bl-pixmap mwm-resize-style-corner-size 
                                     resizeBorderWidth
                                     active t)))

(: bottom-resize-hplug-right
   (make-resize-plug cursor-SE
                     (make-br-pixmap mwm-resize-style-corner-size 
                                     resizeBorderWidth
                                     active t)))

(: top-resize-hplug-left
   (make-resize-plug cursor-NW
                     (make-tl-pixmap mwm-resize-style-corner-size 
                                     resizeBorderWidth
                                     active t ())))

(: top-resize-hplug-right
   (make-resize-plug cursor-NE
                     (make-tr-pixmap mwm-resize-style-corner-size 
                                     resizeBorderWidth
                                     active t ())))

(: top-resize-hplug-left2
   (make-resize-plug cursor-NW
                     (make-tl-pixmap mwm-resize-style-corner-size
                                     (- resizeBorderWidth 1)
                                     active t t)))

(: top-resize-hplug-right2
   (make-resize-plug cursor-NE
                     (make-tr-pixmap mwm-resize-style-corner-size
                                     (- resizeBorderWidth 1)
                                     active t t)))

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

(: border-v-bar
  (with (
        fsm border.fsm
        borderwidth 0
        cursor frame-cursor
        tile border-vbar-tile
        property (list 'pixmap border-vbar-tile
                       'activepixmap active-border-vbar-tile)
       )
   (bar-make)
  )
)

(: border-v-bar-l
  (with (
        fsm border.fsm
        borderwidth 0
        cursor frame-cursor
        tile border-vbar-tile-l
        property (list 'pixmap border-vbar-tile-l
                       'activepixmap active-border-vbar-tile-l)
       )
   (bar-make)
  )
)

(: border-v-bar-r
  (with (
        fsm border.fsm
        borderwidth 0
        cursor frame-cursor
        tile border-vbar-tile-r
        property (list 'pixmap border-vbar-tile-r
                       'activepixmap active-border-vbar-tile-r)
       )
   (bar-make)
  )
)

(: border-top-bar
  (with (
        fsm border.fsm
        borderwidth 0
        cursor frame-cursor
        tile border-hbar-tile
        property (list 'pixmap border-hbar-tile
                       'activepixmap active-border-hbar-tile)
       )
   (bar-make border-plug-tl () border-plug-tr)
  )

)

(: border-top-bar2
  (with (
        fsm border.fsm
        borderwidth 0
        cursor frame-cursor
        tile border-hbar-tile-t
        property (list 'pixmap border-hbar-tile-t
                       'activepixmap active-border-hbar-tile-t)
       )
   (bar-make border-plug-tl2 () border-plug-tr2)
  )

)

(: border-bottom-bar
  (with (
        fsm border.fsm
        borderwidth 0
        cursor frame-cursor
        tile border-hbar-tile
        property (list 'pixmap border-hbar-tile
                       'activepixmap active-border-hbar-tile)
       )
   (bar-make border-plug-bl () border-plug-br)
  )

)
	 
(defun left-bar ()
  (if deco.border
      (if deco.resizeh
          (with (
                 fsm resize-plug.fsm
                 borderwidth 0
                 cursor (if resizeCursors cursor-W frame-cursor)
                 tile shadowed-vbar-tile
                 property (list 'pixmap shadowed-vbar-tile 
                                'activepixmap active-shadowed-vbar-tile)
                 )
            (bar-make (if (not deco.title)
                          top-resize-vplug-left
                        top-resize-vplug-left-small)
                      ()
                      bottom-resize-vplug-left ))
        border-v-bar)))

(defun right-bar ()
  (if deco.border
      (if deco.resizeh
          (with (
                 fsm resize-plug.fsm
                 borderwidth 0
                 cursor (if resizeCursors cursor-E frame-cursor)
                 tile shadowed-vbar-tile
                 property (list 'pixmap shadowed-vbar-tile 
                                'activepixmap active-shadowed-vbar-tile)
                 )
            (bar-make (if (not deco.title)
                          top-resize-vplug-right
                        top-resize-vplug-right-small)
                      ()
                      bottom-resize-vplug-right))
        border-v-bar)))

(defun bottom-bar ()
  (if deco.border
      (if deco.resizeh
          (with (
                 fsm resize-plug.fsm
                 borderwidth 0
                 cursor (if resizeCursors cursor-S frame-cursor)
                 tile shadowed-hbar-tile
                 plug-separator 0
                 property (list 'pixmap shadowed-hbar-tile 
                                'activepixmap active-shadowed-hbar-tile)
                 )
            (bar-make bottom-resize-hplug-left 
                      () 
                      bottom-resize-hplug-right))
        border-bottom-bar)))

(defun top-bar ()
  (if deco.border
      (if deco.resizeh
          (if deco.title
              (with (
                     fsm resize-plug.fsm
                     borderwidth 0
                     cursor (if resizeCursors cursor-N frame-cursor)
                     tile shadowed-hbar-tile-t
                     plug-separator 0
                     property (list 'pixmap shadowed-hbar-tile-t
                                    'activepixmap active-shadowed-hbar-tile-t)
                     )
                (bar-make top-resize-hplug-left2 
                          ()
                          top-resize-hplug-right2))
              (with (
                     fsm resize-plug.fsm
                     borderwidth 0
                     cursor (if resizeCursors cursor-N frame-cursor)
                     tile shadowed-hbar-tile
                     plug-separator 0
                     property (list 'pixmap shadowed-hbar-tile
                                    'activepixmap active-shadowed-hbar-tile)
                     )
                (bar-make top-resize-hplug-left 
                          ()
                          top-resize-hplug-right)))
        (if deco.title
            border-top-bar2
          border-top-bar))))


;============================================================================


; FSM of the text field :
; =====================
(: edit-fsm  
   (fsm-make 
     (state-make
      (on (user-event 'focus-in) 
          (progn
            (: wob-background clientActiveBackground)
            (wob-tile (with (foreground clientActiveForeground)
                            (active-label-make window-name clientFontList)))
            ) )
      (on (user-event 'focus-out)
          (progn
            (: wob-background clientBackground)
            (wob-tile (with (foreground clientForeground)
                            (active-label-make window-name clientFontList)))
            ) )
      (on (user-event 'name-change)
          (progn
            (wob-tile 
             (with (foreground ;(if (# 'got-focus (property-of-wob window))
                    (if (= wob-background clientActiveBackground)
                        clientActiveForeground clientForeground))
                   (active-label-make window-name clientFontList)))
            ))
      (on (buttonpress 1 alone)
          (progn (send-user-event 'press wob-parent)
                 (do-binding-button 1 alone 'press '(title frame))
                 (with (cursor cross-cursor) (move-window))
                 (send-user-event 'release wob-parent)))
      (do-bindings-state '(title frame))
      )
))
    

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

(: title-bar.width (+ 6 clientFontHeight))

(: shadowed-title-bar-tile 
   (make-hbar-tile title-bar.width () ()))

(: active-shadowed-title-bar-tile 
   (make-hbar-tile title-bar.width t ()))

(: shadowed-title-bar-tile2 
   (make-hbar-tile (- title-bar.width 2) () 'title))

(: active-shadowed-title-bar-tile2 
   (make-hbar-tile (- title-bar.width 2) t 'title))

(with (tmp clientActiveTopShadowColor
       clientActiveTopShadowColor clientActiveBottomShadowColor
       clientActiveBottomShadowColor tmp)
  (: pressed-title-bar-tile2 (make-hbar-tile (- title-bar.width 2) t 'title))
)

(: titlebar-fsm 
    (fsm-make
	(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 (buttonpress 1 alone)
                (progn (send-user-event 'press wob)
                       (do-binding-button 1 alone 'press '(title frame))
                       (with (cursor cross-cursor) (move-window))
                       (send-user-event 'release wob)))
	    (do-bindings-state '(title frame))
)))
    

(: editable-plug '(with (borderwidth 0
			 background clientBackground 
			 foreground clientForeground
			 font clientFontList
			 menu ()
			 property (list 'name window-name)
                         fsm edit-fsm)
			(plug-make (label-make window-name))))

(defun title-seam-pixmap (col)
  (with (tile ()
         foreground col)
    (pixmap-make 1 (- title-bar.width 2))))
         
(defun inner-titlebar ()
  (with (
         fsm titlebar-fsm
         property (list 'pixmap shadowed-title-bar-tile2
                        'activepixmap active-shadowed-title-bar-tile2
                        'pressedpixmap pressed-title-bar-tile2)
         lseam (title-seam-pixmap clientTopShadowColor)
         rseam (title-seam-pixmap clientBottomShadowColor)
         alseam (title-seam-pixmap clientActiveTopShadowColor)
         arseam (title-seam-pixmap clientActiveBottomShadowColor)
         tile shadowed-title-bar-tile2
         bar-min-width (- title-bar.width 2)
         bar-max-width bar-min-width
         )
    (bar-make
     (with (property (list 'pixmap lseam 'activepixmap alseam
                           'pressedpixmap arseam))
       (plug-make lseam))
     () 
     editable-plug 
     () 
     (with (property (list 'pixmap rseam 'activepixmap arseam
                           'pressedpixmap alseam))
       (plug-make rseam))
     )))

(defun make-title-row ()
  (with (bar-min-width (if deco.border 
                           (- title-bar.width 1)
                         title-bar.width)
         bar-max-width bar-min-width
         params1 (+   
                  (if deco.menu (list button-of-menu))
                  (list (bar-make () (inner-titlebar) ()))
                  (if deco.minimize (list button-iconify))
                  (if deco.maximize (list button-zoom)))
         params2 (+ 
                 (if deco.border
                     (if deco.resizeh
                         (list top-resize-vplug-left2)
                       (list border-v-bar-l)))
                 (list (bar-make (eval (+ '(bar-make) params1))))
                 (if deco.border
                     (if deco.resizeh
                         (list top-resize-vplug-right2)
                       (list border-v-bar-r)))
                 ))
    (eval (+ '(bar-make) params2))))

(defun titlebar ()
 (if deco.title
     (with (menu ()
            cursor frame-cursor
            borderwidth 0
            background clientBackground
            fsm ()
            plug-separator 0
            pixmap shadowed-title-bar-tile
            activepixmap active-shadowed-title-bar-tile
            property (list 'pixmap pixmap 'activepixmap activepixmap)
            tile pixmap)
       (if deco.border
           (bar-make (bar-make (top-bar)
                               (make-title-row)))
         (make-title-row))
       )
   (if deco.border (top-bar))
   )
 )

(df mwm-window-fsm ()
		  (fsm-make 
		    (state-make 
			(# 0 (# 'window keyBindings))
			(# 'wfsm (menu-wob menu))
			window-std-behavior
			(do-bindings-state '(window))
		    )
		  )
)


; THE MWM-LIKE WINDOW :
; ===================


(df mwm-win-deco-make ()
 	     (with (inner-borderwidth 1 
		    menu (eval (atom (get-res-value 'windowMenu)))
		    fsm (mwm-window-fsm)
		    cursor frame-cursor
		    borderwidth mwm-ed-borderwidth
		    borderpixel white
		    property (list 'resize-corner-size
				(if deco.resizeh
                                    mwm-resize-style-corner-size 1) )
		    grabs  
			(+      (# 1 (# 'window keyBindings))
				(# 'app-grabs buttonBindings)
				(# 'wgrabs (menu-wob menu))
				window-std-grabs
			)
 		   )
		     (window-make (titlebar) (left-bar)
                                  (right-bar) (bottom-bar) ())
	     )
)

(defname 'mwm-win.data screen. ())

(: default-deco ())

(: mwm-win
   '(with (deco-string (get-res-value "clientDecoration")
	   deco-list ())
      (if window-is-transient-for (: deco-list transientDecoration)
	(if (= deco-string "all")
	    (: deco-list '(border maximize minimize resizeh menu title))

	    (= deco-string "none") (: deco-list ())
	    (: deco-list (listify-string deco-string))))
      (get-deco-ctxt deco-list)
      (mwm-win-deco-make)))

(: all '(maximize minimize menu resizeh border title))

(de get-deco-ctxt (theDeco)
 (: deco.title ())
 (: deco.border ())
 (: deco.maximize ())
 (: deco.minimize ())
 (: deco.menu ())
 (: deco.resizeh ())

 (if (= theDeco 'none) ()
     (= theDeco 'all) (get-deco-ctxt (eval theDeco))
     (while theDeco
      (set (atom (+ "deco." (# 0 theDeco))) t)
      (: theDeco (sublist 1 (length theDeco) theDeco))
     )
 )
)