;; $Id: decor.scwmrc,v 1.27 2006/11/22 01:53:06 dsmith Exp $ -*- scwm -*-
;;-------------------------------;;
;; import the scwm modules       ;;

;; Uncomment the below to send a single UDP packet to
;; the scwm usage counter machine at startup
;; The single packet just contains the hostname and version number
;; To disable, set environment variable SCWM_DO_NOT_LOG_USAGE
;;(define thank-scwm-authors-with-usage-note #t)


(use-scwm-modules base winops winlist-menu wininfo style face decor)

;;-------------------------------;;
;; set some basic style info    ;;

(define tan-color (make-color "tan"))
(define light-gray-color (make-color "light gray"))

(define font12
  (load-font "-adobe-helvetica-bold-r-*-*-12-*-*-*-*-*-*-*"))
(define font14 
  (load-font "-adobe-helvetica-bold-r-*-*-14-*-*-*-*-*-*-*"))

(menu-style #:fg "black" #:bg "grey76" ; #:stipple "blue"
	    #:font font14 ; #:mwm #f
)
;; (define menu-bg-color (make-color "gray76"))
;; (define menu-text-color (make-color "black"))

(title-style #:font font12 #:justify 'left)

(set-icon-font! font12)
;;(set-highlight-foreground! "white")
;;(set-highlight-background! "blueviolet")
(set-rubber-band-mask! 127)


(define user-image-path 
  (list (string-append (user-home) "/pixmaps") 
	(string-append (user-home) "/bitmaps")
	(string-append (user-home) "/icons")
	(string-append (user-home) "/mini-icons")))


;;-------------------------------;;
;; set some paths                ;;
;;

;; these are OK for my system, but may need to be changed for
;; yours. This should probably be eventually autoconfed or something.

(set! image-load-path (append user-image-path
			      '("/usr/X11/include/X11/bitmaps"
				"/usr/local/X11/include/X11/pixmaps"
				"/usr/local/lib/icons"
				"/uns/include/X11/pixmaps"
				"/usr/lib/icons"
				"/usr/X11/include/X11/pixmaps"
				"/usr/X11/lib/X11/mini-icons")
				image-load-path))
			      

;;-------------------------------;;
;; set up a couple of various    ;;
;; decors and styles             ;;

(define helvetica-12   
  (load-font "-adobe-helvetica-bold-r-*-*-12-*-*-*-*-*-*-*"))

(define helvetica-14   
  (load-font "-adobe-helvetica-bold-o-*-*-14-*-*-*-*-*-*-*"))


(define times-14   
  (load-font "-adobe-times-bold-r-*-*-14-*-*-*-*-*-*-*"))

(define fvwm-decor (make-decor))

(with-decor fvwm-decor
	    (title-style #:justify 'center #:relief 'raised
			 #:font times-14)
	    (border-style #:no-inset #f #:hidden-handles #f)
;;; Big Lighting Bolt (Fat at top, comes to a point)
	    (button-style 1 #:relief-pattern
			  '((35 15 #t) (20 50 #t) (40 50 #f) (30 80 #t) 
				       (75 40 #f) (50 40 #t) (75 15 #f) 
				       (35 15 #t)))
;;; large up triangle
	    (button-style 2 #:relief-pattern
			  '((50 25 #t) (75 75 #f) (25 75 #f) (50 25 #t)))
;;; large down triangle
	    (button-style 4 #:relief-pattern
			  '((50 75 #t) (25 25 #t) (75 25 #t) (50 75 #f)))
	    (set-highlight-foreground! "black")
	    (set-highlight-background! "salmon"))

(define fvwm-style 
  (make-style #:fg "black" #:bg tan-color #:show-icon #t
	      #:border-width 4 #:mwm-border #f
	      #:mwm-buttons #f
	      #:use-decor fvwm-decor))

(define mwm-decor (make-decor))

(with-decor mwm-decor
	    (title-style #:justify 'center #:relief 'raised
			 #:font times-14)
	    (border-style #:no-inset #f #:hidden-handles #f)
	    (set-highlight-foreground! "black")
	    (set-highlight-background! "cadet blue"))

(define mwm-style 
  (make-style #:fg "black" #:bg "gray" #:show-icon #t
	      #:border-width 6 #:mwm-border #t
	      #:mwm-buttons #t
	      #:use-decor mwm-decor))

(define win95-decor (make-decor))

(with-decor win95-decor 
	    (title-style #:justify 'left #:font helvetica-12
			 #:relief 'flat
			 #:solid "navy blue" 
			 #:inactive (list #:solid "grey50"))
	    (border-style #:no-inset #t #:hidden-handles #t)
	    (button-style 1 #:relief 'flat 
 			  #:solid "navy blue" #:pixmap 'mini-program-icon
			  #:inactive 
			  (list #:solid "grey50" #:pixmap 'mini-program-icon))
	    (button-style 2 #:relief 'flat
			  #:solid "navy blue"
			  #:pixmap "win95-maximize-full.xpm"
			  #:inactive 
			  (list #:solid "grey50" 
				#:pixmap "win95-maximize-full.xpm"))
	    (button-style 4 #:relief 'flat
			  #:solid "navy blue"
			  #:pixmap "win95-minimize-full.xpm"
			  #:inactive 
			  (list #:solid "grey50" 
				#:pixmap "win95-minimize-full.xpm"))
	    (set-highlight-foreground! "white")
	    (set-highlight-background! "grey76"))

(define win95-style
  (make-style #:fg "grey76" #:bg "grey76" #:show-icon #f
	      #:border-width 4 #:mwm-border #f
	      #:mwm-buttons #f
	      #:use-decor win95-decor))

(define win95-grad-decor (make-decor))

(with-decor win95-grad-decor 
	    (title-style #:justify 'left #:font helvetica-12
			 #:relief 'flat
			 #:h-gradient (list 20 (list "navy blue" 20) 
					    "navyblue" "black") 
			 #:inactive 
			 (list #:h-gradient 
			       (list 40 (list "grey50" 20) 
				     "grey50" "grey25")))
	    (border-style #:no-inset #t #:hidden-handles #t)
	    (button-style 1 #:relief 'flat 
 			  #:solid "navy blue" #:pixmap 'mini-program-icon
			  #:inactive 
			  (list #:solid "grey50" #:pixmap 'mini-program-icon))
	    (button-style 2 #:relief 'flat
			  #:solid "black"
			  #:pixmap "win95-maximize-full.xpm"
			  #:inactive 
			  (list #:solid "grey15" 
				#:pixmap "win95-maximize-full.xpm"))
	    (button-style 4 #:relief 'flat
			  #:solid "black"
			  #:pixmap "win95-minimize-full.xpm"
			  #:inactive 
			  (list #:solid "grey25" 
				#:pixmap "win95-minimize-full.xpm"))
	    (set-highlight-foreground! "white")
	    (set-highlight-background!  "grey76"))

(define win95-grad-style
  (make-style #:fg "grey76" #:bg "grey76" #:show-icon #f
	      #:border-width 4 #:mwm-border #f
	      #:mwm-buttons #f
	      #:use-decor win95-grad-decor))


(define tile-decor (make-decor))

;; texture by Stephanie Miller <stephane@mit.edu>
(with-decor tile-decor
	    (border-style #:hidden-handles #t #:no-inset #t
			  #:pixmap "lizard.xpm" #:inactive
			  (list #:hidden-handles #t #:no-inset #t
			  #:pixmap "lizard2.xpm"))
	    (title-style #:justify 'center #:font helvetica-14 
			 #:relief 'raised)
	    (button-style 1 #:use-style-of 'border
			  #:relief-pattern 
			  '((26 29 #t) (34 21 #t) (50 35 #t) 
				       (70 21 #t) (79 29 #t) 
				       (63 48 #f) (79 65 #t) 
				       (70 75 #f) (50 61 #f) 
				       (34 75 #f) (26 65 #f) 
				       (44 48 #t) (26 29 #f)))
	    (button-style 2 #:use-style-of 'border
			  #:relief-pattern
			  '((25 25 #t) (25 75 #t) (75 75 #f) 
				       (75 25 #f) (25 25 #t)))
	    (button-style 4 #:use-style-of 'border
			  #:relief-pattern
			  '((40 40 #t) (60 40 #t) (60 60 #f) 
				       (40 60 #f) (40 40 #t)))
	    (set-highlight-foreground! "white")
;	    (set-highlight-background! "#3cb21c") 

)

(define tile-style (make-style #:fg "white" 
; #:bg "#a63823" 
			       #:show-icon #t
			       #:border-width 6
			       #:use-decor tile-decor))


(define twm-decor (make-decor))

(with-decor twm-decor
	    (title-style #:justify 'left #:font helvetica-12 
			 #:relief 'flat #:height 20)
	    (border-style #:hidden-handles #t)
	    (button-style 1 #:relief 'flat #:pixmap "twm-x.xpm")
	    (button-style 2 #:relief 'flat #:pixmap "twm-boxes.xpm")
	    (button-style 4 #:relief 'flat #:pixmap "twm-dot.xpm")
	    (set-highlight-foreground! light-gray-color)
	    (set-highlight-background! "maroon"))

(define twm-style (make-style #:border-width 1  #:fg light-gray-color #:bg "black"
			      #:show-icon #f #:use-decor twm-decor))


(define win-decoration-menu
  (menu 
   (list
    (menuitem "Fvwm" 
	      #:action (lambda () 
			 (style-one-window (get-window)
					   #:use-style fvwm-style)))
    (menuitem "Mwm" 
	      #:action (lambda () 
			 (style-one-window (get-window)
					   #:use-style mwm-style)))
    (menuitem "Fvwm95"
	      #:action (lambda () 
			 (style-one-window (get-window)
					   #:use-style win95-style)))
    (menuitem "Fvwm95 (With Gradients)" 
	      #:action (lambda () 
			 (style-one-window (get-window)
					   #:use-style win95-grad-style)))
    (menuitem "Lizard Texture" 
	      #:action (lambda () 
			 (style-one-window (get-window)
					   #:use-style tile-style)))
    (menuitem "Twm (Inaccurate)"
	      #:action (lambda () 
			 (style-one-window (get-window)
					   #:use-style twm-style))))))


(define global-decorations-menu
  (menu 
   (list
    (menu-title "Global Decorations Settings")
    menu-separator
    (menuitem "Fvwm" 
	      #:action (lambda ()
			 (window-style "*" #:use-style fvwm-style)))
    (menuitem "Mwm" 
	      #:action (lambda ()
			 (window-style "*" #:use-style mwm-style)))
    (menuitem "Fvwm95" 
	      #:action (lambda ()
			 (window-style "*" #:use-style win95-style)))
    (menuitem "Fvwm95 (With Gradients)" 
	      #:action (lambda ()
			 (window-style "*" #:use-style win95-grad-style)))
    (menuitem "Lizard Texture" 
	      #:action (lambda () 
			 (window-style "*" #:use-style tile-style)))
    (menuitem "Twm (Inaccurate)"
	      #:action (lambda () 
			 (window-style "*" #:use-style twm-style))))))



;;-------------------------------;;
;; set some window styles        ;;

(window-style "*" 
	      #:icon-box (list (x- 70) 1 69 (y- 141))
	      #:focus 'mouse
	      #:icon "unknown1.xpm"
	      #:mwm-func-hint #t #:mwm-decor-hint #t
	      #:hint-override #t #:decorate-transient #t
	      #:PPosition-hint #f
	      #:lenience #t
	      #:mini-icon "mini-x.xpm")

(window-style "*" #:use-style fvwm-style)


(define desk-widget
  (make-style #:plain-border #t #:sticky #t #:winlist-skip #t
	      #:border-width 3 #:focus 'none))

(window-style "*lock" #:use-style desk-widget)
(window-style "xload" #:no-titlebar #t #:use-style desk-widget)
(window-style "xscreensaver" #:no-titlebar #t #:use-style desk-widget)
(window-style "xbiff" #:no-titlebar #t #:use-style desk-widget)
(window-style "xcalc" #:icon "xcalc.xpm")
(window-style "xman" #:icon "xman.xpm")
(window-style "xmag" #:icon "mag_glass.xpm")
(window-style "Emacs" #:icon "gnu-animal.xpm")
(window-style "XTerm" #:icon "xterm.xpm")



;;-------------------------------;;
;; define some useful menus      ;;


(define window-ops-menu
  (menu
   (list
    (menu-title "Window Ops")
    menu-separator
    (menuitem "Move" interactive-move)
    (menuitem "Resize" #:action interactive-resize)
    (menuitem "Raise" #:action raise-window)
    (menuitem "Lower" #:action lower-window)
    (menuitem "(Un) Window-Shade" #:action toggle-window-shade)
    (menuitem "(De) Iconify" #:action toggle-iconify)
    (menuitem "(Un) Maximize" #:action toggle-maximize-vertical)
    (menuitem "(Un)Stick" #:action toggle-stick)
    (menuitem "(Un)Keep On Top" #:action toggle-on-top)
    menu-separator
    (menuitem "Close" #:action close-window)
    (menuitem "Delete" #:action delete-window)
    (menuitem "Destroy" #:action destroy-window)
    menu-separator
    (menuitem "Refresh Screen" #:action refresh))))

(define (popup-ops)
  (popup-menu window-ops-menu))

(define menu-quit-verify
  (menu 
   (list 
    (menu-title "Really quit scwm?")
    menu-separator
    (menuitem "Yes" #:action quit)
    (menuitem "No" #:action noop)
    menu-separator
    (menuitem "Restart scwm" #:action (lambda () (restart "scwm"))))))

(define (quit-verify)
  (popup-menu menu-quit-verify))

(define desk-menu 
  (menu 
   (list
    (menu-title "Desks")
    menu-separator
    (menuitem "Desk 1" #:action (lambda () (set-current-desk! 0)))
    (menuitem "Desk 2" #:action (lambda () (set-current-desk! 1)))
    (menuitem "Desk 3" #:action (lambda () (set-current-desk! 2)))
    (menuitem "Desk 4" #:action (lambda () (set-current-desk! 3))))))

(define util-menu 
  (menu
   (list
    (menu-title "Utilities")
    menu-separator
    (menuitem "xterm" #:action (lambda () (execute "xterm")))
    (menuitem "rxvt" #:action (lambda () (execute "rxvt")))
    (menuitem "emacs" #:action (lambda () (execute "emacs")))
    (menuitem "top" #:action (lambda () (execute "rxvt -T Top -n Top -e top")))
    (menuitem "xcalc" #:action (lambda () (execute "xcalc")))
    (menuitem "xmag" #:action (lambda () (execute "xmag")))
    menu-separator
    (menuitem "Globally Set Decorations" #:action
	  global-decorations-menu)
    (menuitem "Desks" #:action desk-menu)
    menu-separator
    (menuitem "Exit scwm" #:action menu-quit-verify))))
  
(define (popup-util)
  (popup-menu util-menu))


(define (make-small-window-ops-menu w)
  (menu 
   (list
    (menuitem "Move" #:action interactive-move)
    (menuitem "Resize" #:action interactive-resize)
    (menuitem "Raise" #:action raise-window)
    (menuitem "Lower" #:action lower-window)
    (menuitem "Iconify" #:action iconify-window)
    menu-separator
    (menuitem "More" #:action 
	      (menu 
	       (list
		(menuitem (if (maximized? w)
			      "Unmaximize"
			      "Maximize") toggle-maximize-vertical)
		(menuitem (if (sticky-window? w)
			      "Unstick"
			      "Stick") toggle-stick)
		(menuitem (if (shaded-window? w)
			      "UnWindow-Shade"
			      "Window-Shade") toggle-window-shade)
		(menuitem (if (kept-on-top? w)
			      "UnKeep On Top"
			      "Keep On Top") toggle-on-top))))
    (menuitem "Set Decorations" #:action
	      win-decoration-menu)
    menu-separator
    (menuitem "Close" #:action close-window)
    (menuitem "Destroy" #:action destroy-window))))

(define (popup-small-ops)
  (popup-menu (make-small-window-ops-menu (get-window))))



;; now set some mouse and key bindings ;;

;; first our root menus
(bind-mouse 'root 1 popup-util)
(bind-mouse 'root 2 popup-ops)
(bind-mouse 'root 3 (lambda () 
		      (show-window-list-menu #f #f #:show-geometry #t)))
(bind-mouse 'root "M-3" (lambda () (popup-menu desk-menu)))


;; window buttons
(bind-mouse 'left-button-1 1 popup-small-ops)
(bind-mouse 'right-button-1 1 toggle-maximize-vertical)
(bind-mouse 'right-button-2 1 iconify-window)

;; operations on parts of the window
(bind-mouse '(frame-corners frame-sides) 2 popup-small-ops)
(bind-mouse 'frame-corners 1 resize-or-raise)
(bind-mouse 'frame-sides 1 move-or-raise)
(define (move-or-shade)
  (case (mouse-event-type)
    ((double-click) (toggle-window-shade))
    (else (move-or-raise))))
(bind-mouse 'title 1 move-or-shade)
(bind-mouse 'title 3 lower-window)


;; key bindings for the menus
(bind-key 'all "M-F1" popup-util)
(bind-key 'all "M-F2" popup-ops)

;; to exit hit Control-Meta-Shift-q
(bind-key 'all "C-M-S-q" quit-verify)

;; some stuff for icons
(define (move-or-deiconify)
  (case (mouse-event-type)
    ((motion) (interactive-move))
    ((double-click) (deiconify-window))))

(bind-mouse 'icon 1 move-or-deiconify)
(bind-mouse 'icon 2 deiconify-window)


;; move the pointer with the keyboard
(bind-key 'all "M-Left" (lambda () (move-pointer (%x -1) 0)))
(bind-key 'all "M-Right" (lambda () (move-pointer (%x 1) 0)))
(bind-key 'all "M-Up" (lambda () (move-pointer 0 (%y -1))))
(bind-key 'all "M-Down" (lambda () (move-pointer 0 (%y 1))))

;; move the viewport with the keyboard
(bind-key 'all "C-M-Left" (lambda () (move-viewport (%x -100) 0)))
(bind-key 'all "C-M-Right" (lambda () (move-pointer (%x 100) 0)))
(bind-key 'all "C-M-Up" (lambda () (move-viewport 0 (%y -100))))
(bind-key 'all "C-M-Down" (lambda () (move-viewport 0 (%y 100))))

;; rotate the current window with the keyboard
(bind-key 'all "C-S-Tab"
	  (lambda ()
	    (next-window #:only visible? #:except iconified-window?)))

(bind-key 'all "M-S-Tab" 
	  (lambda ()
	    (prev-window #:only visible? #:except iconified-window?)))