533 lines
15 KiB
Plaintext
533 lines
15 KiB
Plaintext
;; fvwm.gwm --- FVWM profile for GWM
|
|
;;
|
|
;; 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 file is the main file of the FVWM profile for gwm.
|
|
;;
|
|
;; This profile is mainly a copy of the VTWM profile, with fvwm style
|
|
;; windows ', icons, and menus. There are (currently) no virtual rooms,
|
|
;; nor any "GoodStuff" panel.
|
|
;;
|
|
;; All normal user customization of the profile (colors, original
|
|
;; positions and sizes, behaviors, menus, etc.) can be done either
|
|
;; in "fvwmrc.gwm", or via interactive customization menus.
|
|
;;
|
|
|
|
(load "trace-func")
|
|
(stack-print-level 5)
|
|
(setq display-name-radix (match "\\([^:]*:[0-9][0-9]*\\)" display-name 1))
|
|
(defname 'x-screen-name screen. '(+ display-name-radix "." (itoa screen)))
|
|
|
|
(if (= gwm-quiet 0)
|
|
(progn
|
|
(for screen (list-of-screens)
|
|
(? x-screen-name " " screen-width " x " screen-height " x "
|
|
screen-depth "\n"))
|
|
(print "reading")
|
|
(: original-load load)
|
|
(defun load (file) (? ".")(original-load file))
|
|
))
|
|
|
|
(load "std-func")
|
|
|
|
;; General appearance
|
|
;; ------------------
|
|
|
|
(: move-grid-style 3)
|
|
(: move-meter 0)
|
|
(: resize-grid-style 4)
|
|
(: resize-meter 0)
|
|
(: property ())
|
|
(: borderwidth 2)
|
|
(: border-on-shaped 1)
|
|
|
|
|
|
;; Some nice names for use later in the profile
|
|
;; --------------------------------------
|
|
|
|
(set-color black Black)
|
|
(set-color white White)
|
|
(set-color grey Grey)
|
|
(set-color darkgrey DarkSlateGrey)
|
|
|
|
(: name-font (font-make "9x15"))
|
|
(: small-font (font-make "6x10"))
|
|
|
|
(: any-button (button any any))
|
|
(: any-key (key any any))
|
|
|
|
(: select-button 1)
|
|
(: action-button 2)
|
|
(: menu-button 3)
|
|
|
|
|
|
(for screen (list-of-screens)
|
|
(: invert-color (bitwise-xor black white))
|
|
)
|
|
|
|
|
|
;;=============================================================================
|
|
;; Load and define several useful functions
|
|
;;=============================================================================
|
|
|
|
(load "utils")
|
|
(load "deltabutton")
|
|
|
|
|
|
; default placement make title bar in screen
|
|
(defun onscreen-placement (flag)
|
|
(if flag
|
|
(with (x window-x
|
|
y window-y)
|
|
bottom (+ window-y window-height))
|
|
(if (> (+ x window-width) screen-width)
|
|
(setq x (- screen-width window-width)))
|
|
(if (< x 0)
|
|
(setq x 0))
|
|
(if (> (+ y window-height) screen-height)
|
|
(setq y (- screen-height window-height)))
|
|
(if (< y 0)
|
|
(setq y 0))
|
|
(if (not (and (= x window-x) (= y window-y)))
|
|
(move-window x y))))
|
|
|
|
(setq place-x-offset 23)
|
|
(setq place-y-offset 19)
|
|
(setq place-x-wrap 1031)
|
|
(setq place-y-wrap 871)
|
|
(setq place-last-x 0)
|
|
(setq place-last-y 100)
|
|
|
|
(defun random-placement (flag)
|
|
(if flag
|
|
(if (not (or window-was-on-screen
|
|
;; window-starts-iconic
|
|
;; window-is-transient-for
|
|
(not (= window-status 'window))))
|
|
(with (left (+ place-last-x place-x-offset)
|
|
right (+ left window-width)
|
|
top (+ place-last-y place-y-offset)
|
|
bottom (+ top window-height))
|
|
(if (> right 1024)
|
|
(setq place-last-x (with (neg (- left place-x-wrap))
|
|
(+ neg (* (/ (- place-x-offset neg 1)
|
|
place-x-offset)
|
|
place-x-offset))))
|
|
(setq place-last-x left))
|
|
(if (> bottom 864)
|
|
(setq place-last-y (with (neg (- top place-y-wrap))
|
|
(+ neg (* (/ (- place-y-offset neg 1)
|
|
place-y-offset)
|
|
place-y-offset))))
|
|
(setq place-last-y top))
|
|
(move-window place-last-x place-last-y)))))
|
|
|
|
(defun fvwm-user-placement (flag)
|
|
(if flag
|
|
(if (not (or window-was-on-screen
|
|
;; window-starts-iconic
|
|
;; window-is-transient-for
|
|
(not (= window-status 'window))))
|
|
(with (pos (current-mouse-position)
|
|
cursor (cursor-make 130))
|
|
(move-window (# 0 pos) (# 1 pos))
|
|
(process-exposes)
|
|
(move-window)
|
|
(setq pos (current-mouse-position))
|
|
(if (> (# 2 pos) 0)
|
|
(progn
|
|
(warp-pointer 10 10)
|
|
(fvwm-resize-window)))))))
|
|
|
|
(defun fvwm-placement (flag)
|
|
(if flag
|
|
(if (or window-was-on-screen
|
|
;; window-starts-iconic
|
|
;; window-is-transient-for
|
|
(= window-client-class 'Gwm)
|
|
(not (= window-status 'window))
|
|
;; (virtual-nailed)
|
|
)
|
|
()
|
|
(or (not (or window-program-set-position
|
|
window-user-set-position))
|
|
(and (= window-x 0)
|
|
(= window-y 0)))
|
|
(if place-randomly
|
|
(random-placement flag)
|
|
(fvwm-user-placement flag))
|
|
window-user-set-position
|
|
(virtual-placement flag)
|
|
window-program-set-position
|
|
(with (left window-x
|
|
right (+ left window-width)
|
|
top window-y
|
|
bottom (+ top window-height))
|
|
(if (not (and (< left screen-width)
|
|
(> right -1)
|
|
(< top screen-height)
|
|
(> bottom -1)))
|
|
(if place-randomly
|
|
(random-placement flag)
|
|
(fvwm-user-placement flag)))))))
|
|
|
|
|
|
(load "placements")
|
|
|
|
;;=============================================================================
|
|
;; Wrappers for some primitive functions
|
|
;;=============================================================================
|
|
|
|
|
|
(if (not (boundp 'raise-window-orig))
|
|
(progn
|
|
|
|
(: raise-window-orig raise-window)
|
|
|
|
(defun raise-window arg
|
|
(if (and arg (# 0 arg))
|
|
(raise-window-orig (# 0 arg))
|
|
(raise-window-orig))
|
|
(if (not autofocus)
|
|
(if arg
|
|
(set-focus (# 0 arg))
|
|
(set-focus)))
|
|
(virtual-update))
|
|
))
|
|
|
|
(if (not (boundp 'lower-window-orig))
|
|
(progn
|
|
|
|
(: lower-window-orig lower-window)
|
|
|
|
(defun lower-window arg
|
|
(if (and arg (# 0 arg))
|
|
(lower-window-orig (# 0 arg))
|
|
(lower-window-orig))
|
|
(virtual-update))
|
|
))
|
|
|
|
(if (not (boundp 'move-window-orig))
|
|
(progn
|
|
|
|
(: move-window-orig move-window)
|
|
|
|
(defun move-window args
|
|
(if (and raise-on-move (< (length args) 2))
|
|
(if (= (length args) 1)
|
|
(raise-window-orig (# 0 args))
|
|
(raise-window-orig)))
|
|
(if args
|
|
(eval (+ (list 'move-window-orig) args))
|
|
(move-window-orig))
|
|
(if (window-is-mapped)
|
|
(virtual-update)))
|
|
))
|
|
|
|
(if (not (boundp 'resize-window-orig))
|
|
(progn
|
|
|
|
(: resize-window-orig resize-window)
|
|
|
|
(defun resize-window args
|
|
(if (and raise-on-resize (< (length args) 2))
|
|
(if (= (length args) 1)
|
|
(raise-window-orig (# 0 args))
|
|
(raise-window-orig)))
|
|
(if args
|
|
(eval (+ (list 'resize-window-orig) args))
|
|
(resize-window-orig))
|
|
(if (window-is-mapped)
|
|
(virtual-update)))
|
|
))
|
|
|
|
;; This one is done in vtwm-icon-mgr.gwm instead
|
|
;;(if (not (boundp 'iconify-window-orig))
|
|
;; (progn
|
|
;;
|
|
;; (: iconify-window-orig iconify-window)
|
|
;;
|
|
;; (defun iconify-window ()
|
|
;; (if raise-on-iconify
|
|
;; (raise-window-orig))
|
|
;; (iconify-window-orig)
|
|
;; (virtual-update))
|
|
;;))
|
|
|
|
|
|
;;=============================================================================
|
|
;; Some more useful functions
|
|
;;=============================================================================
|
|
|
|
(defun windows-overlap (w1 w2)
|
|
(with (window w1
|
|
w1l window-x
|
|
w1t window-y
|
|
w1r (+ window-width w1l)
|
|
w1b (+ window-height w1t)
|
|
window w2
|
|
w2l window-x
|
|
w2t window-y
|
|
w2r (+ window-width w2l)
|
|
w2b (+ window-height w2t))
|
|
(and (< w2l w1r)
|
|
(< w2t w1b)
|
|
(> w2b w1t)
|
|
(> w2r w1l))))
|
|
|
|
(defun window-obscured ()
|
|
(with (unobscured t
|
|
might-obscure ())
|
|
(for w (list-of-windows 'stacking-order 'mapped)
|
|
(if (and might-obscure
|
|
(not (= (# 'float w) 'up)) ; ignore floating windows
|
|
(windows-overlap window w))
|
|
(: unobscured ()))
|
|
(if (= w window) (: might-obscure t)))
|
|
(not unobscured)))
|
|
|
|
(defun raiselower-window ()
|
|
(if (window-obscured)
|
|
(raise-window)
|
|
(lower-window)))
|
|
|
|
(defun raise-lower-move-window ()
|
|
(if (not autofocus)
|
|
(set-focus))
|
|
(if (deltabutton)
|
|
(move-window)
|
|
(raiselower-window)))
|
|
|
|
(defun pop-to-window ()
|
|
(if (and (wob-is-valid window)
|
|
(not (= window root-window)))
|
|
(with (wob window-window)
|
|
(virtual-make-window-visible)
|
|
(de-iconify-window)
|
|
(raise-window))))
|
|
|
|
(defun focus-window ()
|
|
(if (= window root-window)
|
|
(progn
|
|
(setq autofocus t)
|
|
(set-focus ()))
|
|
(progn
|
|
(setq autofocus ())
|
|
(set-focus window))))
|
|
|
|
(defun sleep-now ()
|
|
(set-screen-saver 1 0 1 1)
|
|
(with (ct (+ 2000 (elapsed-time)))
|
|
(while (> ct (elapsed-time))))
|
|
(process-events)
|
|
(set-screen-saver 300 0 1 1))
|
|
|
|
(defun deiconify-all ()
|
|
(for wob (list-of-windows)
|
|
(de-iconify-window)))
|
|
|
|
(defun redecorate-all ()
|
|
(with (show-icon-mgr ()
|
|
iconify-unmanaged-by-icon ()
|
|
show-virtual ())
|
|
(wob root-window)
|
|
(for wob (list-of-windows 'window)
|
|
(if (not (= window-client-class 'Gwm))
|
|
(re-decorate-window))))
|
|
(icon-mgr-show)
|
|
(virtual-show)
|
|
(door-mgr-show))
|
|
|
|
(defun virtual-coord-string (x y)
|
|
(+ "+" (itoa (virtual-x x))
|
|
"+" (itoa (virtual-y y))))
|
|
|
|
(defun place-window (flag)
|
|
(with (func (if (= window-status 'icon)
|
|
(or (# 0 (matches-cond icon-placement-list))
|
|
(std-resource-get 'GwmIconPlacement)
|
|
default-icon-placement)
|
|
(= window-status 'window)
|
|
(or (# 0 (matches-cond placement-list))
|
|
(std-resource-get 'GwmPlacement)
|
|
default-placement)))
|
|
(eval (list func flag))))
|
|
|
|
;;=============================================================================
|
|
;; Openings and Closings
|
|
;;=============================================================================
|
|
|
|
(: opening
|
|
'(progn
|
|
(place-window t)
|
|
(icon-mgr-add)
|
|
(virtual-add)))
|
|
|
|
(: closing
|
|
'(progn
|
|
(place-window ())
|
|
(virtual-remove)
|
|
(icon-mgr-remove)))
|
|
|
|
(: screen-opening
|
|
'(progn
|
|
(: setup-done t)
|
|
(virtual-show)
|
|
(door-add-initial)
|
|
(if show-pan-lists
|
|
(install-pan-lists))
|
|
(icon-mgr-show)))
|
|
|
|
(: screen-closing
|
|
'(progn
|
|
(virtual-move-home)
|
|
(for wob (list-of-windows 'window)
|
|
(map-window)))) ; Dont lose unmapped windows on restart
|
|
|
|
|
|
(load "custom-install")
|
|
|
|
|
|
;;=============================================================================
|
|
;; User Profile
|
|
;;=============================================================================
|
|
|
|
(declare-screen-dependent
|
|
screen-tile
|
|
root-cursor
|
|
setup-done
|
|
autoraise
|
|
autocolormap
|
|
autofocus
|
|
default-placement
|
|
default-icon-placement
|
|
placement-list
|
|
icon-placement-list
|
|
place-randomly
|
|
raise-on-move
|
|
raise-on-resize
|
|
raise-on-iconify
|
|
to-be-done-after-setup
|
|
)
|
|
|
|
;;
|
|
;; USER CUSTOMIZABLE VARIABLES
|
|
;; ---------------------------
|
|
;; Adjust these in your own profile
|
|
;;
|
|
(for screen (list-of-screens)
|
|
(defaults-to
|
|
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-icon-placement ()
|
|
placement-list ()
|
|
icon-placement-list ()
|
|
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
|
|
to-be-done-after-setup '(progn) ; good for user setup
|
|
)
|
|
)
|
|
|
|
|
|
(for screen (list-of-screens)
|
|
(: setup-done ())
|
|
)
|
|
|
|
(load "virtual")
|
|
(load "virtual-door")
|
|
(load "virtual-pan")
|
|
|
|
(load "fvwm-window")
|
|
(load "fvwm-icon")
|
|
(load "vtwm-zoom")
|
|
(load "vtwm-icon-mgr")
|
|
(load "fvwm-menu")
|
|
|
|
(load "pick")
|
|
|
|
;; Here comes the user settings:
|
|
(if (= 0 gwm-quiet) (? "["))
|
|
(for screen (list-of-screens)
|
|
(load "fvwmrc"))
|
|
(if (= 0 gwm-quiet) (? "]"))
|
|
|
|
;; Some reasonable defaults if the user failed to give these:
|
|
(defaults-to root-pop
|
|
(construct-menu
|
|
"Root Options"
|
|
'("Refresh" (refresh))
|
|
'("Exec cut"
|
|
(execute-string (+ "(? " cut-buffer ")")))
|
|
'("Restart" (restart))
|
|
'("Quit" (end)))
|
|
)
|
|
(defaults-to root-behavior
|
|
(state-make
|
|
(on (buttonpress 3 any) (fvwm-pop-menu root-pop)))
|
|
)
|
|
(defaults-to fvwm-grabs ())
|
|
|
|
;; Add "virtual" behavior (scrolling on arrows)
|
|
(: standard-behavior (state-make standard-behavior (virtual-behavior)))
|
|
(: root-behavior (state-make root-behavior (virtual-behavior)))
|
|
(: fvwm-grabs (+ (virtual-grabs) fvwm-grabs))
|
|
|
|
;; Let root behavior and grabs have effect
|
|
(: root-fsm (fsm-make root-behavior))
|
|
(: grabs (: root-grabs (: window-grabs (: icon-grabs fvwm-grabs))))
|
|
|
|
|
|
;;=============================================================================
|
|
;; DESCRIBE-SCREEN & DESCRIBE-WINDOW
|
|
;;=============================================================================
|
|
|
|
(de describe-screen ()
|
|
(with (fsm root-fsm
|
|
cursor root-cursor
|
|
menu root-pop
|
|
tile screen-tile
|
|
grabs root-grabs
|
|
opening '(progn
|
|
(eval screen-opening)
|
|
(eval to-be-done-after-setup)
|
|
(if (= 0 gwm-quiet)
|
|
(? "Screen #" screen " ready.\n")))
|
|
closing '(eval screen-closing))
|
|
(window-make () () () () ())))
|
|
|
|
(de describe-window ()
|
|
(list
|
|
(autoload-description
|
|
(or (std-resource-get 'GwmWindow)
|
|
fvwm-window))
|
|
'(autoload-description
|
|
(or (std-resource-get 'GwmIconWindow)
|
|
fvwm-icon))))
|
|
|
|
|
|
;; That's all, folks
|
|
;; -----------------
|
|
|
|
(if (= 0 gwm-quiet)
|
|
(progn
|
|
(setq load original-load)
|
|
(print "done\n")
|
|
)
|
|
(bell)
|
|
)
|
|
|