; SIMPLEST DECORATION
; ===================

;;File: simple-win.gwm -- simple window decoration
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;Revision: 1.6 -- Aug 13 1991
;;State: Exp
;;GWM Version: 1.7

;;============================================================================
;; INITS
;;============================================================================

;; first we declare as screen-dependent all the screen-dependent values we will
;; use (i.e. colors, pop-ups, pixmaps and cursors)
;; this file will normally be loaded once.

(declare-screen-dependent
  simple-win.active.background
  simple-win.background
  simple-win.active.label.background
  simple-win.label.background
  simple-win.active.label.foreground
  simple-win.label.foreground
  simple-win.active.label.border
  simple-win.label.border
  simple-win.context
)


;; We set to their default values all the simple-win.* customizable
;; values that the user hadn't set
;; here we say that some values can be nil, to mean: just use the same value
;; as the inactive value
;; tile can also be given

;; first, the screen-independent ones:

(defaults-to
  simple-win.active.font ()
  simple-win.font name-font
  simple-win.active.label.borderwidth ()
  simple-win.label.borderwidth 1
  simple-win.label ()
  simple-win.legend "top"
  simple-win.lpad 1
  simple-win.rpad 1
)

;; then the screen-dependent:
;; (we protect the value of the current wob which will be modified by the loop)

(with (wob wob)
  (for screen (list-of-screens)

    (defaults-to
      simple-win.active.background darkgrey
      simple-win.background grey
      simple-win.active.label.background ()
      simple-win.label.background white
      simple-win.active.label.foreground ()
      simple-win.label.foreground black
      simple-win.active.label.border ()
      simple-win.label.border black
      )

;; we declare the the context (pairs of variables/values) that will be inbedded
;; into the window, accessible in the window wool property of key 'context.
;; these get initilized from their global defaults.

    (setq simple-win.context (list
      'active-label? ()
      'active.background  simple-win.active.background 
      'background simple-win.background
      'active.font  simple-win.active.font 
      'font simple-win.font
      'active.label.background  simple-win.active.label.background 
      'label.background simple-win.label.background
      'active.label.foreground  simple-win.active.label.foreground 
      'label.foreground simple-win.label.foreground
      'active.label.borderwidth  simple-win.active.label.borderwidth 
      'label.borderwidth simple-win.label.borderwidth
      'active.label.border  simple-win.active.label.border 
      'label.border simple-win.label.border
      'label ()
      'legend "top"
      'lpad 1
      'rpad 1
    ))

))

;;============================================================================
;; FSMs
;;============================================================================
;; here we declare the fsms of the deco. 
;; the idea is that all window-dependent values should be accessed through the
;; 'context property-list in the window property-list where they have been
;; put at built tiome, by the main simple-win function.

;; the title bar: will change background color with focus

