261 lines
6.9 KiB
Plaintext
261 lines
6.9 KiB
Plaintext
;; std-func.gwm --- Standard functions used by most GWM profiles
|
|
;;
|
|
;; ---------------------------------------------------------------------
|
|
;;
|
|
;; Note from Anders Holst (aho@sans.kth.se):
|
|
;; This file is not really written by me, I just cut it out from
|
|
;; ".profile.gwm" since its functions are used by most profiles, and
|
|
;; its a pity to duplicate. I use it for the VTWM profile.
|
|
;;
|
|
|
|
|
|
;;=============================================================================
|
|
;; 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.any.any.any.any.any.any" resource-class))
|
|
(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))
|
|
|
|
|
|
; 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)))
|
|
))))
|
|
|