;; vtwm-window.gwm --- Default windows and icons for VTWM profile.
;;
;; Author: Anders Holst  (aho@sans.kth.se)  
;; Copyright (C) 1995  Anders Holst
;; Version: vtwm-1.0
;; Last change: 14/9 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 the normal windows and icons for the VTWM profile.
;;
;; This file is highly inspired by, and in large parts stolen
;; directly from, the file "twm-titled-win.gwm" by Arup Mukherjee.
;; 

(declare-screen-dependent
    vtwm-borderwidth
    vtwm-bordercolor
    vtwm-active-bordercolor
    vtwm-title-background
    vtwm-title-foreground
    vtwm-title-font
    vtwm-icon-foreground
    vtwm-icon-background
    vtwm-icon-bordercolor
    vtwm-icon-font
    vtwm-fancy-colors
    vtwm-notitle-list
    vtwm-left-plugs
    vtwm-right-plugs
    iconify-pixmap-name
    resize-pixmap-name
    hilite-pixmap-name
    default-icon-pixmap-name
)

;;
;;    USER CUSTOMIZABLE VARIABLES
;;    ---------------------------  
;;    Adjust these in your own profile
;;
(with (wob wob)
  (for screen (list-of-screens)
    (defaults-to
       vtwm-borderwidth 2             ; Borderwidth of most windows
       vtwm-bordercolor black         ; Color of border (inactive window)
       vtwm-active-bordercolor white  ; Color of active window border
       vtwm-title-background white    ; Default background of titlebar
       vtwm-title-foreground black    ; Default foreground of titlebar
       vtwm-title-font (font-make "9x15")   ; Font in titlebar
       vtwm-icon-foreground black     ; Default background of icons
       vtwm-icon-background white     ; Default foreground of icons
       vtwm-icon-bordercolor ()       ; Default bordercolor of icons
       vtwm-icon-font (font-make "fixed")    ; Font in icons
       vtwm-fancy-colors ()           ; List of (wintype fg bg) specifications
       vtwm-notitle-list '(Gwm (window-is-transient-for)) ; Untitled windows
       default-icon-pixmap-name ()    ; Pixmap filename for default icon
       hilite-pixmap-name "gray"      ; Filename for active titlebar pattern
       vtwm-left-plugs '(("iconify2" (iconify-window)))
       vtwm-right-plugs '(("resize2" (twm-resize-window) t))
           ; Left and right plugs in the titlebar, a list of pairs
           ; or tripplets:  ( <pixmap-file> <action> [<on-press>] )
           ; The optional third element <on-press> signals that the action
           ; should be run on button-press, rather than button-release.
    )
  )
)

;; 
;;    USER CUSTOMIZABLE BEHAVIORS
;;    ---------------------------
;;    Adjust these in your own profile
;;    

