; GWM: an exemple of a user customisation file for the standard profile
; =====================================================================
;; code indented by the amc-lisp package of epoch

; How to add code to each window decoration
;(setq opening
;  (+ opening '((? "Decorating " window-status " " window-name "\n"))))

;;=============================================================================
;;                    Colas: My personal profile for gwm-1.7
;;=============================================================================

;; You may want to put this profile as "site-defs.gwm", and make users include
;; it in their smaller profiles...

;;=============================================================================
;;                    general setup: menus, cursors
;;=============================================================================

					; global flags
(setq confine-windows t)		; windows stay on screen
					; cursors

;; for me only: how to set the background pattern to a screen-dependent value

(setq screen-background (color-make "lightseagreen"))
(setq screen-opening (+ screen-opening 
    (list '(wob-background screen-background)) 
))

(if (not (= 0 (length (getenv "HOSTNAME"))))
  (setq hostname (getenv "HOSTNAME"))
  (setq hostname "local")
)

(if (= (getenv "USER") "colas")		
  (progn
    (setq USER 'colas)
    ;; (setq root-cursor  (cursor-make 2))
    (with (background (color-make 'DeepPink)
	foreground (color-make 'DeepPink4))
      (setq cursor  (cursor-make "arrow3d-f" "arrow3d-m"))
    )
    (with (background (color-make 'HotPink)
	foreground (color-make 'HotPink4))
      (setq root-cursor  (cursor-make "arrow3d-f" "arrow3d-m"))
    )
        ;; (setq cursor root-cursor)
    (if (> screen-depth 2)
;;      uncomment these lines to get a "grainy" background
;;      (: screen-tile 
;;        (pixmap-make screen-background "grainy" (color-make "#7bb")))
      (: screen-tile ())
      (> screen-depth 1)
      (: screen-tile (pixmap-make white "back" grey))
      (: screen-tile (pixmap-make "back")))
    
    (set-threshold 1)
    (set-acceleration 2 1)
    (stack-print-level 1000)
  )
  ;; general code for non-me users
  (progn
    (setq USER 'other)
    (stack-print-level 3)
  )
)

					; menus colors & fonts

(setq pop-label.font (font-make "*-helvetica-bold-o-normal--18-*"))
(setq pop-item.font (font-make "*-helvetica-medium-r-normal--14-*"))
(setq pop-item.background (color-make "pink"))
(setq pop-item.foreground (color-make "NavyBlue"))
(setq name-font (font-make "*-times-bold-r-normal--18-*"))
(setq fixed-font (font-make "fixed"))

					;insert a menu item to root menu
(insert-at '(item-make
    "reset backgrnd" (! "xsetroot" "-solid" "lightseagreen")
      )
      root-pop-items
    6
)
    
 


; if you do not see the grid lines when moving/resizing, do a:
; (setq grid-color (bitwise-xor (color-make "fore") (color-make "back")))
; with fore and back being the predominant colors on your screen
; do the same thing with invert-color if you have problems with menus

;;=============================================================================
;;                    general packages
;;=============================================================================

;;=============================================================================
;; NOTE: put here all behavior (fsm) modifications, before loading decorations
;;=============================================================================

;; how to add a function (iconify on control-alt clik-right) to windows,
;; and a delta functionality to raise/move windows on button 1:
;; first, define what to do on these events

(load 'deltabutton)

(: standard-behavior
   (state-make
    (on (buttonpress 1 alone)
	(if (deltabutton) (progn (raise-window)(move-window))
	  (raise-window)))
    (on (buttonpress 1 with-alt)
	(if (deltabutton) (progn (raise-window)(move-window))
	  (raise-window)))
    (on (buttonrelease 3 (together with-alt with-control))
	(progn (iconify-window) (raise-window)))
    standard-behavior
    ))

;; second, "grab" these events to prevent them to go to the decorated 
;; application

(setq window-grabs 
    (+ window-grabs 
       (list (buttonpress 3 (together with-alt with-control)))))

;; I also like to be able to do "Exec Cut" anywhere by Ctrl-Alt-F1
;;================================================================
;; first abbrev for the event
(setq CtrlAltF1 (key "F1" (together with-alt with-control)))

;; second, put the transition in the relevant behaviors
(: standard-behavior (state-make	; for windows & icons
    standard-behavior
    (on CtrlAltF1 (execute-string (+ "(? " cut-buffer ")")))
))
(: root-behavior (state-make		; root window only
    root-behavior
    (on CtrlAltF1 (execute-string (+ "(? " cut-buffer ")")))
))   

;; third, grab these events to catch them anywhere
(: window-grabs (+ window-grabs (list CtrlAltF1)))
(: icon-grabs (+ icon-grabs (list CtrlAltF1)))
(: root-grabs (+ root-grabs (list CtrlAltF1)))

;; last register these changes
(reparse-standard-behaviors)

;; load misc little packages
;;==========================

(load 'float)				; to make sticky windows
(load 'unconf-move)			; to allow control-moving out of screen
;(load 'suntools-keys)			; to add L7 for iconify
(load 'move-opaque)			; to move windows in real time (NeXT)
;(load 'mon-keys)			; M.Newton functions key bindings

;;=============================================================================
;;                    virtual screen
;;=============================================================================

(setq std-virtual.doors '(
    ("Home" screen-background)
    ("Comp" "LightBlue3")
    ("Mail" 
      (pixmap-make (color-make "seagreen3") "grainy" (color-make "seagreen2"))
      background (color-make "seagreen3"))    
    ("WWW" lightgrey door-icon (pixmap-load "netscape-small.xpm"))
    ("Text" "LightYellow3")
    ("Games" grey)
))

(load "std-virtual.gwm")

;;=============================================================================
;; temporary windows
;;=============================================================================

(require 'timeout-win)
(set-window XLogo.tmp (timeout-win simple-ed-win delay 1))

;;=============================================================================
;;                    menus
;;=============================================================================

(if (not (boundp 'Screensaver.menu-added)) (progn
    (setq Screensaver.menu-added t)

    (insert-at '(item-make "Screensaver" (! "xscreensaver-command" "-activate"))
      root-pop-items
      6
    )
))


;;=============================================================================
;; NOTE: Now we can actually load decorations, the fsms have been updated
;;=============================================================================

;;=============================================================================
;;                    simple-ed-win
;;=============================================================================

(: edit-keys.backspace "Delete")
(: edit-keys.delete "Escape")

;; My Bull Icon... comment out this code to get rid of my company's logo :-)

(setq icon-pixmap 		; put the BULL logo in the upper left corner
  (if (= screen-depth 1)
	(pixmap-make white "bull_1" black "bull_2" white)
      (= screen-depth 2)
	(pixmap-make white "bull_1" darkgrey "bull_2" grey)
      (pixmap-make white "bull_1" (color-make "DarkSlateBlue")
			 "bull_2" (color-make "Green")))))

;;=============================================================================
;;                    icon groups
;;=============================================================================

;; I don't want to have only one icon for all my epoch screens!

(setq icon-groups.excluded '(Emacs Xmh XRn MinibufferScreen))
(load "icon-groups")		; iconify groups as a whole

;;=============================================================================
;;                    icons
;;=============================================================================

(setq simple-icon.legend ())		; no title under icons

;; How to have different icon colors. as you can see, customize is quite
;; flexible on how to specify arguments

(customize simple-icon any Xman
  background (color-make "MistyRose")
)
(customize simple-icon any Xedit
  background (color-make "thistle2")
)
(customize simple-icon any Xdir
  (background (color-make "LightSeaGreen"))
)
(customize simple-icon any Xarchie
  (background (color-make "yellow3"))
)
(customize simple-icon any Xls
  (background (color-make "aquamarine1"))
)
(customize simple-icon any Emacs 
  background (color-make "wheat1")
  label 
  (lambdaq (s) 
    (with (ss (match "^\\([^ ]*\\) @ \\([a-z][a-z]*\\)[.].*$" s 1 2)) 
      (if (or (= "" ss)(= '("" "") ss)) s 
	(if (= hostname (# 1 ss)) (# 0 ss) ;omit host name on local host
	  (+ (# 0 ss) " @" (# 1 ss)))
  )))
)

(customize simple-icon any MinibufferScreen
  background (color-make "wheat1"))
(customize simple-icon any Xmh
  background (color-make "LightCyan2")
  foreground (color-make "DeepPink2")
)
(customize simple-icon any XRn
  background (color-make "aquamarine2")
  foreground (color-make "DarkSeaGreen4")
  borderwidth 0
)
(customize simple-icon any XRn.xrncma
  background (color-make "LightGoldenrod2")
)
(customize simple-icon any XPostit
  background (color-make "Red")
  foreground (color-make "Yellow")
)
(customize simple-icon any XClipboard
  background (color-make "IndianRed2")
)
(customize simple-win any XClipboard
  font small-font
  background (color-make "IndianRed2")
  active.background (color-make "IndianRed4")
  label.background (color-make "IndianRed2")
))

;; note that you can specify a client by its class.name.windowname.machine

(customize term-icon any XTerm.Console.Console.any
  '(background (color-make "LightSkyBlue2"))
)
(customize term-icon any XTerm.xterm.any.opossum
  background (color-make "PowderBlue")
)
(customize term-icon any XTerm
  background (color-make "LightBlue2")
)

(customize term-icon any XTerm.hobbes
  '(background (color-make "LightGoldenRod3"))
)
(customize simple-icon any Xmh.any.any.lemur
  background (color-make "LightGoldenRod3")
  foreground (color-make "MidnightBlue")
)
(customize simple-icon any Tk.zircon
  background (color-make "yellow2")
)
(customize simple-icon any Zircon
  background (color-make "yellow2")
)
	  
(set-icon XLess (pixmap-load "xterm.xpm"))
(customize simple-icon any XLess
  background (color-make "LavenderBlush2")
  legend t
  stretch t
  borderwidth 0
)
(customize simple-icon any Zircon.@info
  simple-icon.plug-name "Zircon info"
  background (color-make "yellow2")
)
(customize simple-icon any Tk.zircon.Zircon_Control_Panel
  simple-icon.plug-name "Zircon MAIN"
  background (color-make "yellow2")
)

(defun xpm-icon-zircon (init?)
  (if ( = window-icon-name "*#koala*")
    (pixmap-load (+ window-client-class "-icon." "yes"))
    (pixmap-load (+ window-client-class "-icon." "no"))))
(require 'near-mouse)
(set-placement Zircon near-mouse)

(set-icon-window any Zircon*IRC_Channel_#koala (xpm-icon xpm-icon-zircon))
(set-icon-window any Zircon.channel16.IRC_Channel_#koala (xpm-icon xpm-icon-zircon))
(set-icon-window any Zircon.any.IRC_Channel_#koala (xpm-icon xpm-icon-zircon))

(set-icon XPostit (pixmap-load "xpostit-icon"))
(set-icon-window XTerm.Console ())
(set-icon XTerm.Console (pixmap-load "xterm.xpm"))
(set-icon Pixmap (pixmap-load "pixmap.xpm"))

;;=============================================================================
;;                    affectation of decorations to windows
;;=============================================================================

(set-window any simple-win)	; Any X Client

;; how to fully customize decos: define a Lisp function to choose the
;; deco for the client with full lisp power, then affect it as a deco to 
;; clients

(defun xterm-deco ()
  (if (= window-client-name "test") 'test-win ; atoms
    (= window-client-name "vb") "vb-term"     ; or strings are equivalent
      'simple-ed-win			      ; means load file & execute func
))

(set-window XTerm.Console vb-term)	; XTERM
(set-window XTerm simple-ed-win)	; XTERM

;(setq term-icon:background screen-background)
(setq term-icon:background "none")
(load 'term-icon-xpm.gwm)

(set-icon-window XTerm
  (term-icon-xpm "xterm3" pop-item.font
  (color-make "#73737F7F8A8A")
  (color-make "yellow")))

(setq xterm-decos.sony 
  '(term-icon-xpm "xterm3" pop-item.font
  (color-make "green4")
  (color-make "yellow")))
(set-icon-window XTerm*maki xterm-decos.sony)
(set-icon-window XTerm*lemur xterm-decos.sony)

(setq xterm-decos.indri 
  '(term-icon-xpm "xterm3" pop-item.font
  (color-make "HotPink4")
  (color-make "yellow")))
(set-icon-window XTerm*indri xterm-decos.indri)

(setq xterm-decos.mips 
  '(term-icon-xpm "xterm3" pop-item.font
  (color-make "blue4")
  (color-make "yellow")))
(set-icon-window XTerm*opossum xterm-decos.mips)
(set-icon-window XTerm*aye xterm-decos.mips)
(set-icon-window XTerm*koala xterm-decos.mips)
(set-icon-window XTerm*wombat xterm-decos.mips)


(set-window XLoad no-frame) ; XLOAD
(set-window XPostit no-frame-no-borders)
(set-window XCal no-frame-no-borders)
(set-window XBiff no-frame-no-borders)
(set-window Sxpm no-frame-no-borders)

;(set-window XClock frame-win)	; XCLOCK
(set-window XClock no-frame)	; XCLOCK
(set-window Clock frame-win)

(set-window chaos no-frame)

(set-icon-window any simple-icon) ; Any icon
(set-window client no-frame-no-borders) ; xwud

(set-icon XCol (pixmap-load 'xcol-icon.xpm))

;(load 'waiting-xterm)			; prepared in advance xterms

(set-placement Netrek.wait rows.right-top.placement)
(set-window  Netrek.wait no-frame-no-borders)
(set-window XPmview no-frame-no-borders)
(set-icon TkMan (pixmap-load "LRom1.xpm"))
(set-icon Dayview (pixmap-load "datebook.xpm"))
;;(set-icon Mosaic (pixmap-load "mosaic.xpm"))
(customize simple-icon any Mosaic
  borderwidth 0
)
(set-icon Xfilemanager (pixmap-load "cdrom1.xpm"))

(defun xpm-icon-xrn (init?)
  (if ( = window-icon-name "xrn-nonews")
    (pixmap-load "xrn-nonews")
    (= window-icon-name "xrn-busy")
    (pixmap-load "xrn-busy")
    (pixmap-load "xrn")
))
(defun xpm-icon-xrn2 (init?)
  (if ( = window-icon-name "xrn2-nonews")
    (pixmap-load "xrn2-nonews")
    (= window-icon-name "xrn-busy")
    (pixmap-load "xrn2-busy")
    (pixmap-load "xrn2")
))
(set-icon-window any XRn (xpm-icon xpm-icon-xrn))
(set-icon-window any XRn.xrn2 (xpm-icon xpm-icon-xrn2))
(set-icon-window any XRn.Composition ())
(set-icon-window any XRn.Information ())

(setq bar-max-width 500)


;;=============================================================================
;;                    Netscape
;;=============================================================================

;; I want my netscape search popups under the mouse
(set-placement Netscape.findDialog_popup near-mouse)
(set-placement Netscape.openURL_popup near-mouse)

(set-icon Netscape (pixmap-load "netscape-small.xpm")) ;a nice small logo
(set-icon-window Netscape 'simple-icon)

(customize simple-icon any Netscape
  legend "left"
  stretch t
  borderwidth 0
  background screen-background
  ;;strip the Netscape: prefix from icon titles
  label (lambdaq (s) 
    (if (= s "icon") "Bookmarks" (match "Netscape: \\(.*\\)$" s 1)))
  ;;add behaviors to netscape icons:
  ;; -  selecting an URL and control-middle-mouse on a netscape icon will make
  ;;    this netscape instance open the URL
  ;; -  selecting an URL and control-left-mouse or control-alt-middle-mouse will
  ;;    create a new netscape window on the URL
  icon-grabs '(+ icon-grabs (list 
      (button action-button with-control)
      (button action-button (together with-alt with-control))
      (button select-button with-control)
  ))
  icon-fsm (fsm-make (state-make 
      (state-make
	(on (buttonrelease action-button with-control)
	  (if (match "^[hftp][hftp]*:[/][/][^ ]*$" cut-buffer)
	    (! "netscape-remote" "-id" 
	      (itoa (window-to-client window-window))
	      "-remote" (+ "openURL(" cut-buffer ")")
	    )
	    (? "selection is not an URL: " cut-buffer "\n")
	))	
	(on (buttonrelease action-button (together with-alt with-control))
	  (if (match "^[hftp][hftp]*:[/][/][^ ]*$" cut-buffer)
	    (! "netscape-remote" "-id" 
	      (itoa (window-to-client window-window))
	      "-remote" (+ "openURL(" cut-buffer ",new-window)")
	    )
	    (? "selection is not an URL: " cut-buffer "\n")
	))
	(on (buttonrelease select-button with-control)
	  (if (match "^[hftp][hftp]*:[/][/][^ ]*$" cut-buffer)
	    (! "netscape-remote" "-id" 
	      (itoa (window-to-client window-window))
	      "-remote" (+ "openURL(" cut-buffer ",new-window)")
	    )
	    (? "selection is not an URL: " cut-buffer "\n")
	))
      )
      icon-behavior standard-behavior)
  )
)

;;=============================================================================
;;                    placements
;;=============================================================================

(set-placement XTerm user-positioning)  ; place manually xterms

(if (not (= USER 'colas))		; people other than me like to have 
					; interactive placement for all windows
  (set-placement * user-positioning)
)

(set-icon-placement any rows.right-top.placement) ; place most icons on right

; xloads, xclocks, etc goes on NE corner

(set-placement XLoad.xload rows.top-right.placement) 
(set-placement XPostit.xpostit.xpostit rows.top-right.placement) 
(set-placement XClock rows.top-right.placement) 
(set-placement Clock rows.top-right.placement) 
(set-placement XBiff rows.top-right.placement) 
;(set-placement XLogo rows.down-right.placement) 

(set-icon-placement Gwm rows.down-right.placement) ; inactive dvrooms
(set-window Gwm no-frame)
(set-placement Gwm			; active dvrooms
	       (lambda (f) (if (= window-name "rmgr")
			         (if f
				   (move-window
				    (- screen-width 175)
				    60)))))))))

(set-placement XPostit.xpostit rows.top-right.placement)

(set-placement XCal rows.top-right.placement) ; XCal windows

;; specify the ordering of icons

(setq icon-order '(Xmh 10 XPostit 5 XRn 20 XClock 2 Clock 2 XBiff 1 XLoad 20
    XTerm 90 Emacs 30 XDvi 250 XCal 1000
    Zircon 15 Tk.zircon 15))

(rows.limits rows.right-top 'start 55 'separator 1 'sort sort-icons 'end 1000)
(rows.limits rows.down-right 'start 100 'separator 1 'offset
     (- screen-height 70))
(rows.limits rows.down-left 'start 600 'separator 1 'offset 1)
(rows.limits rows.top-right 'start 55  'sort sort-icons)


;; I want my local xload on the top right corner

(set-placement XLoad.xloadlocal
  (lambda (f) (if f (progn
	(move-window (- screen-width window-width wob-borderwidth) 0)
	(## 'update-placement window  ())
)))))

;;=============================================================================
;;                    a better icon sorter, weigths given by customize
;;=============================================================================

(defun pack-icons (w1 w2)
  (with (wob w1 weight1 100 weight2 100 n1 window-icon-name)
    (setq weight1 (# 'weight (std-resource-get 'PackIcons 'pack-icons)))
    (if (not weight1) (setq weight1 100))
    (setq wob w2)
    (setq weight2 (# 'weight (std-resource-get 'PackIcons 'pack-icons)))
    (if (not weight2) (setq weight2 100))
    
    (if (= weight1 weight2)
      (compare n1 window-icon-name)
      (compare weight1 weight2)
)))

(customize pack-icons any any weight 100)

(rows.limits rows.right-top 'sort pack-icons)

;; my personal weights

(customize pack-icons any Xmh weight 10)
(customize pack-icons any XPostit weight 5)
(customize pack-icons any XRn weight 20)
(customize pack-icons any XClock weight 2)
(customize pack-icons any Clock weight 2)
(customize pack-icons any XBiff weight 1)
(customize pack-icons any XLoad weight 20)
(customize pack-icons any XTerm weight 90)
(customize pack-icons any Emacs weight 30)
(customize pack-icons any XDvi weight 250)
(customize pack-icons any XCal weight 1000)
(customize pack-icons any Zircon weight 15)
(customize pack-icons any Tk.zircon weight 15)

;;=============================================================================
;;                    Misc Examples
;;=============================================================================

; have a list of machines for xterms and xload alphabetically sorted

(setq xload-list (: xterm-list '(
      avahi lemur  aye maki indri
      celeste rataxes columbo
      aenegada capa
      modja crios ploum milos rhea
      babar  paprika trinidad bahia oural arthur
      tatoo almeria tsoris mbili bagheera falbala
      oaxaca))))

; I sort the list of machines alphabetically

(sort xterm-list (lambdaq (atom1 atom2) (compare atom1 atom2)))

;; Example on how to make a window start as iconic: 
;; first, sets its window-starts-iconic to t,
;; then return deco

(defun no-frame-iconic ()
    '(progn
	(window-starts-iconic t)
	(no-frame)))
;; we use this for xdvi, which has no -iconic option
(set-window XDvi no-frame-iconic)

; how to affect a decoration by some other criterions:
; example: set deco of xrn windows by size: small windows (popups) do not
; have decos, big ones (height > 200) have

(setq XRn-deco '(if (> window-height 200)
    (progn
      (require 'simple-win)		; we must load it if it wasn't here
      (simple-win 'font small-font
	'background (color-make "PaleGreen2")
	'active.background (color-make "PaleGreen4")
	'label.background (color-make "PaleGreen2")
    ))
    no-frame-no-borders			; no visible frame on popups
))
(set-window XRn XRn-deco)

(setq XRn-deco.xrncma '(if (> window-height 200)
    (progn
      (require 'simple-win)		; we must load it if it wasn't here
      (simple-win 'font small-font
	'background (color-make "GoldenRod2")
	'active.background (color-make "GoldenRod4")
	'label.background (color-make "GoldenRod2")
    ))
    no-frame-no-borders			; no visible frame on popups
))
(set-window XRn.xrncma XRn-deco.xrncma)

;; in fact, you can give customization argiments either to the function itself
;; or like here by another call to customize...

(set-window XTerm.xterm_Lpq simple-win)
(customize simple-win any XTerm.xterm_Lpq font small-font
	background (color-make "Yellow3")
	active.background (color-make "Yellow1")
	label.background (color-make "Yellow3")
)))

;;=============================================================================
;;                    stacking xmemuse windows ont top of each other
;;=============================================================================

(customize simple-win any Xmemuse.xmemuse.xmemuse.aye
  font fixed-font
  active.font fixed-font
  active.label.background grey
  label (lambda (s) window-machine-name)
  tile t
  label.background screen-background
  legend "right"
  lpad 0
  rpad 4
)
(customize simple-win any Xmemuse.xmemuse.xmemuse.lemur
  font fixed-font
  active.font fixed-font
  active.label.background grey
  label (lambda (s) window-machine-name)
  tile t
  label.background screen-background
  legend "right"
  lpad 1
  rpad 3
)
(customize simple-win any Xmemuse.xmemuse.xmemuse.maki
  font fixed-font
  active.font fixed-font
  active.label.background grey
  label (lambda (s) window-machine-name)
  tile t
  label.background screen-background
  legend "right"
  lpad 2
  rpad 2
)
(customize simple-win any Xmemuse
  font fixed-font
  active.font fixed-font
  active.label.background grey
  label (lambda (s) window-machine-name)
  tile t
  label.background screen-background
  legend "right"
  lpad 4
  rpad 0
)

;;=============================================================================
;;                    emacs windows: small-win is a  variant of simple-win
;;=============================================================================

;; first, we create the variant by calling the simple-win deco with a
;; context as argument (think of it as a closure made with the simple-win
;; deco + another environnement)

(require 'simple-win)			; ensure simple-win func is defined
(: small-win '(simple-win 'font small-font
    'background (color-make "BurlyWood")
    'active.background (color-make "orange4")
    'label.background (color-make "BurlyWood")
))
(: lemacs-win '(with (ignore-take-focus t)
    (simple-win 'font small-font
    'background (color-make "BurlyWood")
    'active.background (color-make "orange4")
    'label.background (color-make "BurlyWood")
)))
;; then we can use it

(set-window Emacs small-win)
(set-window Emacs.emacs lemacs-win)
(set-window emacs (simple-win 'font small-font))
(set-window Emacs.epoch.minibuffer no-frame)
(set-window MinibufferScreen no-frame)

;;=============================================================================
;;                    xmh
;;=============================================================================

(load 'xpm-icon)
(set-icon-window any Xmh.xmh.xmh:_inbox (xpm-icon xpm-icon-by-size))
(set-icon-window any Xmh ())

(set-icon XClipboard (pixmap-load "clipboard.xpm"))
(set-icon XRn.xrn (pixmap-load "Xrn-icon"))
(set-icon XRn.xrn-6_18 (pixmap-load "Xrn-icon"))
(set-window Clock.oclock no-frame-no-borders)

;;=============================================================================
;;                    epoch placement
;;=============================================================================

;; this is a code to arrange my epoch window: make new epoch windows occupy
;; vacant slots in the "Epoch-windows-list"
;; Sample list is one to the left, and a cascade to the right

(if (= USER 'colas) (progn
    (setq Epoch-windows-list '(
    ;; free (width height x-pixel-pos y-pixel-pos ordering-number)    
	free (80 87 0 0 0)
	free (80 87 585 0 1)
	free (80 85 605 22 2)
	free (80 83 625 44 3)
	free (80 81 645 66 4)
	free (80 79 665 88 5)
	free (80 77 685 110 6)
	free (80 75 705 132 7)
    ))
    
    (set-placement Emacs.epoch 
      (lambda (flag)
	(if flag			; opening: seek free slot
	  (if (not window-starts-iconic) ; then put window-id instead of free
	    (place-epoch-window)
	  )
					; closing: put 'free in slot
	  (with (e (member window Epoch-windows-list))
	    (if e
	      (replace-nth e Epoch-windows-list 'free)
    )))))
    
;; search Epoch-windows-list for free slots, and move & resize window there
    (defun place-epoch-window ()
      (with (geometry (nth 'free Epoch-windows-list))
	(if geometry
	  (progn
	    (move-window (nth 2 geometry) (nth 3 geometry))
	    (setq window-size (sublist 0 2 geometry))
	    (replace-nth (* 2 (nth 4 geometry)) Epoch-windows-list window)
    ))))


;;; same for lucid emacs
    (setq Emacs-windows-list '(
    ;; free (width height x-pixel-pos y-pixel-pos ordering-number)    
	free (82 69 20 0 0)
	free (82 69 540 0 1)
	free (82 67 560 22 2)
	free (82 65 580 44 3)
	free (82 63 600 66 4)
	free (82 61 620 88 5)
	free (82 59 640 110 6)
	free (82 57 660 132 7)
    ))
    
    (set-placement Emacs.emacs 
      (lambda (flag)
	(if flag			; opening: seek free slot
	  (if (not window-starts-iconic) ; then put window-id instead of free
	    (place-emacs-window)
	  )
					; closing: put 'free in slot
	  (with (e (member window Emacs-windows-list))
	    (if e
	      (replace-nth e Emacs-windows-list 'free)
    )))))
    ;; search Emacs-windows-list for free slots, and move & resize window there
    (defun place-emacs-window ()
      (with (geometry (nth 'free Emacs-windows-list))
	(if geometry
	  (progn
	    (move-window (nth 2 geometry) (nth 3 geometry))
	    (setq window-size (sublist 0 2 geometry))
	    (replace-nth (* 2 (nth 4 geometry)) Emacs-windows-list window)
    ))))


))

;; Personal clients
(if (= USER 'colas) (progn
    (setq xlpwatch.color (color-make "bisque"))
    (set-icon Tk.xlpwatch (pixmap-make xlpwatch.color "printer.xbm" black))
    (set-window Tk.xlpwatch no-frame-no-borders)
    (set-icon Tk.xlpwatch_#2 (pixmap-make xlpwatch.color "printer.xbm" black))
    (set-window Tk.xlpwatch_#2 no-frame-no-borders)
    (set-icon Tk.xlpwatch_#3 (pixmap-make xlpwatch.color "printer.xbm" black))
    (set-window Tk.xlpwatch_#3 no-frame-no-borders)
))

(set-window XQuery.NewMail no-frame-no-borders)
(set-placement XQuery.NewMail rows.left-top.placement)

;;=============================================================================
;; buttons for often done actions
;; button creation must be done at screen-opening-time
;;=============================================================================

(if (and (= USER 'colas) (not (boundp 'TEST)))
  (progn
    (setq screen-opening (+ screen-opening '(
	  
;;      ;; kill all my "new mail" windows
;;	  (place-3d-button "kill-mails"
;;	    black  'CadetBlue
;;	    '(for window (list-of-windows) 
;;	      (if (= window-client-name 'NewMail)(kill-window))
;;	  ))
;;	  
;;      ;; show/hide my vital postit, determined by its size
;;	  (place-3d-button "admin-post"
;;	    black 'khaki
;;	    '(for window (list-of-windows) 
;;	      (if (and (= window-name 'PostItNote)
;;		  (= window-width 515)(= window-height 191)
;;		)
;;		(if window-is-mapped (iconify-window)
;;		  (progn (map-window)(raise-window))
;;	  ))))
;;	  
;;      ;; toggle on/off all big postits
;;	  (place-3d-button "Post Big"
;;	    black 'thistle
;;	    '(for window (list-of-windows) 
;;	      (if (= window-name 'PostItNoteBig)
;;		(if window-is-mapped (iconify-window)
;;		  (progn (map-window)(raise-window))
;;	  ))))
;;	  
;;      ;; toggle on/off all normal postits
;;	  (place-3d-button "Post Norm"
;;	    black 'khaki
;;	    '(for window (list-of-windows) 
;;	      (if (= window-name 'PostItNote)
;;		(if window-is-mapped (iconify-window)
;;		  (progn (map-window)(raise-window))
;;	  ))))
;;	  
;;      ;; toggle on/off all small postits
;;	  (place-3d-button "Post Small"
;;	    black 'SpringGreen
;;	    '(for window (list-of-windows) 
;;	      (if (= window-name 'PostItNoteSmall)
;;		(if window-is-mapped (iconify-window)
;;		  (progn (map-window)(raise-window))
;;	    )))
;;	  )
;;	  
	  
      ;; raise/lower/iconify (depending of button) all xterms
	  (place-3d-button "XTerms"
	    black 'LightBlue
	    '(if (= 0 (current-event-modifier))
	      (for window (list-of-windows 'window) 
		(if (and (= window-client-class 'XTerm) window-is-mapped)
		  (if (= 1 (current-event-code))
		    (raise-window)
		    (= 2 (current-event-code))
		    (lower-window)
		    (= 3 (current-event-code))
		    (iconify-window)
	      )))
	      (for window (list-of-windows 'icon)
		(if (and (= window-client-class 'XTerm) window-is-mapped)
		  (if (= 1 (current-event-code))
		    () ;; to be completed
		    (= 2 (current-event-code))
		    () ;; to be completed
		    (= 3 (current-event-code))
		    (iconify-window)
	  )))))
	  
	  ;; forks an lpwatch
	  (place-3d-button "lpq"
	    black 'bisque
	    '(! "rx" "paprika" "PATH=`cat ~/bin/sun4/.path`; xlpwatch -geometry +750+900")
	  )

	  ;; resets the selection state of the server
	  (place-3d-button "blank" black 'pink
	    '(! "xscreensaver-command" "-activate")
	  )
    )))
    
    (set-placement Gwm.button rows.right-down.placement)
    (set-window Gwm.button no-frame-no-borders)
))

;;=============================================================================
;; some little modifications after modules have been loaded
;;=============================================================================
;; a bit of a hack. just to show it can be done.

;; change font of first item of window menu
(## 0 window-pop-items
  (list 'with '(pop-item.font (font-make "*-helvetica-bold-r-normal--14-*"))
    (# 0 window-pop-items)
))

(setq old-get-x-resource resource-get)
;(defun resource-get (class name)
;;  (? "GET [" class "] [" name "]\n")
;  (old-get-x-resource class name)
;)
(setq reenter-on-opening ())

;; idraw: place pop-up on left top

(set-placement Dialog.idraw26
  (lambda (f) (if f (progn (move-window 0 0) (resize-window 210 800)
))))

;;=============================================================================
;; framemaker windows
;;=============================================================================
(load 'framemaker)

(setq frame-icon-color.1 (color-make "LightYellow2"))
(setq frame-icon-font.1 pop-item.font)
(setq frame-icon-color.2 (color-make "LightYellow3"))
(setq frame-icon-font.2 small-font)
(setq frame-inactive-color frame-icon-color.1)
(setq frame-active-color (color-make "LightYellow4"))

(set-icon Maker.makerkit (pixmap-load "App_write.xpm"))
(set-icon-window Maker
  (if (= "makerkit" window-client-name) ; top window(menu): use frame pixmap
    (simple-icon 'background frame-icon-color.2)

    (match ".*kit" window-client-name)
    (progn				; main edit windows: icon name
      (simple-icon 'background frame-icon-color.1
	'simple-icon.plug-name (+ "[ " window-icon-name " ]")
	'simple-icon.no-center-plug t
	'font frame-icon-font.1
      )
    )

					; all popups, use a smaller name
    (with (name (match "FrameMaker - \\(.*\\)$" window-name 1))
      (if (= name "")
	(setq name window-name)
      )
      (if
	(= name "Character Format") (setq name "Format Chr")
	(= name "Paragraph Format") (setq name "Format Par")
	(= name "\xB6 Catalog") (progn
	  (setq window-name "Par Catalog")
	  (setq name "Catalog Par")
	)
	(= name "C Catalog") (setq name "Catalog Chr")
	(= name "Spelling Checker") (setq name "Spell")
      )
      (simple-icon 'background frame-icon-color.2
	'font frame-icon-font.2
	'simple-icon.plug-name name)
)))

(setq icon-order (+ icon-order '(Maker 210)))

;; experimental epoch menus

(setq epoch-color "bisque")

(for i '("1" "2" "3" "4")
  (set (atom (+ "epoch-color" i))
    (color-make (+ epoch-color i))
))

(: widget.Bfont  (font-make "*clean-medium*--10*c-60*"))
(: widget.font (font-make "*clean-bold*--10*c-60*"))
(setq widget.foreground epoch-color4)
(setq widget.background epoch-color1)
(setq widget.name-font (font-make "fixed"))
(setq widget.name-foreground black)

(: widget.weave (pixmap-make
    epoch-color4
    "/usr/include/X11/bitmaps/cross_weave"
    epoch-color1
))
(: widget.black (pixmap-make
    black
    "/usr/include/X11/bitmaps/black"
    epoch-color4
))
(: widget.gray (pixmap-make
    black
    "/usr/include/X11/bitmaps/black"
    epoch-color4
))
(: widget.lt-gray (pixmap-make
    black
    "/usr/include/X11/bitmaps/black"
    epoch-color2
))

(load "em-widgets.gwm")
(load "em-drop-menus.gwm")
(set-window Emacs.epoch style:select)

(Dmenu: Dmenu.fonts
   '("fonts" (
      ("screen-11" "(progn (font \"screen.r.11\") (redraw-display))")
      ("screen-12" "(progn (font \"screen.r.12\") (redraw-display))")
      ("screen-12-Bold" "(progn (font \"screen.b.12\") (redraw-display))")
      ("screen-13" "(progn (font \"screen.r.13\") (redraw-display))")
      ("screen-14" "(progn (font \"screen.r.14\") (redraw-display))")
      ("screen-14-Bold" "(progn (font \"screen.b.14\") (redraw-display))")
      ("screen-7" "(progn (font \"screen.r.7\") (redraw-display))")
      ("fixed" "(progn (font \"fixed\") (redraw-display))")
      )))

(Dmenu: Dmenu.buffers 
   '("buffers" (
      ("list of buffers"
	"(progn \
(list-buffers) \
(switch-to-buffer \"*Buffer List*\") \
(delete-other-windows) \
(if (not (boundp 'mouse-Buffer-menu-select)) (progn \
    (setq mouse-Buffer-menu-select t)\
    (defun mouse-Buffer-menu-select (&optional mdata) (interactive) \
      (Buffer-menu-select) \
))) \
(if (boundp 'imouse-version)\
  (local-set-mouse mouse-middle mouse-down 'mouse-set-point-or-select) \
  (local-set-mouse mouse-middle mouse-down 'mouse::set-point)) \
(local-set-mouse mouse-middle mouse-up 'mouse-Buffer-menu-select) \
)")
      ("other buffer" "(switch-to-buffer (other-buffer))")
      ("*scratch* buffer" "(switch-to-buffer \"*scratch*\")")
      ("-" (bell))
      ("kill buffer" "(kill-buffer (current-buffer))")
      )))

(Dmenu: Dmenu.files 
   '("files" (
      ("list of directory"
	"(progn \
(dired \".\") \
(delete-other-windows) \
(if (not (boundp 'mouse-dired-find-file)) (progn \
    (setq mouse-dired-find-file t)\
    (defun mouse-dired-find-file (&optional mdata) (interactive) \
      (dired-find-file) \
))) \
(if (boundp 'imouse-version)\
  (local-set-mouse mouse-middle mouse-down 'mouse-set-point-or-select) \
  (local-set-mouse mouse-middle mouse-down 'mouse::set-point)) \
(local-set-mouse mouse-middle mouse-up 'mouse-dired-find-file) \
)")
    (" - - - " "")
    (".Xdefaults" "(find-file \"~/.Xdefaults\")")
    ("profile-epoch" "(find-file \"~/el/profile-epoch-4.0.el\")")
    ("wool TODO" "(find-file \"~/Wool2/src/TODO\")")
    ("wool Log" "(find-file \"~/Wool2/src/Log\")")
    ("gwm-talk" "(find-file \"~/mailist/gwm-talk\")")
    ("gwm-bugs" "(find-file \"~/mailist/gwm-bugs\")")
    ("gwm-welcome" "(find-file \"~/mailist/newusers-gwm\")")

      )))

(Dmenu: Dmenu.db
    '("db" 
     (
      (" " "")
      ("byte-compile-current-file" "(byte-compile-current-file)")
      ("toggle debug" "(setq debug-on-error (not debug-on-error))")
      ("debug on" "(setq debug-on-error t)")
      ("debug off" "(setq debug-on-error f)")
      )))

(: Dmenu.epoch-menus
   (list 
    Dmenu.fonts
    Dmenu.files
    Dmenu.buffers
    Dmenu.db
    ))

