;; fvwmrc.gwm --- FVWM profile customizations
;;
;; Author: Anders Holst  (aho@sans.kth.se)  
;; Copyright (C) 1999  Anders Holst
;; Last change: 2/5 1999
;;
;; 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 is an example of FVWM profile customizations. Plaese copy this
;; file to your own gwm-directory, and make the modifications you like.
;;
;; Some variables below are lists of "window types". These lists can 
;; contain one of four (actually six) different kinds of specifications:
;;   * An atom, representing a client class (like 'XTerm or 'Emacs).
;;   * A string, representing a regexp for the window name ("^login$").
;;   * A list which is a specification ala Jay Berkenbilt (as matched
;;     with 'match-windowspec')
;;   * An arbitrary WOOL expression, returning nil or non-nil.
;;  (* 't', which matches everything.)
;;  (* '()' which matches nothing.)
;;
;; Most variables below can be set via interactive customization menus,
;; which is often a more convenient way to specifu things. Although very
;; few variables are set below, the documentation of the variables can
;; be found here.


;;=============================================================================
;;
;;        User settable variables
;;
;;=============================================================================
;;
;; Below are shown in comments all default settings of customizable
;; variables from the various components of the FVWM profile.
;;


;;=============================================================================
;;        General FVWM variables
;;=============================================================================
;;
;;       screen-tile ()         ; Pixmap for screen background tiling
;;       root-cursor ()         ; Form of root cursor
;;       autoraise ()           ; Raise windows when entered
;;       autocolormap t         ; Change colormap to that of the entered window
;;       autofocus t            ; Set focus to entered window
;;       default-placement 'fvwm-placement ; default window placement method
;;       default-icon-placement ()         ; default icon placement method
;;       placement-list ()      ; List of (window-type func)-specifications 
;;       icon-placement-list () ;   of how to place different windows or icons
;;       place-randomly t       ; Place windows pseudo randomly,and not by user
;;       raise-on-move ()       ; Raise windows when they are moved
;;       raise-on-resize ()     ; Raise windows when they are resized
;;       raise-on-iconify ()    ; Raise windows (or icons) when iconifying

;;=============================================================================
;;        FVWM Window and Icon variables
;;=============================================================================
;;
;;       fvwm-color "tan"                  ; Main color of window
;;       fvwm-active-color "palevioletred" ; Color when in focus, as above if ()
;;       fvwm-title-color "black"          ; Color of title text
;;       fvwm-active-title-color ()        ; Color of text when in focus
;;       fvwm-title-font (font-make "6x13bold")  ; Font of title text
;;       fvwm-title-width ()         ; Title width. If (), set from font.
;;       fvwm-frame-width 6          ; Frame width.
;;       fvwm-corner-size ()         ; Resize corner size. If (), set automatic.
;;       fvwm-has-frame t            ; Window has border or resize handles
;;       fvwm-has-resize t           ; Window has resize handles
;;       fvwm-has-title t            ; Window has title bar
;;       fvwm-wide-shadow ()         ; Slightly wider shadows around title bar
;;       fvwm-inner-border -1        ; Use of inner border
;;       fvwm-outer-border ()        ; Use of outer border
;;       fvwm-left-plugs '((horizontal-rectangle (fvwm-pop-menu window-pop) press))
;;       fvwm-right-plugs '((up-triangle (zoom-window))
;;                          (down-triangle (iconify-window) release))
;;       fvwm-border-action '(move-window)
;;       fvwm-corner-action '(fvwm-resize-window)
;;       fvwm-side-action '(fvwm-resize-window)
;;       fvwm-title-action '(raise-lower-move-window)
;;       fvwm-color-styles '(((virtual-nailed) "palegreen")
;;                           (XTerm "grey")
;;                           (Emacs "lightblue"))
;;       fvwm-window-styles '(((matches-list '(XClock XLoad XBiff Gwm))
;;                             resize () title () color "tan" active-color ()
;;                             frame-width 5 inner-border ()))
;;       fvwm-virtual-colors t       ; Affect colors in virtual map.
;;       fvwm-icon-action '(iconify-window)
;;       fvwm-pixmap-path '("/usr/X11R6/include/X11/pixmaps/")
;;       fvwm-icon-assoc-list '(Emacs "emacs")