(if (not (boundp 'standard-title-behavior))
    (: standard-title-behavior
       ()))

(if (not (boundp 'window-behavior))
    (: window-behavior
       ()))

(if (not (boundp 'icon-behavior))
    (: icon-behavior
       (state-make
           (on (buttonpress any alone) (iconify-window))
           )))

(if (not (boundp 'standard-behavior))
    (: standard-behavior
       (state-make
           (on (buttonpress 1 any) (raise-lower-move-window))
           (on (buttonpress 2 any) (move-window))
           (on (buttonpress 3 any) (lower-window))
           )))


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

(defun twm-resize-window ()
  (with (resize-style 1
         mwm-resize-style-corner-size 1
         mwm-resize-style-catch-corners 1
         cursor (cursor-make 52)
         cursor-NW cursor
         cursor-NE cursor
         cursor-SW cursor
         cursor-SE cursor
         cursor-N cursor
         cursor-W cursor
         cursor-S cursor
         cursor-E cursor)
    (resize-window)))

;; VTWM Titled Window

(: vtwm-window-behavior
    (state-make
	(on name-change 
            (progn
              (send-user-event 'name-change)
              (icon-mgr-update)
              (if (window-icon?)
                  (send-user-event 'icon-name-change window-icon))))
        (on focus-in
            (progn 
              (if autoraise (raise-window))
              (send-user-event 'focus-in)
              (wob-borderpixel vtwm-active-bordercolor)
              (if autocolormap (set-colormap-focus))
              (icon-mgr-focusin)))
        (on focus-out
            (progn 
              (send-user-event 'focus-out)
              (wob-borderpixel vtwm-bordercolor)
              (icon-mgr-focusout)))
	(on enter-window 
            (if (not autofocus)
                (if autoraise (raise-window))
              (progn (if autoraise (raise-window))
                     (set-focus)
;                     (if autocolormap (set-colormap-focus))
              )))
	(on leave-window (if autofocus
                             (progn 
                               (set-focus ())
                               (if autocolormap (set-colormap-focus ())))))
	(on (property-change "WM_ICON_NAME")
            (progn
              (icon-mgr-update)
              (if (window-icon?)
                  (send-user-event 'icon-name-change window-icon))))
	(on window-icon-pixmap-change 
	    (if (window-icon?)
		(send-user-event 'icon-pixmap-change window-icon)))
        ))

(defun vtwm-get-color ()
  (if vtwm-fancy-colors
      (with (wob window-window)
        (matches-cond vtwm-fancy-colors))))

(defun vtwm-hilite-pixmap ()
  (or (# 'hp wob)
      (# 'hp (## 'hp wob
               (pixmap-make vtwm-title-background
                            hilite-pixmap-name
                            vtwm-title-foreground)))))

(defun vtwm-no-hilite-pixmap ()
  (or (# 'np wob)
      (# 'np (## 'np wob
               (pixmap-make vtwm-title-background
                            hilite-pixmap-name
                            vtwm-title-background)))))

(defun vtwm-titlebar-plug (pixmap-file expr press)
  (with (pixmap (if (= (type pixmap-file) 'pixmap)
                    pixmap-file
                  (pixmap-make vtwm-title-background
                               (eval pixmap-file)
                               vtwm-title-foreground))
         fsm (if (= (type expr) 'fsm)
                 expr
               (fsm-make 
                 (state-make
                   (eval (list 'on
                               (if press 
                                   '(buttonpress any alone)
                                 '(buttonrelease any alone))
                               expr)))))
         borderwidth 0
         background vtwm-title-background)
    (plug-make pixmap)))

(defun vtwm-make-pluglist (lst)
  (with (i 0
         res (list-make (+ (* 2 (length lst)) 1)))
    (for ele lst
      (## i res (vtwm-space-plug 2))
      (## (+ 1 i) res (vtwm-titlebar-plug (# 0 ele) (# 1 ele) (# 2 ele)))
      (setq i (+ i 2)))
    (## i res (vtwm-space-plug 2))
    res))

(: vtwm-name-fsm  
    (fsm-make 
       (state-make
         (on (user-event 'name-change)
             (with (borderwidth 0 
	            background (or (# 'bg wob-parent) vtwm-title-background)
                    foreground (or (# 'fg wob-parent) vtwm-title-foreground)
                    font vtwm-title-font
                    label-horizontal-margin 6
                    label-vertical-margin 1)
               (wob-tile (label-make window-name)))
               ))))

(defun vtwm-name-plug ()
  (with (background vtwm-title-background 
         foreground vtwm-title-foreground
         font vtwm-title-font
         fsm vtwm-name-fsm
         borderwidth 0 
         label-horizontal-margin 6
         label-vertical-margin 1)
    (plug-make (label-make window-name))))

(defun vtwm-space-plug (wdt)
  (with (background vtwm-title-background 
         foreground vtwm-title-background
         borderwidth 0
         bar-min-width wdt
         fsm ())
    (bar-make )))
		
    
(: vtwm-titlebar-behavior 
   (state-make
    (on (user-event 'focus-in)
        (wob-borderpixel vtwm-active-bordercolor))
    (on (user-event 'focus-out)
        (wob-borderpixel vtwm-bordercolor))))
    
(defun vtwm-titlebar-fsm  ()
  (fsm-make
    (state-make
     vtwm-titlebar-behavior
     standard-title-behavior)))

(: vtwm-titlebar-inner-behavior
   (state-make
    (on (user-event 'focus-in)
        (with (vtwm-title-background (or (# 'bg wob) vtwm-title-background)
               vtwm-title-foreground (or (# 'fg wob) vtwm-title-foreground))
          (wob-tile (vtwm-hilite-pixmap))))
    (on (user-event 'focus-out)
        (with (vtwm-title-background (or (# 'bg wob) vtwm-title-background)
               vtwm-title-foreground (or (# 'fg wob) vtwm-title-foreground))
          (wob-tile (vtwm-no-hilite-pixmap))))
    ))
 
(defun vtwm-titlebar-inner-fsm  ()
  (fsm-make
     vtwm-titlebar-inner-behavior))

    
(defun vtwm-middle-bar ()
  (with (borderwidth 0
         property ()
         background vtwm-title-background
         fsm ())
    (bar-make (bar-make (vtwm-space-plug 3)
                        (vtwm-name-plug) 
                        (vtwm-space-plug 3)
                        (bar-make (with (borderwidth 2
                                         borderpixel vtwm-title-background
                                         fsm (vtwm-titlebar-inner-fsm))
                                    (bar-make ())))
                        (vtwm-space-plug 3)))))

(defun vtwm-titlebar ()
  (with (borderwidth vtwm-borderwidth
         cols (vtwm-get-color)
         vtwm-title-foreground (or (# 0 cols) vtwm-title-foreground)
         vtwm-title-background (or (# 1 cols) vtwm-title-background)
         property (+ (list 'fg vtwm-title-foreground
                           'bg vtwm-title-background)
                     property)
         background vtwm-title-background
         fsm (vtwm-titlebar-fsm) 
         plug-separator 0
         borderpixel vtwm-bordercolor
         bar-min-width 1 bar-max-width 30
         bar-list (+ (vtwm-make-pluglist vtwm-left-plugs)
                     (list (vtwm-middle-bar))
                     (vtwm-make-pluglist vtwm-right-plugs)))
    (apply bar-make bar-list)))

(: vtwm-borderbar-behavior
   (state-make
      (on (user-event 'focus-in)
          (wob-background vtwm-active-bordercolor))
      (on (user-event 'focus-out)
          (wob-background vtwm-bordercolor))))

(defun vtwm-borderbar-fsm ()
  (fsm-make
    (state-make
     vtwm-borderbar-behavior
     standard-title-behavior)))

(defun vtwm-borderbar ()
  (if (> vtwm-borderwidth 0)
      (with (borderwidth 0
             background vtwm-bordercolor
             fsm (vtwm-borderbar-fsm)
             plug-separator 0
             bar-min-width vtwm-borderwidth
             bar-max-width vtwm-borderwidth)
        (bar-make ))))

(defun vtwm-titled-window-fsm ()
  (fsm-make
    (state-make
     window-behavior
     standard-behavior
     vtwm-window-behavior
     )))

(defun vtwm-titled-window ()
  (with (inner-borderwidth 0
         borderwidth 0
         fsm (vtwm-titled-window-fsm)
         borderpixel vtwm-bordercolor)
    (window-make (vtwm-titlebar)
                 (vtwm-borderbar)
                 (vtwm-borderbar)
                 (vtwm-borderbar)
                 ())))


;; VTWM Simple Window

(defun vtwm-simple-window-fsm ()
  (fsm-make
    (state-make
     window-behavior
     standard-behavior
     vtwm-window-behavior
     )))

(defun vtwm-simple-window ()
  (with (inner-borderwidth 0
         borderwidth vtwm-borderwidth
         fsm (vtwm-simple-window-fsm)
         borderpixel vtwm-bordercolor)
    (window-make () () () () ())))


;; VTWM Simple Icon

(: vtwm-icon-behavior
    (state-make
      ()  ; Nothing, as for now. Most things are handled from the window.
      ))

(defun vtwm-smart-icon-name ()
  (if (= window-icon-name "icon") ; Means that no icon name was specified
      window-name
    window-icon-name))

(defun vtwm-simple-icon-fsm ()
  (fsm-make
    (state-make
     icon-behavior
     standard-behavior
     vtwm-icon-behavior
     )))

(: vtwm-icon-label-fsm
   (fsm-make
     (state-make
       (on (user-event 'icon-name-change)
           (with (foreground vtwm-icon-foreground
                  background vtwm-icon-background
                  font vtwm-icon-font
                  label-horizontal-margin 2
                  label-vertical-margin 1)
             (wob-tile (label-make (vtwm-smart-icon-name))))))))

(: vtwm-icon-pixmap-fsm
   (fsm-make
     (state-make
       (on (user-event 'icon-pixmap-change)
           (with (foreground vtwm-icon-foreground
                  background vtwm-icon-background)
             (wob-tile (window-icon-pixmap)))))))

(defun vtwm-icon-get-plug ()
  (or (window-icon-window)
      (with (foreground vtwm-icon-foreground
             background vtwm-icon-background
             borderwidth 0
             pm ()
             fsm vtwm-icon-pixmap-fsm)
        (if (setq pm (std-resource-get 'GwmIconPixmap))
            (plug-make (pixmap-make pm))
          (setq pm (window-icon-pixmap))
            (plug-make pm)
          default-icon-pixmap-name
            (plug-make (pixmap-make default-icon-pixmap-name))
            ()))))

(defun vtwm-icon-get-label ()
  (with (foreground vtwm-icon-foreground
         background vtwm-icon-background
         font vtwm-icon-font
         label-horizontal-margin 2
         label-vertical-margin 1
         borderwidth 0
         fsm vtwm-icon-label-fsm)
    (plug-make (label-make (vtwm-smart-icon-name)))))

(defun vtwm-simple-icon ()
  (with (borderwidth 0
         inner-borderwidth vtwm-borderwidth
         cols (vtwm-get-color)
         vtwm-icon-foreground (or (# 0 cols) vtwm-icon-foreground)
         vtwm-icon-background (or (# 1 cols) vtwm-icon-background)
         foreground vtwm-icon-foreground
         background vtwm-icon-background
         borderpixel (or vtwm-icon-bordercolor vtwm-bordercolor)
         fsm (vtwm-simple-icon-fsm)
         center-plug (vtwm-icon-get-plug)
         label-plug (vtwm-icon-get-label))
    (if center-plug
        (with (tile t)
          (window-make ()
                       (bar-make ())
                       (bar-make ())
                       (bar-make () label-plug ())
                       center-plug))
      (window-make () () () () label-plug))))


;; VTWM Window 

(defun vtwm-window ()
  (if (matches-list vtwm-notitle-list)
      (vtwm-simple-window)
    (vtwm-titled-window)))