(: simple-win.titlebar-fsm
  (fsm-make
    (state-make
      (on (user-event 'focus-in)
	(wob-background (# 'active.background (# 'context window)))
      )
      (on (user-event 'focus-out)
	(wob-background (# 'background (# 'context window)))
      )
      standard-title-behavior
      standard-behavior))
)

;; here we process optionnaly the window-name by an optional "label"
;; customisation argument that can be a function

(de simple-win.name ()
  (with (new-label
      (if label
	(if 
	  (= (type label) 'string)
	  label
	  (eval (list label window-name))
	)
	window-name
    ))
    (if (and (= (type new-label) 'string) (not (= "" new-label)))
      new-label
      window-name
    )
))

    
;; the window name plug: may change with focus (two different fsms in each 
;; case to make less X calls), and must update name when window name is changed
;; which is forwarded to us by the standard-behavior in the form of a 
;; (user-event 'name-change) event

(: simple-win.label-fsm
  (fsm-make
    (state-make
      (on (user-event 'name-change)
	(with (context (# 'context window)
	    label (# 'label context)
	    font (# 'font context)
	    background (# 'label.background context)
	    foreground (# 'label.foreground context)
	  )
	  (wob-tile (label-make (simple-win.name)))))
      standard-title-behavior
      standard-behavior)))

(: simple-win.active.label-fsm
  (fsm-make
    (setq inactive (state-make
	(on (user-event 'focus-in)
	  (wob-tile (# 'active-label window-property))
	  active
	)
	(on (user-event 'name-change)
	  (with (context (# 'context window)
	      label (# 'label context)
	      font (# 'font context)
	      background (# 'label.background context)
	      foreground (# 'label.foreground context)
	      tile (label-make (simple-win.name))
	      font (# 'active.font context)
	      background (# 'active.label.background context)
	      foreground (# 'active.label.foreground context)
	      atile (label-make (simple-win.name))
	    )
	    (## 'inactive-label window tile)
	    (## 'active-label window atile)
	    (wob-tile tile)))
	standard-title-behavior
	standard-behavior))
    (setq active (state-make
	(on (user-event 'focus-out)
	  (wob-tile (# 'inactive-label window-property))
	  inactive
	)
	(on (user-event 'name-change)
	  (with (context (# 'context window)
	      label (# 'label context)
	      font (# 'font context)
	      background (# 'label.background context)
	      foreground (# 'label.foreground context)
	      tile (label-make (simple-win.name))
	      font (# 'active.font context)
	      background (# 'active.label.background context)
	      foreground (# 'active.label.foreground context)
	      atile (label-make (simple-win.name))
	    )
	    (## 'inactive-label window tile)
	    (## 'active-label window atile)
	    (wob-tile atile)))
	standard-title-behavior
	standard-behavior))
))
  
;;============================================================================
;; The actual decoration
;;============================================================================
;; for customisation: we build a context as the sum of :
;; - the global defaults: simple-win.context
;; - the value stored by customize under the 'simple-win resource
;; - the arguments passed to simple-win
;; the we obtain a context, that we snapshot by context-save, that we will put
;; on the window itself (via property) for later use by the fsms

(defun simple-win args
  (if (= window root-window)		; trap user errors
    (trigger-error "Decoration function \"simple-win\" called on root window")
  )
  (setq simple-icon.oldfont font)	;hack due to bug, we save this value...
  (with-eval (+ simple-win.context
      (get-context (std-resource-get 'SimpleWin 'simple-win))
      args
    )					; concatenates the context
    ;; fix default values which are still ()
    (default-if-nil
      active.background background
      active.font font
      active.label.background label.background
      active.label.foreground label.foreground
      active.label.borderwidth label.borderwidth
      active.label.border label.border
    )
    ;; we compute this value to know if we can have a simple fsm if the
    ;; the title plug isn't supposed to change.
    (setq active-label? (not (and
	  (= active.background background)
	  (= active.font font)
	  (= active.label.background label.background)
	  (= active.label.foreground label.foreground)
	  (= active.label.borderwidth label.borderwidth)
	  (= active.label.border label.border)
    )))
    (with (
	fsm window-fsm
	context (context-save simple-win.context) ; snapshot
	grabs window-grabs
	inactive-label (with (
	    background label.background
	    foreground label.foreground
	    borderwidth label.borderwidth
	    borderpixel label.border
	  )
	  (label-make (simple-win.name))
	)
	;; put context in window property list
	property (+ property (list 'context context)
	  (list
	    'label label
	    'inactive-label (if active-label? inactive-label ())
	    'active-label (if active-label? (with (
		  font active.font
		  background active.label.background
		  foreground active.label.foreground
		  borderwidth active.label.borderwidth
		  borderpixel active.label.border
		)
		(label-make (simple-win.name))
	      )
	      ()
      ))))
      ;; then build the window
      (setq simple-win.result (window-make
	  (if (= legend "top") (simple-win.bar-make))
	  (if (= legend "left") (simple-win.bar-make))
	  (if (= legend "right") (simple-win.bar-make))
	  (if (= legend "base") (simple-win.bar-make))
	  ()
  ))))
  (setq font simple-icon.oldfont)	;hack due to bug
  simple-win.result
)

(defun simple-win.bar-make ()
  (with (
      borderwidth (if (= tile t) 0 1)
      fsm simple-win.titlebar-fsm
      expr (+ 
	(list 'bar-make)
	(list-make lpad)
	'((with (
	      fsm (if active-label? simple-win.active.label-fsm
		simple-win.label-fsm
	    ))
	    (with (borderwidth label.borderwidth)
	      (plug-make inactive-label)
	)))
	(list-make rpad)
    ))
    (eval expr)
))