; Frame with name on the right
; Iconify, Maximise, Close and Stayontop buttons on the left
; This is my first attempt at writing a gwm window decoration
; ===========================================================================

;;File: cutewin.gwm
;;Author: Sundar Ranganathan - Techlead Corporation Inc.
;;Credit: Colas Nahaboo - Generously borrowed from Colas' simple-ed-win.gwm
;;GWM Version: 1.8c

(defaults-to
  cutewin.borderwidth 3
  cutewin.font (font-make "-*-clean-bold-*-*-*-16-*-*-*-*-*-*-*")
  cutewin.active darkgrey
  cutewin.inactive grey
  cutewin.label.background (color-make 'navyblue)
  cutewin.label.foreground white
  edit-keys.return "Return"
  edit-keys.backspace "BackSpace"
  edit-keys.delete "Delete"

  cutewin.context (list
    'borderwidth cutewin.borderwidth
    'font cutewin.font
    'active cutewin.active
    'inactive cutewin.inactive
    'background cutewin.label.background
    'foreground cutewin.label.foreground
  )
)

(: cutewin.maximise-fsm
  (fsm-make 
    (state-make 
      (on (buttonpress 1 any)
          (wob-pixmap (pixmap-load "maximise_pressed.xpm")))
      (on (buttonrelease 1 any)
        (with (cerx (current-event-relative-x)
               cery (current-event-relative-y))
        (progn
	   (wob-pixmap (pixmap-load "maximise.xpm"))
           (if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
	       (progn (resize-window screen-width screen-height) (move-window 0 0))
        ))))
      standard-title-behavior
      standard-behavior
)))

(: cutewin.close-fsm
  (fsm-make 
    (state-make 
      (on (buttonpress 1 any)
          (wob-pixmap (pixmap-load "close_pressed.xpm")))
      (on (buttonrelease 1 any)
        (with (cerx (current-event-relative-x)
               cery (current-event-relative-y))
        (progn
	   (wob-pixmap (pixmap-load "close.xpm"))
           (if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
	       (delete-window))
        )))
      standard-title-behavior
      standard-behavior
)))

(: cutewin.kill-fsm
  (fsm-make 
    (state-make 
      (on (buttonpress 1 any)
          (wob-pixmap (pixmap-load "kill_pressed.xpm")))
      (on (buttonrelease 1 any)
        (with (cerx (current-event-relative-x)
               cery (current-event-relative-y))
        (progn
	   (wob-pixmap (pixmap-load "kill.xpm"))
           (if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
	       (kill-window))
        )))
      standard-title-behavior
      standard-behavior
)))

(: cutewin.iconise-fsm
  (fsm-make 
    (state-make 
      (on (buttonpress 1 any)
          (wob-pixmap (pixmap-load "iconise_pressed.xpm")))
      (on (buttonrelease 1 any)
        (with (cerx (current-event-relative-x)
               cery (current-event-relative-y))
        (progn
	   (wob-pixmap (pixmap-load "iconise.xpm"))
           (if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
	      (progn (iconify-window)(raise-window)))
        )))
      standard-title-behavior
      standard-behavior
)))

(: cutewin.inform-fsm
  (fsm-make 
    (state-make 
      (on (buttonpress 1 any)
          (wob-pixmap (pixmap-load "inform_pressed.xpm")))
      (on (buttonrelease 1 any)
        (with (cerx (current-event-relative-x)
               cery (current-event-relative-y))
        (progn
	   (wob-pixmap (pixmap-load "inform.xpm"))
           (if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
	      (print-window-info))
        )))
      standard-title-behavior
      standard-behavior
)))

(: cutewin.stayontop-fsm
   (fsm-make
      (state-make
        (on (buttonpress 1 any)
            (wob-pixmap (pixmap-load "stayontop_pressed.xpm")))
        (on (buttonpress 2 any)
            (wob-pixmap (pixmap-load "stayonbottom_pressed.xpm")))
        (on (buttonrelease 1 any)
        (with (cerx (current-event-relative-x)
               cery (current-event-relative-y))
        (progn
	   (wob-pixmap (pixmap-load "stayontop.xpm"))
           (if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
	       (float.toggle 'up))
        )))
        (on (buttonrelease 2 any)
        (with (cerx (current-event-relative-x)
               cery (current-event-relative-y))
        (progn
	   (wob-pixmap (pixmap-load "stayontop.xpm"))
           (if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
	       (float.toggle 'down))
        )))
        standard-title-behavior
        standard-behavior
)))

(: cutewin.staynormal-fsm
   (fsm-make
      (state-make
        (on (buttonpress 1 any)
            (wob-pixmap (pixmap-load "staynormal_pressed.xpm")))
        (on (buttonrelease 1 any)
        (with (cerx (current-event-relative-x)
               cery (current-event-relative-y))
        (progn
	   (wob-pixmap (pixmap-load "staynormal.xpm"))
           (if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
	       (float.toggle ()))
        )))
      standard-title-behavior
      standard-behavior
)))

(: cutewin.size-fsm
   (fsm-make
      (state-make
         (on (user-event 'resize)
             (wob-tile (label-make (+ "Width: " (itoa window-width) " Height: " (itoa window-height)) cutewin.font )))
      standard-title-behavior
      standard-behavior
)))

(: cutewin.position-fsm
   (fsm-make
      (state-make
         (on (user-event 'windowmove)
             (wob-tile (label-make (+ "X: " (itoa window-x) " Y: " (itoa window-y)) cutewin.font )))
      standard-title-behavior
      standard-behavior
)))

(: cutewin.titleplug-fsm
   (fsm-make
      (state-make
	 (on (user-event 'name-change) 
	     (with (foreground cutewin.label.foreground)
	      (wob-tile (active-label-make window-name cutewin.font))))
)))

(: cutewin.close-plug 
   '(with (borderwidth 0 background cutewin.label.background
		      foreground cutewin.label.foreground
                      cursor
                      (with (background (color-make 'DeepPink)
	                  foreground (color-make 'yellow))
                        (cursor-make XC_hand2)
                      )
		      borderpixel background fsm cutewin.close-fsm)
	(plug-make (pixmap-load "close.xpm"))))

(: cutewin.kill-plug
   '(with (borderwidth 0 background cutewin.label.background
		      foreground cutewin.label.foreground
                      cursor
                      (with (background (color-make 'DeepPink)
	                  foreground (color-make 'yellow))
                        (cursor-make XC_hand2)
                      )
		      borderpixel background fsm cutewin.kill-fsm)
	(plug-make (pixmap-load "kill.xpm"))))

(: cutewin.maximise-plug
   '(with (borderwidth 0 background cutewin.label.background
				 foreground cutewin.label.foreground
                      cursor
                      (with (background (color-make 'DeepPink)
	                  foreground (color-make 'yellow))
                        (cursor-make XC_hand2)
                      )
		       borderpixel background fsm cutewin.maximise-fsm)
	(plug-make (pixmap-load "maximise.xpm"))))

(: cutewin.iconise-plug
   '(with (borderwidth 0 background cutewin.label.background
				 foreground cutewin.label.foreground
                      cursor
                      (with (background (color-make 'DeepPink)
	                  foreground (color-make 'yellow))
                        (cursor-make XC_hand2)
                      )
		       borderpixel background fsm cutewin.iconise-fsm)
	(plug-make (pixmap-load "iconise.xpm"))))

(: cutewin.inform-plug
   '(with (borderwidth 0 background cutewin.label.background
				 foreground cutewin.label.foreground
                      cursor
                      (with (background (color-make 'DeepPink)
	                  foreground (color-make 'yellow))
                        (cursor-make XC_hand2)
                      )
		       borderpixel background fsm cutewin.inform-fsm)
	(plug-make (pixmap-load "inform.xpm"))))

(: cutewin.stayontop-plug
   '(with (borderwidth 0 background cutewin.label.background
				 foreground cutewin.label.foreground
                      cursor
                      (with (background (color-make 'DeepPink)
	                  foreground (color-make 'yellow))
                        (cursor-make XC_hand2)
                      )
		       borderpixel background fsm cutewin.stayontop-fsm)
	(plug-make (pixmap-load "stayontop.xpm"))))

(: cutewin.staynormal-plug
   '(with (borderwidth 0 background cutewin.label.background
				 foreground cutewin.label.foreground
                      cursor
                      (with (background (color-make 'DeepPink)
	                  foreground (color-make 'yellow))
                        (cursor-make XC_hand2)
                      )
		       borderpixel background fsm cutewin.staynormal-fsm)
	(plug-make (pixmap-load "staynormal.xpm"))))

(: cutewin.title-plug
   '(with (borderwidth 0 background cutewin.label.background
				 foreground cutewin.label.foreground
                                 font cutewin.font
		       borderpixel background fsm cutewin.titleplug-fsm)
	(plug-make '(label-make window-name cutewin.font))))

(: cutewin.size-plug
   '(with (borderwidth 0 background cutewin.label.background
				 foreground cutewin.label.foreground
                                 font cutewin.font
		       borderpixel background fsm cutewin.size-fsm)
	(plug-make '(label-make (+ "Width: " (itoa window-width) " Height: " (itoa window-height)) cutewin.font ))))

(: cutewin.position-plug
   '(with (borderwidth 0 background cutewin.label.background
				 foreground cutewin.label.foreground
                                 font cutewin.font
		       borderpixel background fsm cutewin.position-fsm)
	(plug-make '(label-make (+ "X: " (itoa window-x) " Y: " (itoa window-y)) cutewin.font ))))

(defun update-icon (update-icon.title)
  (if (window-icon?)
      (send-user-event 'get-title (window-icon))))

(: cutewin.titlebar-fsm 
  (fsm-make
    (state-make
      (on (user-event 'focus-in)  (wob-background cutewin.active))
      (on (user-event 'focus-out) (wob-background cutewin.inactive))
      standard-title-behavior
      standard-behavior)))

(: cutewin.titlebar
    (with (borderwidth 1 background cutewin.inactive
	fsm cutewin.titlebar-fsm
        plug-separator 1
	borderpixel cutewin.label.foreground
      )
      (bar-make () cutewin.title-plug ())))

(: cutewin.rightbar
   (with (borderwidth 1 background cutewin.inactive
          fsm cutewin.titlebar-fsm
          plug-separator 1
          borderpixel cutewin.label.foreground
   )
   (bar-make cutewin.inform-plug cutewin.iconise-plug cutewin.maximise-plug
             cutewin.stayontop-plug cutewin.staynormal-plug cutewin.close-plug
             () cutewin.kill-plug)))

(: cutewin.bottombar
   (with (borderwidth 1 background cutewin.inactive
          fsm cutewin.titlebar-fsm
          plug-separator 1
          borderpixel cutewin.label.foreground
   )
   (bar-make cutewin.size-plug () cutewin.position-plug)))

(: cutewin.result '(with (inner-borderwidth 1 fsm cutewin.window-fsm 
		    borderwidth cutewin.borderwidth
		    borderpixel cutewin.inactive)
;		    grabs (+ window-grabs 
;			     (if (and (boundp 'emacs-mouse-loaded) 
;				      emacs-mouse-loaded)
;				 (list (button any with-control)))))
			     (window-make cutewin.titlebar () cutewin.rightbar
                                          cutewin.bottombar ())))

(defname 'cutewin.data screen. ())
(df cutewin () (if cutewin.data cutewin.data
			 (: cutewin.data (eval cutewin.result))))


(: cutewin.window-fsm
  (fsm-make
    (state-make
      (on focus-in
	(progn
	  (if autoraise (raise-window))
	  (send-user-event 'focus-in)
	  (wob-borderpixel cutewin.active)))
      (on focus-out
	(progn (send-user-event 'focus-out)
	  (wob-borderpixel cutewin.inactive)))
      window-behavior
      standard-behavior
)))

(if (not (boundp 'cutewin-move-window-orig))
    (progn
      (: cutewin-move-window-orig move-window)
      (defun move-window args
        (eval (+ (list 'cutewin-move-window-orig) args))
        (send-user-event 'windowmove))
))

(if (not (boundp 'cutewin-resize-window-orig))
    (progn
      (: cutewin-resize-window-orig resize-window)
      (defun resize-window args
        (eval (+ (list 'cutewin-resize-window-orig) args))
        (send-user-event 'resize))
))