616 lines
17 KiB
Plaintext
616 lines
17 KiB
Plaintext
;;=============================================================================
|
|
;; STANDARD GWM PROFILE
|
|
;;=============================================================================
|
|
|
|
;;File: .gwmrc.gwm -- the GWM standard profile
|
|
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
|
|
;;Revision: 1.4 -- June 12 1989
|
|
;;State: Exp
|
|
;;GWM Version: 1.4
|
|
|
|
;;=============================================================================
|
|
;; Initialisations
|
|
;;=============================================================================
|
|
|
|
; banner
|
|
; ======
|
|
|
|
(load 'trace-func)
|
|
(stack-print-level 3)
|
|
(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))
|
|
))
|
|
|
|
; appearance
|
|
; ==========
|
|
|
|
(: name-font (font-make "9x15"))
|
|
(: meter-font (font-make "9x15"))
|
|
(: bull-font (font-make "9x15"))
|
|
(: small-font (font-make "6x10"))
|
|
|
|
; global switches
|
|
; ===============
|
|
|
|
(: move-grid-style 3)
|
|
(: resize-grid-style 4)
|
|
|
|
(: property ())
|
|
(: borderwidth 1)
|
|
(: any-button (button any any))
|
|
(: any-key (key any any))
|
|
|
|
(: select-button 1)
|
|
(: action-button 2)
|
|
(: menu-button 3)
|
|
|
|
(: autoraise ())
|
|
(: autocolormap t)
|
|
(: no-set-focus ())
|
|
(: to-be-done-after-setup '(progn)) ; obsolete: use screen-opening
|
|
(: screen-opening '(progn)) ; actions to be done before operation
|
|
(: screen-closing ; actions to be done when ending
|
|
'(progn
|
|
))
|
|
|
|
(setq left "left")
|
|
(setq base "base")
|
|
(setq bottom "bottom")
|
|
(setq right "right")
|
|
(setq top "top")
|
|
|
|
; per-screen data setting
|
|
; =======================
|
|
|
|
(defunq defname-in-screen-to args
|
|
(with (value (eval (# 0 args))
|
|
vars (sublist 1 (length args) args))
|
|
(for var vars
|
|
(defname var screen. value))))
|
|
|
|
(defunq set-color (name value)
|
|
(if (not (= screen. (namespace-of name)))
|
|
(progn
|
|
(defname name screen.)
|
|
(for screen (list-of-screens)
|
|
(set name (color-make value)))
|
|
)))
|
|
|
|
(defunq set-pixmap args
|
|
(with (name (# 0 args)
|
|
pixmap-make-call (# 0 args 'pixmap-make))
|
|
(if (not (= screen. (namespace-of name)))
|
|
(progn
|
|
(defname name screen.)
|
|
(for screen (list-of-screens)
|
|
(set name (eval pixmap-make-call)))
|
|
))))
|
|
|
|
; per-screen data
|
|
; ===============
|
|
|
|
(defname-in-screen-to () tile screen-tile bordertile menu root-cursor)
|
|
|
|
(defname 'root-pop screen.)
|
|
(defname 'window-pop screen.)
|
|
(defname 'icon-pop screen.)
|
|
(set-color black Black)
|
|
(set-color white White)
|
|
(set-color grey Grey)
|
|
(set-color darkgrey DarkSlateGrey)
|
|
(set-color lightgrey LightGrey)
|
|
(set-pixmap icon-pixmap "icon20")
|
|
|
|
(defname 'look-3d screen.)
|
|
(for screen (list-of-screens)
|
|
(if (= 'mono screen-type)
|
|
(: look-3d ())
|
|
(: look-3d t)
|
|
(: invert-color (bitwise-xor black white))
|
|
))))
|
|
|
|
; functions to affect decorations to a client name
|
|
; =================================================
|
|
|
|
; The assignement of decorations to client names:
|
|
; a decoration is either:
|
|
; a function yielding the decoration
|
|
; an unbound variable: the corresponding file is then loaded, which
|
|
; must define the function
|
|
|
|
(load 'utils)
|
|
|
|
;;=============================================================================
|
|
;; X resource management for the standard profile
|
|
;;=============================================================================
|
|
;;
|
|
|
|
(defun std-resource-get args
|
|
(with (resource-class (# 0 args) resource-name (# 1 args) Name () Class ())
|
|
(: Name (+ -screen-name '.
|
|
window-client-class '.
|
|
(make-string-usable-for-resource-key-non-nil window-client-name) '.
|
|
(make-string-usable-for-resource-key-non-nil window-name) '.
|
|
screen-type '.
|
|
window-machine-name '.
|
|
(if resource-name resource-name resource-class)
|
|
))
|
|
;; (: Class (+ "S......" resource-class)) ;; makes Xrm crash on sun4s
|
|
(: Class (+ "S.any.any.any.any.any.any" resource-class))
|
|
;; (? "resource-get " Name " " Class " = " (resource-get Name Class) "\n")
|
|
(resource-get Name Class)
|
|
))
|
|
|
|
;; puts resource:
|
|
;; (std-resource-put resource-name
|
|
;; [screen-type] clientclass[name[windnowname[machine]]]]
|
|
;; value)
|
|
|
|
(defun std-resource-put (Resource args)
|
|
(with (Client-desc () Value () Screen () Name ())
|
|
(if (= 3 (length args))
|
|
(progn
|
|
(: Client-desc (# 1 args))
|
|
(: Value (# 2 args))
|
|
(: Screen (# 0 args))
|
|
)
|
|
(progn
|
|
(: Client-desc (# 0 args))
|
|
(: Value (# 1 args))
|
|
))
|
|
(: Name (std-resource-expand Client-desc Screen Resource))
|
|
;; (? "resource-put " Name " " Value "\n")
|
|
(resource-put Name Value)
|
|
))
|
|
|
|
;; expands class[.name[.wname[.machine]]] visual Resource
|
|
;; into ScreenNumber.class.name.wname.visual.machine.Resource
|
|
|
|
(defun std-resource-expand (desc visual resource)
|
|
(if (match "[*]" desc)
|
|
(+ -screen-name
|
|
(if (match "^[*]" desc) () '.)
|
|
desc
|
|
(if (match "[*]$" desc) () '.)
|
|
resource)
|
|
(with (tmp (match
|
|
"^\\([^.]*\\)[.]*\\([^.]*\\)[.]*\\([^.]*\\)[.]*\\([^.]*\\)$"
|
|
desc 1 2 3 4
|
|
))
|
|
(make-resource-string -screen-name (# 0 tmp) (# 1 tmp) (# 2 tmp)
|
|
visual (# 3 tmp) 'any resource
|
|
))))
|
|
|
|
;; appends list elements with '.', collapsing consecutive void (or any)
|
|
;; elements into *
|
|
|
|
(defun make-resource-string l
|
|
(with (star () first t l2
|
|
(mapfor elt l
|
|
(if (or (= "any" elt) (not elt))
|
|
(if star
|
|
""
|
|
(progn
|
|
(setq star t)
|
|
"*"
|
|
)
|
|
)
|
|
(progn
|
|
(setq star ())
|
|
(if first (progn (setq first ()) elt)
|
|
(+ "." elt)
|
|
)))))
|
|
(eval (+ '(+) l2))
|
|
))
|
|
|
|
|
|
;(trace-func std-resource-put)
|
|
|
|
;; customisation of decos by context
|
|
;; (customize deco screen application context...)
|
|
|
|
(defun customize-usage (string)
|
|
(? "USAGE: (customize deco screen application context...),\n"
|
|
"error was: " string "\n"
|
|
(exit customize)
|
|
))
|
|
|
|
(defunq customize args
|
|
(tag customize
|
|
(with (Deco (# 0 args)
|
|
Screen (# 1 args)
|
|
Application (# 2 args)
|
|
Context (if (and (= 4 (length args)) (= 'list (type (# 3 args))))
|
|
(# 3 args)
|
|
(sublist 3 (length args) args)
|
|
)
|
|
l (length Context)
|
|
i 1
|
|
)
|
|
(while (< i l)
|
|
(## i Context (eval (# i Context)))
|
|
(setq i (+ 2 i))
|
|
)
|
|
(std-resource-put Deco (list Screen Application Context))
|
|
)))
|
|
|
|
;; recursively evaluates till we obtain a context
|
|
|
|
(defun get-context (name)
|
|
(do-get-context name 0)
|
|
)
|
|
|
|
(defun do-get-context (name level)
|
|
(if (> level max-autoload-evaluation) name
|
|
(progn
|
|
(setq name
|
|
(if (# (type name) string-types)
|
|
(progn ; atoms:
|
|
(if (= 'string (type name))
|
|
(: name (atom name))) ; string->atom to test if defined
|
|
(if (boundp name)
|
|
(eval name) ; defined: eval
|
|
(progn
|
|
(load name) ; undefined, load and returns itself
|
|
name
|
|
)))
|
|
(# (type name) func-types) ; function: called without args
|
|
(eval (list name))
|
|
(= (type name) 'list)
|
|
(if (= (% (length name) 2) 0) ; if even list, its a context
|
|
name
|
|
(= 1 (length name)) ; if one element, return it
|
|
(# 0 name)
|
|
(eval name) ; if odd list, eval
|
|
)
|
|
(eval name) ; others: eval
|
|
))
|
|
(if (or (not name)
|
|
(and (= (type name) 'list)(= (% (length name) 2) 0)))
|
|
name
|
|
(do-get-context name (+ 1 level)
|
|
)))))
|
|
|
|
|
|
;;=============================================================================
|
|
;; user-callable resource settings
|
|
;;=============================================================================
|
|
|
|
(defname '-screen-name screen.)
|
|
(for screen (list-of-screens)
|
|
(: -screen-name (+ "S" (itoa screen)))
|
|
(std-resource-put 'GwmWindow (list screen-type ()))
|
|
(std-resource-put 'GwmIconWindow (list screen-type ()))
|
|
(std-resource-put 'GwmIconPixmap (list screen-type ()))
|
|
(std-resource-put 'GwmPlacement (list screen-type ()))
|
|
(std-resource-put 'GwmIconPlacement (list screen-type ()))
|
|
)
|
|
|
|
(: string-types '(string t atom t pointer t active t))
|
|
(: func-types '(expr t fexpr t subr t fsubr t))
|
|
|
|
(setq max-autoload-evaluation 10)
|
|
|
|
(defun autoload-description (name)
|
|
(with (level 0)
|
|
(do-autoload-description name level)
|
|
))
|
|
|
|
;; recursively evaluates or load description to obtain a wl_client
|
|
|
|
(defun do-autoload-description (name level)
|
|
(if (> level max-autoload-evaluation) name
|
|
(progn
|
|
(setq name
|
|
(if (# (type name) string-types)
|
|
(progn ; atoms:
|
|
(if (= 'string (type name))
|
|
(: name (atom name))) ; string->atom to test if defined
|
|
(if (boundp name)
|
|
(eval name) ; defined: eval
|
|
(progn
|
|
(load name) ; undefined, load and returns itself
|
|
name
|
|
)))
|
|
(# (type name) func-types) ; function: called without args
|
|
(eval (list name))
|
|
(eval name) ; others: evalb
|
|
))
|
|
(if (= 'client (type name)) name
|
|
(do-autoload-description name (+ 1 level)
|
|
))))))
|
|
|
|
(defun autoload-description (name)
|
|
(do-autoload-description name 0)
|
|
)
|
|
|
|
(defunq set-window args (std-resource-put 'GwmWindow args))
|
|
|
|
(defunq set-icon-window args (std-resource-put 'GwmIconWindow args))
|
|
|
|
(defunq set-icon args
|
|
(## (- (length args) 1) args (expand-pixmap (# (- (length args) 1) args)))
|
|
(std-resource-put 'GwmIconPixmap args)
|
|
)
|
|
|
|
(defun expand-pixmap (obj)
|
|
(if (and obj (# (type obj) string-types))
|
|
(pixmap-make obj)
|
|
(eval obj)))
|
|
|
|
(defunq set-placement args (std-resource-put 'GwmPlacement args))
|
|
|
|
(defunq set-icon-placement args (std-resource-put 'GwmIconPlacement args))
|
|
|
|
;;=============================================================================
|
|
;; automatic placement
|
|
;;=============================================================================
|
|
|
|
(de apply1 (func arg)
|
|
(eval (list (eval func) arg)))
|
|
|
|
(: opening
|
|
'(progn
|
|
(apply1 (if (= window-status 'icon)
|
|
(std-resource-get 'GwmIconPlacement)
|
|
(= window-status 'window)
|
|
(std-resource-get 'GwmPlacement)
|
|
)
|
|
t)))
|
|
|
|
(: closing
|
|
'(progn
|
|
(apply1 (if (= window-status 'icon)
|
|
(std-resource-get 'GwmIconPlacement)
|
|
(= window-status 'window)
|
|
(std-resource-get 'GwmPlacement)
|
|
)
|
|
())
|
|
))
|
|
|
|
; default placement make title bar in screen
|
|
(defun default-placement (flag)
|
|
(if flag
|
|
(if (< window-y 0) (move-window window-x 0))))
|
|
|
|
(load "placements")
|
|
|
|
;;=============================================================================
|
|
;; std-... wrappers for raise-current flag
|
|
;;=============================================================================
|
|
|
|
(if (not (boundp 'std-move-window))
|
|
(progn
|
|
(: raise-on-move t)
|
|
(defun std-move-window ()
|
|
(if raise-on-move (raise-window))
|
|
(move-window)
|
|
)
|
|
(: raise-on-resize t)
|
|
(defun std-resize-window ()
|
|
(if raise-on-resize (raise-window))
|
|
(resize-window)
|
|
)
|
|
(: raise-on-iconify t)
|
|
(defun std-iconify-window ()
|
|
(iconify-window)
|
|
(if raise-on-iconify (raise-window))
|
|
)))
|
|
|
|
;;=============================================================================
|
|
;; default behaviors
|
|
;;=============================================================================
|
|
|
|
;; standard-behavior is the default actions for all items
|
|
;; to make a fsm for a window or icon, do a
|
|
;; (fsm-make (state-make <your-actions> window-behavior standard-behavior)
|
|
;; (fsm-make (state-make <your-actions> icon-behavior standard-behavior)
|
|
|
|
(: standard-behavior
|
|
(state-make
|
|
(on (buttonpress select-button alone)
|
|
(std-move-window))
|
|
(on (button select-button with-shift) (lower-window))
|
|
(on (buttonpress select-button with-alt)
|
|
(std-move-window))
|
|
(on (button select-button (together with-shift with-alt))
|
|
(lower-window))
|
|
(on (buttonpress menu-button alone)
|
|
(progn (set-colormap-focus ()) (std-pop-menu)))
|
|
(on (buttonpress menu-button with-alt)
|
|
(progn (set-colormap-focus ()) (std-pop-menu)))
|
|
))
|
|
|
|
;; actions specific to window titles. should be used before
|
|
;; standard-behavior in further fsms
|
|
|
|
(: standard-title-behavior
|
|
(state-make
|
|
(on (buttonpress action-button alone)
|
|
(std-resize-window))
|
|
(on (buttonpress action-button with-alt)
|
|
(std-resize-window))
|
|
))
|
|
|
|
;; actions specific to windows
|
|
|
|
(: window-behavior
|
|
(state-make
|
|
(on (buttonpress action-button alone)
|
|
(std-resize-window))
|
|
(on (buttonpress action-button with-alt)
|
|
(std-resize-window))
|
|
(on name-change (send-user-event 'name-change))
|
|
(on focus-in (progn (if autoraise (raise-window))
|
|
(send-user-event 'focus-in)))
|
|
(on focus-out (send-user-event 'focus-out))
|
|
(if no-set-focus
|
|
(on enter-window (progn (if autoraise (raise-window))
|
|
(if autocolormap (set-colormap-focus))))
|
|
(on enter-window (progn (if autoraise (raise-window))
|
|
(set-focus)
|
|
(if autocolormap (set-colormap-focus)))))
|
|
(if (not no-set-focus)
|
|
(on leave-window (set-focus ())))
|
|
(on name-change (send-user-event 'name-change))
|
|
(on (property-change 'WM_ICON_NAME)
|
|
(if (window-icon?)
|
|
(send-user-event 'get-icon window-icon)))
|
|
(on window-icon-pixmap-change
|
|
(if (window-icon?)
|
|
(send-user-event 'icon-pixmap-change window-icon)))
|
|
))
|
|
|
|
;; icon-specific actions
|
|
|
|
(: icon-behavior
|
|
(state-make
|
|
(on (buttonrelease action-button any)
|
|
(std-iconify-window))
|
|
))
|
|
|
|
;; root-window actions
|
|
;; make root menu appear on any modifier combinations in case of problems
|
|
|
|
(: root-behavior
|
|
(state-make
|
|
(on (buttonpress menu-button any) (pop-root-menu))
|
|
))
|
|
|
|
(: old-standard-behavior ())
|
|
(: old-standard-title-behavior ())
|
|
(: old-window-behavior ())
|
|
(: old-icon-behavior ())
|
|
(: old-root-behavior ())
|
|
|
|
(: grabs (: root-grabs (: window-grabs (: icon-grabs (list
|
|
(button any with-alt)
|
|
(button select-button (together with-shift with-alt))
|
|
)))))
|
|
|
|
;; the function to call when redefining behaviors, to re-create fsms
|
|
;;==================================================================
|
|
|
|
(defun reparse-standard-behaviors ()
|
|
(if (not (and
|
|
(eq window-behavior old-window-behavior)
|
|
(eq standard-behavior old-standard-behavior)
|
|
))
|
|
(progn
|
|
(: window-fsm (fsm-make (state-make window-behavior standard-behavior)))
|
|
(: old-window-behavior window-behavior)
|
|
))
|
|
(if (not (and
|
|
(eq icon-behavior old-icon-behavior)
|
|
(eq standard-behavior old-standard-behavior)
|
|
))
|
|
(progn
|
|
(: icon-fsm (fsm-make (state-make icon-behavior standard-behavior)))
|
|
(: old-icon-behavior icon-behavior)
|
|
))
|
|
(if (not (eq root-behavior old-root-behavior))
|
|
(progn
|
|
(: root-fsm (fsm-make (state-make root-behavior)))
|
|
(: old-root-behavior root-behavior)
|
|
))
|
|
(: old-standard-behavior standard-behavior)
|
|
|
|
;; some sensible defaults for buggy decos
|
|
(: fsm window-fsm)
|
|
(: grabs window-grabs)
|
|
)
|
|
|
|
(reparse-standard-behaviors)
|
|
|
|
|
|
;;=============================================================================
|
|
;; User Profile
|
|
;;=============================================================================
|
|
|
|
; Pop-ups
|
|
; =======
|
|
|
|
(load "std-popups.gwm") ; default: the standard menu package
|
|
|
|
(for screen (list-of-screens) (: menu 'window-pop)))
|
|
|
|
; read user customizations in .profile.gwm, once per screen
|
|
; =========================================================
|
|
|
|
(if (= 0 gwm-quiet) (? "["))
|
|
(for screen (list-of-screens)
|
|
(load ".profile.gwm")
|
|
(if (= 'string (type screen-tile))
|
|
(: screen-tile (pixmap-make screen-tile)))
|
|
)
|
|
(if (= 0 gwm-quiet) (? "]"))
|
|
|
|
(load menu.builder) ; build menus from set-up descs
|
|
|
|
; The simplest window: no-decoration
|
|
; ==================================
|
|
|
|
(defun simple-window-decoration ()
|
|
(with (fsm window-fsm
|
|
borderwidth 0
|
|
inner-borderwidth any
|
|
menu window-pop)
|
|
(window-make () () () () ())))
|
|
(: no-frame-no-borders (: simple-icon-decoration
|
|
(: no-decoration simple-window-decoration))
|
|
)
|
|
|
|
; no-decoration by a small border
|
|
|
|
(df no-frame () (window-make ()()()()()))
|
|
|
|
;;=============================================================================
|
|
;; 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 to-be-done-after-setup)
|
|
(eval screen-opening)
|
|
(if (= 0 gwm-quiet)
|
|
(? "Screen #" screen " ready.\n")))
|
|
closing '(eval screen-closing)
|
|
)
|
|
(window-make () () () () ()))))
|
|
|
|
(de describe-window ()
|
|
(list
|
|
(autoload-description
|
|
(if (: tmp (std-resource-get 'GwmWindow))
|
|
tmp
|
|
'simple-win)
|
|
)
|
|
'(autoload-description ; defer evaluation till iconification
|
|
(if (: tmp (std-resource-get 'GwmIconWindow))
|
|
tmp
|
|
'simple-icon)
|
|
)))
|
|
|
|
; Bye bye
|
|
; ========
|
|
|
|
(if (= 0 gwm-quiet)
|
|
(progn
|
|
(setq load original-load)
|
|
(print "...done\n")
|
|
)
|
|
(bell)
|
|
)
|
|
|
|
;(trace-func do-autoload-description name)
|