(setq my-vtwm-style '(frame () resize () title t inner-border 1 outer-border 1
                      color "royalblue" active-color "lightskyblue" title-color "white"
                      left-plugs ((medium-circle (iconify-window) release))
                      right-plugs ((medium-square (fvwm-resize-window) press))
                      title-action ((1 (raise-lower-move-window) press)
                                    (2 (move-window) press)
                                    (3 (fvwm-pop-menu window-pop) press))))
(setq my-panel-style '(frame t resize () title () frame-width 5
                       color "tan" active-color () outer-border () inner-border ()))
(if (not (boundp 'fvwm-window-styles))
(setq fvwm-window-styles (list
;;                           (+ '(t) my-vtwm-style)
                           (+ '((matches-list '(XClock XLoad XBiff Gwm)))
                              my-panel-style)))
)

;;=============================================================================
;;        FVWM/VTWM Zoom functions
;;=============================================================================
;;
;;       zoom-offset 3                  ; Minimum distance to screen edge
;;       zoom-window-method-list ()     ; List of (wind-type zoom-func) specs.
;;          ; This is to make zoom-window use different zoom methods for
;;          ; different types of windows.

;;=============================================================================
;;        FWWM Menu appearance
;;=============================================================================
;;
;;       fvwm-menu-color                ; Menu background color
;;       fvwm-menu-text-color           ; Menu text color
;;       fvwm-menu-font (font-make "8x13")     ; Menu item font
;;       fvwm-menu-label-font fvwm-menu-font   ; Menu label font
;;       fvwm-menu-item-height 10       ; Minimum height of an item
;;       fvwm-menu-min-width 100        ; Minimum width of menu

;;=============================================================================
;;        Icon Manager variables
;;=============================================================================
;;
;;       icon-mgr-name "Icon Manager"   ; Default name of icon manager
;;       icon-mgr-xpos 0                ; Default x position
;;       icon-mgr-ypos 0                ; Default y position
;;       show-default-icon-mgr t        ; Default icon manager is used
;;       show-icon-mgr t                ; Use icon managers
;;       icon-mgr-hide-if-empty t       ; Don't show empty managers
;;       iconify-by-unmapping t         ; Do not use icons by default
;;       iconify-unmanaged-by-icon t    ; Use an icon if not in any manager
;;       iconify-by-icon-list ()        ; Always use icons for these
;;       iconify-on-start-list () ; List of window types to iconify on start
;;       icon-mgr-omit-list ()    ; Window types not handled in default manager
;;       icon-mgr-sort ()               ; Sort the entries in an icon manager
;;       icon-mgr-font (font-make "8x13")   ; Font in icon managers
;;       icon-mgr-width 150             ; Width of icon manager
;;       icon-mgr-foreground black      ; Foreground of icon managers
;;       icon-mgr-background white      ; Background of icon managers
;;       icon-mgr-title-foreground icon-mgr-foreground
;;       icon-mgr-title-background icon-mgr-background
;;       icon-mgr-no-title ()           ; Inhibits the icon manager title
;;       icon-mgr-framed-bars ()        ; Makes it look more like in real VTWM
;;       icon-mgr-fancy-colors ()       ; List of (wintype fg bg) specifications
;;       icon-mgr-window-feedback t     ; Rely on focus feedback from windows
;;       icon-mgr-pixmap-name "iconify2"; Pixmap file for iconified symbol
;;         ; In addition, the property 'icon-mgr-special-pixmap can be set on
;;         ; a window to the pixmap to use for that window in the icon manager.

(setq icon-mgr-xpos -9)
(setq icon-mgr-ypos 9)
(setq icon-mgr-omit-list '(XLoad XClock XBiff Gwm (window-is-transient-for)))

;;=============================================================================
;;        Virtual Screen
;;=============================================================================
;;
;;       show-virtual t                 ; Show the map of the virtual screen
;;       virtual-modifiers (together with-control with-alt) 
;;                                      ; Modifiers for arrow keys
;;       virtual-omit-nailed t          ; Show only non-nailed windows in map
;;       virtual-omit-list ()           ; List of window types not shown in map
;;       virtual-show-filled t          ; Draw windows filled in map
;;       virtual-fancy-colors ()        
;;           ; list of (window-type foreground background) specifications
;;       virtual-xpos 0                 ; Original position of map
;;       virtual-ypos 0                 ;  - '' -  
;;       virtual-pixsize 160            ; Size of the map
;;       virtual-background white       ; Default background of the map
;;       virtual-foreground black       ; Default window frame color in the map
;;       virtual-title-font ()          ; Font of window titles in the map
;;       virtual-title-position ()      ; Position of titles in the map, could
;;                                      ; be: top, center, bottom, above, below.
;;       virtual-horizontal-step (/ screen-width 2)  ; Amount to move by keys
;;       virtual-vertical-step (/ screen-height 2)
;;       virtual-nailed-list '(Gwm)     ; Initially nailed windows

(setq virtual-xpos -172)
(setq virtual-ypos 9)
(setq virtual-pixsize 150)
(setq virtual-omit-list '(XLoad XClock XBiff Gwm))
(setq virtual-nailed-list '(XLoad XClock XBiff Gwm))

;;=============================================================================
;;        Virtual Door variables
;;=============================================================================
;;
;;       door-font (font-make "8x13")   ; Font in door buttons
;;       door-background white          ; Background color of door buttons
;;       door-foreground black          ; Foreground color of door buttons
;;       door-borderwidth 2             ; Border width of door buttons
;;       door-xsize 90                  ; Door button size
;;       door-ysize 16                  ;  - '' -
;;       door-mgr-dir-horiz t    ; Controls mapping of doors on virtual screen,
;;       door-mgr-dir-len 2      ; e.g. two screenfulls in a (horizontal) row.
;;       door-mgr-mdir-horiz t   ; Controls position of door buttons, e.g. 
;;       door-mgr-mdir-len 2     ; place two buttons in each (horizontal) row.
;;       door-mgr-xpos 0                ; Upper left corner of door manager
;;       door-mgr-ypos 0                ;  - '' -
;;       door-mgr-tile t             ; tile of empty positions, t = transparent 
;;       door-mgr-no-outer-border () ; Leave outermost borders to decoration
;;       door-context ()             ; p-list of customizations per door name
;;
;;       door-auto-string "Area "    ; Name prefix of auto-generated doors
;;       door-free-area-string "Free Area"   ; Name of magic free area door
;;       door-free-area-color ()     ; Special color of free area door
;;       door-free-area-cleans t     ; Let free area door clean empty doors
;;

(setq door-mgr-xpos 9)
(setq door-mgr-ypos 9)
(setq initial-doors '("Home" (make-free-area-door)))

;;=============================================================================
;;        Virtual Panlist variables
;;=============================================================================
;;
;;       show-pan-lists t               ; Enable pan lists
;;       pan-on-click ()                ; Pan on click (i.e. when you click
;;          ; in an edge or corner of the screen), or on enter (i.e. autopan, 
;;          ; pan as soon as the cursor reaches the edge of the screen).
;;       pan-x-step (/ screen-width 4)  ; How much to pan (when autopanning)
;;       pan-y-step (/ screen-height 4) ;  - '' -
;;       pan-delay ()                ; Time in milliseconds before autopanning
;;       pan-warp-step 4             ; Movement of cursor from edge on autopan
;;       pan-warp-wrapped ()         ; Move cursor to opposite edge on autopan
;;       pan-corner-width 30         ; Diagonal pan when this close to corner

;;=============================================================================
;;
;;        Definition of menus
;;
;;=============================================================================
;;
;; To define a menu, you can use the following constructors:
;; 
;;   (construct-menu ENTRY ...)
;;
;;   (construct-window-menu NAME ACTION)
;;   (construct-window-menu-items WINDOW-TYPE ACTION)
;;
;;   (construct-machine-menu NAME MACHINE-LIST ACTION)
;;   (construct-machine-menu-items MACHINE-LIST ACTION)
;;   (construct-xrsh-menu MACHINE-LIST COMMAND)
;;
;; There are examples on how to use most of them below, and more
;; thorough documentation can be found in "fvwm-menu.gwm".
;;
;; Below you can first define a set of useful variables and functions
;; for use when constructing menus. Thereafter you construct all the
;; menus you need. These can in turn be used in the behaviors defined
;; furter down.

;;=============================================================================
;;        Variables to use when constructing menus
;;=============================================================================

(load "fvwm-multimenu")

;; Put the often used machines in this list, "computer.some.whe.re"
(if (not (and (boundp 'machine-list) machine-list))
(setq machine-list (list ))
)

;; Put here machines that are not in the same domain, and thus need password
(if (not (and (boundp 'telnet-machine-list) telnet-machine-list))
(setq telnet-machine-list (list ))
)

;;=============================================================================
;;        Construction of menus
;;=============================================================================

;; Menu with useful global commands
(if (not (and (boundp 'root-pop-list) root-pop-list))
(setq root-pop-list
              '("Root Options"
                ("Customize" (custom-global-menu))
                ("Refresh" (refresh))
                ("Sleep" (sleep-now))
                ("Exec cut" 
                 (execute-string (+ "(? " cut-buffer ")")))
                ("Redecorate" (redecorate-all))
                ("Deiconify all" (deiconify-all))
                ("Unfocus" (focus-window))
                ("Toggle IconMgr" (icon-mgr-toggle))
                ("Toggle Virtual" (virtual-toggle))
                ("Restart" (restart))
                ("Quit" (end))))
)

;; Menu with useful window commands (and some global)
(if (not (and (boundp 'window-pop-list) window-pop-list))
(setq window-pop-list 
              '("Window Options"	
                ("Raise" (raise-window))
                ("Lower" (lower-window))
                ("Resize" (fvwm-resize-window))
                ("Move" (move-window))
                ("Iconify" (toggle-iconify-window))
                ("Zoom" (zoom-window))
                ("Nail" (fvwm-toggle-nail-window))
                ("Focus" (focus-window))
                ("Refresh" (refresh window))
                ("Redecorate" (re-decorate-window))
                ("Kill" (or (delete-window) (kill-window)))))
)

(defun construct-dialogue-item (name query defaultvar action)
  (with (col (make-color-scheme fvwm-menu-color fvwm-menu-text-color)
         font (if (= (type fvwm-menu-font) 'string)
                  (font-make fvwm-menu-font)
                fvwm-menu-font))
    (fvwm-menu-item-make name (` (with (background (, (# 1 col))
                                        foreground (, (# 3 col))
                                        borderwidth 1
                                        font (, font)
                                        reply (simple-dialogue (, query)
                                                               (, defaultvar)))
                                   (if reply 
                                       (progn
                                         (if (quote (, defaultvar))
                                             (setq (, defaultvar) reply))
                                         (, action))))))))

(setq global-last-host ())
(setq global-last-command ())

;; Menu to log in to other machines. First comes the local host, then
;; all host you can log in to with "rsh" (in machine-list), and then
;; those you need to give an additional password (in telnet-machine-list).
(defun make-login-pop ()
  (construct-menu
   "Logins"
   (construct-machine-menu-items (list hostname)
             ; This is to get around a bug that turns up
             ; when gwmchat and bash is used together
             (if (match "bash$" (getenv "SHELL"))
                 (+ '(! "xterm" "-T" name "-e" "csh" "-c")
                    (list (getenv "SHELL")))
               '(! "xterm" "-n" name)))
   (construct-machine-menu-items (with (mem (member hostname machine-list))
                                   (if mem                       
                                       (delete-nth mem (copy machine-list))
                                       machine-list))
              '(! "xlogin" host "-n" name))
   (construct-machine-menu-items telnet-machine-list
              '(! "xterm" "-T" name "-e" "telnet" host))
   (construct-dialogue-item "Other..." "Login to:" 'global-last-host 
                            '(! "xlogin" reply "-n" (machine-name reply)))))


;; Menu for starting xload
(defun make-xload-pop ()
  (construct-menu 
   "Xload"
   (construct-machine-menu-items (list hostname)
                                 '(! "xload"))
   (construct-machine-menu-items (with (mem (member hostname machine-list))
                                   (if mem                       
                                       (delete-nth mem (copy machine-list))
                                     machine-list))
                                 '(xrsh-command host '("xload")))
   (construct-dialogue-item "Other..." "Xload at:" 'global-last-host 
                            '(xrsh-command  reply '("xload")))))

;; Menu for starting emacs
(defun make-emacs-pop ()
  (construct-menu 
   "Emacs"
   (construct-machine-menu-items (list hostname)
                                 '(! "emacs" "-name" (+ name "-Emacs") "-geometry" "85x50"))
   (construct-machine-menu-items (with (mem (member hostname machine-list))
                                   (if mem                       
                                       (delete-nth mem (copy machine-list))
                                     machine-list))
                                 '(xrsh-command host '("emacs" "-name" (+ name "-Emacs") "-geometry" "85x50")))
   (construct-dialogue-item "Other..." "Emacs at:" 'global-last-host 
                            '(xrsh-command reply '("emacs" "-name" (+ (machine-name reply) "-Emacs") "-geometry" "85x50")))))

;; Auxilary function and menu for starting an xterm, an emacs and an xload
;; on some machine, in a fresh area on the virtual screen.
(defun remote-start (host name)
  (maybe-add-door name 'free)
  (goto-door name)
  (xrsh-command host (list "xterm" "-n" name
                      "-geometry" (virtual-coord-string 20 60)))
  (xrsh-command host (list "emacs" "-name" (+ name "-Emacs")
                      "-geometry" (+ "164x55" (virtual-coord-string 10 110))))
  (xrsh-command host (list "xload")))

(defun make-start-pop ()
  (construct-menu 
   "Start all"
   (construct-machine-menu-items (list hostname)
                                 '(remote-start "." name))
   (construct-machine-menu-items (with (mem (member hostname machine-list))
                                   (if mem                       
                                       (delete-nth mem (copy machine-list))
                                     machine-list))
                                 '(remote-start host name))
   (construct-dialogue-item "Other..." "Start at:" 'global-last-host 
                            '(remote-start reply (machine-name reply)))))

(defun make-machine-mpop ()
  (construct-multimenu 
   "Machines"
   (construct-machine-menu-items (list hostname)
                                 '".")
   (construct-machine-menu-items (with (mem (member hostname machine-list))
                                   (if mem                       
                                       (delete-nth mem (copy machine-list))
                                     machine-list))
                                 'host)
   (construct-dialogue-item "Other..." "Machine:" 'global-last-host 
                            'reply)))

(defun make-command-mpop ()
  (construct-multimenu
   "Commands"
   '("Xterm" '("xterm" "-n" (machine-name host)))
   '("Emacs" '("emacs" "-name" 
               (+ (machine-name host) "-Emacs")
               "-geometry" "85x50"))
   '("Xload" '("xload"))
   '("Xbiff" '("xbiff"))
   (construct-dialogue-item "Other..." "Command:" 'global-last-command 
                            '(list reply))))
;                            '(list "csh" "-f" "-c" reply))))

(defun exec-multi-cmd (host cmd)
  (if (and host cmd)
      (xrsh-command host cmd)))

;; If you rather want one menu with several commands (to run on the
;; local host), then you can do something like this:
(if (not (and (boundp 'command-pop-list) command-pop-list))
(setq command-pop-list
                 '("Command"
                   ("Xterm" (! "xterm" "-n" (machine-name hostname)))
                   ("Emacs" (! "emacs" "-name" 
                              (+ (machine-name hostname) "-Emacs")
                              "-geometry" "85x50"))
                   ("Xload" (! "xload"))
                   ("All" (remote-start hostname (machine-name hostname)))
                   ("Calc" (! "xcalc"))
                   ("Lock" (! "xnlock" "-rv"))))
)

;; Function to create a windows menu which pops to (i.e. scrolls to, 
;; deiconifies, and raises) the selected window. It is a function, so
;; that the menu can be rebuilt with the current windows every time it
;; is used.
(defun windows-pop ()
  (construct-window-menu "Windows" '(pop-to-window)))


(defun update-menus ()
  (setq root-pop (apply construct-menu root-pop-list))
  (setq window-pop (apply construct-menu window-pop-list))
  (setq command-pop (apply construct-menu 
                           (+ command-pop-list
                              (list (construct-dialogue-item "Other..."
                                                             "Command:"
                                                             'global-last-command 
                                                             '(! "csh" "-f" "-c" reply))))))
  (setq command-mpop (make-command-mpop))
  (setq machine-mpop (make-machine-mpop))
  (setq login-pop (make-login-pop))
  (setq emacs-pop (make-emacs-pop))
  (setq xload-pop (make-xload-pop))
  (setq start-pop (make-start-pop)))

(update-menus)

(custom-install-symbols "menus"
  '(machine-list 
    telnet-machine-list
    root-pop-list
    window-pop-list
    command-pop-list))

(custom-install-hook "menus" '(update-menus))

(custom-install-hook "fvwm-menu" '(update-menus))


;;=============================================================================
;;
;;        Behaviors
;;
;;=============================================================================

;;=============================================================================
;;        Root behavior
;;=============================================================================

;; This one uses several of the menus defined above
(setq root-behavior
  (state-make
    (on (buttonpress 1 any)
        (fvwm-pop-menu command-pop))
    (on (buttonpress 2 any)
        (fvwm-pop-multimenu exec-multi-cmd machine-mpop command-mpop))
    (on (buttonpress 3 any)
        (if (> (bitwise-and (current-event-modifier) with-shift) 0)
            (fvwm-pop-menu (windows-pop))
            (fvwm-pop-menu root-pop)))
    (on (keyrelease (key-make "Help") any) 
        (execute-string (+ "(? " cut-buffer ")")))
   ))

;;=============================================================================
;;        Common behavior for windows and icons
;;=============================================================================

(setq standard-behavior
  (state-make
    (on (buttonpress 1 any) (raise-lower-move-window))
    (on (buttonpress 2 any) (move-window))
    (on (buttonpress 3 any) (fvwm-pop-menu window-pop))
    (on (keyrelease (key-make "Help") any) 
        (execute-string (+ "(? " cut-buffer ")")))
   ))

;;=============================================================================
;;        Window behavior
;;=============================================================================

(setq window-behavior
  ())                   ; Nothing more than standard-behavior

;;=============================================================================
;;        Window titlebar behavior (in addition to above)
;;=============================================================================

(setq standard-title-behavior
  ())                   ; Nothing more than standard-behavior

;;=============================================================================
;;        Icon behavior
;;=============================================================================

(setq icon-behavior
  (state-make
    (on (buttonpress 1 any) (pop-to-window))
   ))

;;=============================================================================
;;        Icon Manager behavior
;;=============================================================================

(setq icon-mgr-behavior
  (state-make
    (on (buttonpress 1 any)
        (icon-mgr-with-window
          (pop-to-window)))
    (on (buttonpress 2 any)
        (icon-mgr-with-window
          (toggle-iconify-window)))
    (on (buttonpress 3 any)
        (icon-mgr-with-window
          (fvwm-pop-menu window-pop)))
    ))

;;=============================================================================
;;        Grabs (i.e. which events to steal from clients)
;;=============================================================================

(: fvwm-grabs (list
               (button any with-alt)
               (button any (together with-alt with-lock))
               (button any (together with-alt with-modifier-3))
               (button any (together with-alt with-lock with-modifier-3))
               (key "Help" any)))


;;=============================================================================
;;
;;        Miscellaneous
;;
;;=============================================================================

;; Where on the screen to put icons: down the right edge
(set-icon-placement any rows.right-top.placement)
(rows.limits rows.right-top 
             'start 180
             'offset 10
             'separator 4)

;; Place xclock, xbiff and all xloads in top of screen
(set-placement XLoad rows.top-right.placement) 
(set-placement XClock rows.top-right.placement)
(set-placement XBiff rows.top-right.placement)
(rows.limits rows.top-right 
             'start 330 
             'offset 4 
             'separator 3
             'sort (lambda (w1 w2) 
                     (compare (or (member (with (wob w1) window-client-class)
                                          '(XBiff XClock XLoad)) 3)
                              (or (member (with (wob w2) window-client-class)
                                          '(XBiff XClock XLoad)) 3))))

(setq placement-list '(("^xv" random-placement)))

(defaults-to
  default-window-type "fvwm-window"
  default-icon-type "fvwm-icon"
)

(defun update-windows ()
  (apply set-window (list 'any (atom default-window-type)))
  (apply set-icon-window (list 'any (atom default-icon-type))))

(update-windows)

(custom-install-symbols "windows"
  '(default-window-type
    default-icon-type))

(custom-install-hook "windows" '(update-windows))

