409 lines
13 KiB
Scheme
409 lines
13 KiB
Scheme
;; iconfiy-window send a WM_CHANGE_STATE message (in an appropiate
|
|
;; format), to the root window of the specified screen. See
|
|
;; XIconifyWindow.
|
|
|
|
(define (iconify-window window screen-number)
|
|
(check-screen-number (window-display window) screen-number)
|
|
(if (not (%iconify-window (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
screen-number))
|
|
(error "cannot iconify window"
|
|
window)))
|
|
|
|
(import-lambda-definition %iconify-window (Xdisplay Xwindow scr-num)
|
|
"scx_Iconify_Window")
|
|
|
|
;; withdraw-window unmaps the specified window and sends a synthetic
|
|
;; UnmapNotify event to the root window of the specified screen. See
|
|
;; XWithdrawWindow.
|
|
|
|
(define (withdraw-window window screen-number)
|
|
(check-screen-number screen-number)
|
|
(if (not (%withdraw-window (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
screen-number))
|
|
(error "cannot withdraw window"
|
|
window)))
|
|
|
|
(import-lambda-definition %withdraw-window (Xdisplay Xwindow scr-num)
|
|
"scx_Withdraw_Window")
|
|
|
|
;; reconfigure-wm-window change attributes of the specified window
|
|
;; similar to configure-window, or sends a ConfigureRequestEvent to
|
|
;; the root window if that fails. See XReconfigureWMWindow. See
|
|
;; configure-window.
|
|
|
|
(define (reconfigure-wm-window window screen-number window-change-alist)
|
|
(check-screen-number screen-number)
|
|
(if (not (%reconfigure-wm-window (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
screen-number
|
|
(window-change-alist->integer+vector
|
|
window-change-alist)))
|
|
(error "cannot reconfigure window"
|
|
window)))
|
|
|
|
(import-lambda-definition %reconfigure-wm-window
|
|
(Xdisplay Xwindow scrnum changes)
|
|
"scx_Reconfigure_Wm_Window")
|
|
|
|
;; get-wm-command reads the WM_COMMAND property from the specified
|
|
;; window and returns is as a list of strings. See XGetCommand.
|
|
|
|
(define (get-wm-command window)
|
|
(vector->list (%wm-command (display-Xdisplay (window-display window))
|
|
(window-Xwindow window))))
|
|
|
|
(import-lambda-definition %wm-command (Xdisplay Xwindow)
|
|
"scx_Wm_Command")
|
|
|
|
;; set-wm-command! sets the WM_COMMAND property (the command and
|
|
;; arguments used to invoke the application). The command has to be
|
|
;; specified as a list of string or symbols. See XSetCommand.
|
|
|
|
(define (set-wm-command! window command)
|
|
(%set-wm-command! (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(list->vector (map (lambda (x)
|
|
(if (symbol? x)
|
|
(symbol->string x)
|
|
x))
|
|
command))))
|
|
|
|
(import-lambda-definition %set-wm-command! (Xdisplay Xwindow command)
|
|
"scx_Set_Wm_Command")
|
|
|
|
;; get-text-property returns the property specified by atom of the
|
|
;; specified window as a list of strings. See XGetTextProperty.
|
|
|
|
(define (get-text-property window atom)
|
|
(let ((res (%get-text-property (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(atom-Xatom atom))))
|
|
(cond
|
|
((eq? res #t) #f)
|
|
((eq? res #f) (error "cannot create string list from text property"))
|
|
(else (vector->list res)))))
|
|
|
|
(import-lambda-definition %get-text-property (Xdisplay Xwindow Xatom)
|
|
"scx_Get_Text_Property")
|
|
|
|
;; set-text-property! sets the property specified by atom of the
|
|
;; specified window to value - a list of strings or symbols.
|
|
|
|
(define (s->s s)
|
|
(if (symbol? s)
|
|
(symbol->string s)
|
|
s))
|
|
|
|
(define (set-text-property! window value atom)
|
|
(let ((res (%set-text-property! (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(list->vector (map s->s value))
|
|
(atom-Xatom atom))))
|
|
(if res
|
|
res
|
|
(error "cannot create text property from string list" value))))
|
|
|
|
(import-lambda-definition %set-text-property! (Xdisplay Xwindow value XAtom)
|
|
"scx_Set_Text_Property")
|
|
|
|
;; get-wm-protocols function returns the list of atoms stored in the
|
|
;; WM_PROTOCOLS property on the specified window, or #f if this
|
|
;; property does not exist or has a bas format. These atoms describe
|
|
;; window manager protocols in which the owner of this window is
|
|
;; willing to participate. See XGetWMProtocols.
|
|
|
|
(define (get-wm-protocols window)
|
|
(let ((res (%wm-protocols (display-Xdisplay (window-display window))
|
|
(window-Xwindow window))))
|
|
(if res
|
|
(map make-atom
|
|
(vector->list res))
|
|
#f)))
|
|
|
|
(import-lambda-definition %wm-protocols (Xdisplay Xwindow)
|
|
"scx_Wm_Protocols")
|
|
|
|
;; set-wm-protocols! sets the WM_PROTOCOLS property of the specified
|
|
;; window. protocols has to be a list of atoms. See XSetWMProtocols.
|
|
|
|
(define (set-wm-protocols! window protocols)
|
|
(let ((res (%set-wm-protocols! (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(list->vector (map atom-Xatom protocols)))))
|
|
(if res
|
|
res
|
|
(error "cannot set WM protocols" window protocols))))
|
|
|
|
(import-lambda-definition %set-wm-protocols! (Xdisplay Xwindow protocols)
|
|
"scx_Set_Wm_Protocols")
|
|
|
|
;; get-wm-class returns the class hint for the specified window or #f
|
|
;; if it does not exists or has a bad format. See XGetClassHint.
|
|
|
|
(define (get-wm-class window)
|
|
(%wm-class (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)))
|
|
|
|
(import-lambda-definition %wm-class (Xdisplay Xwindow)
|
|
"scx_Wm_Class")
|
|
|
|
;; set-wm-class! sets the class hint for the specified window. See
|
|
;; XSetClassHint.
|
|
|
|
(define (set-wm-class! window name class)
|
|
(%set-wm-class! (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(if (symbol? name)
|
|
(symbol->string name)
|
|
name)
|
|
(if (symbol? class)
|
|
(symbol->string class)
|
|
class)))
|
|
|
|
(import-lambda-definition %set-wm-class! (Xdisplay Xwindow name class)
|
|
"scx_Set_Wm_Class")
|
|
|
|
;; enumerated type for the XWMHints type. used by set-wm-hints! and
|
|
;; get-wm-hints.
|
|
|
|
(define-enumerated-type initial-state :initial-state
|
|
initial-state? initial-states initial-state-name initial-state-index
|
|
(withdrawn normal initial-state-2 iconic initial-state-4))
|
|
|
|
(define (initial-state->integer v)
|
|
(initial-state-index v))
|
|
|
|
(define (integer->initial-state i)
|
|
(vector-ref initial-states i))
|
|
|
|
(define-enumerated-type wm-hint :wm-hint
|
|
wm-hint?
|
|
wm-hints
|
|
wm-hint-name
|
|
wm-hint-index
|
|
(input? initial-state icon-pixmap icon-window icon-position icon-mask
|
|
window-group urgency))
|
|
|
|
(define-syntax make-wm-hint-alist
|
|
(syntax-rules
|
|
()
|
|
((make-wm-hint-alist (attr arg) rest ...)
|
|
(cons (cons (wm-hint attr) arg)
|
|
(make-wm-hint-alist rest ...)))
|
|
((make-wm-hint-alist)
|
|
'())))
|
|
|
|
(define wm-hint-alist->integer+vector
|
|
(make-enum-alist->integer+vector
|
|
wm-hints wm-hint-index
|
|
(lambda (v)
|
|
(cond
|
|
((or (eq? v (wm-hint input?))
|
|
(eq? v (wm-hint urgency)))
|
|
(lambda (x) x))
|
|
((eq? v (wm-hint initial-state))
|
|
initial-state->integer)
|
|
((or (eq? v (wm-hint icon-pixmap))
|
|
(eq? v (wm-hint icon-mask)))
|
|
pixmap-Xpixmap)
|
|
((or (eq? v (wm-hint icon-window))
|
|
(eq? v (wm-hint window-group)))
|
|
window-Xwindow)
|
|
((eq? v (wm-hint icon-position))
|
|
(lambda (x) x))))))
|
|
|
|
(define (integer+vector->wm-hint-alist display)
|
|
(make-integer+vector->enum-alist
|
|
wm-hints wm-hint-index
|
|
(lambda (v)
|
|
(cond
|
|
((or (eq? v (wm-hint input?))
|
|
(eq? v (wm-hint urgency)))
|
|
(lambda (x) x))
|
|
((eq? v (wm-hint initial-state))
|
|
integer->initial-state)
|
|
((or (eq? v (wm-hint icon-pixmap))
|
|
(eq? v (wm-hint icon-mask)))
|
|
(lambda (Xpixmap)
|
|
(make-pixmap Xpixmap display #f)))
|
|
((or (eq? v (wm-hint icon-window))
|
|
(eq? v (wm-hint window-group)))
|
|
(lambda (Xwindow)
|
|
(make-window Xwindow display #f)))
|
|
((eq? v (wm-hint icon-position))
|
|
(lambda (x) x))))))
|
|
|
|
;; get-wm-hints reads the window manager hints and returns them as an
|
|
;; alist mapping wm-hint types to specific values. If a hints is not
|
|
;; defined, it is not included in the alist. See wm-hint. See
|
|
;; XGetWMHints for a description.
|
|
|
|
(define (get-wm-hints window)
|
|
(let ((res (%wm-hints (display-Xdisplay (window-display window))
|
|
(window-Xwindow window))))
|
|
(if res
|
|
((integer+vector->wm-hint-alist (window-display window)) res)
|
|
#f)))
|
|
|
|
(import-lambda-definition %wm-hints (Xdisplay Xwindow)
|
|
"scx_Wm_Hints")
|
|
|
|
;; set-wm-hints! sets the specified window manager hints. The hints
|
|
;; must be specified as an alist of wm-hint values (see above) mapping
|
|
;; to the appropiate values. See XSetWMHints.
|
|
|
|
(define (set-wm-hints! window wm-hint-alist)
|
|
(%set-wm-hints! (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(wm-hint-alist->integer+vector wm-hint-alist)))
|
|
|
|
(import-lambda-definition %set-wm-hints! (Xdisplay Xwindow args)
|
|
"scx_Set_Wm_Hints")
|
|
|
|
;; get-transient-for returns the WM_TRANSIENT_FOR property for the
|
|
;; specified window. The value of that property is a window. See
|
|
;; XGetTransientForHint.
|
|
|
|
(define (get-transient-for window)
|
|
(let ((Xwindow (%transient-for (display-Xdisplay (window-display window))
|
|
(window-Xwindow window))))
|
|
(if (= 0 Xwindow)
|
|
#f
|
|
(make-window Xwindow
|
|
(window-display window)
|
|
#f))))
|
|
|
|
(import-lambda-definition %transient-for (Xdisplay Xwindow)
|
|
"scx_Transient_For")
|
|
|
|
;; set-transient-for! sets the WM_TRANSIENT_FOR property of the
|
|
;; specified window to the specified property-window. See
|
|
;; XSetTransientForHint.
|
|
|
|
(define (set-transient-for! window property-window)
|
|
(%set-transient-for! (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(window-Xwindow property-window)))
|
|
|
|
(import-lambda-definition %set-transient-for! (Xdisplay Xwindow
|
|
Xpropertywindow)
|
|
"scx_Set_Transient_For")
|
|
|
|
;; The following function a wrappers for the get/set-text-property
|
|
;; function.
|
|
|
|
(define xa-wm-name (make-atom 39))
|
|
(define xa-wm-icon-name (make-atom 37))
|
|
(define xa-wm-client-machine (make-atom 36))
|
|
|
|
(define (get-wm-name w)
|
|
(get-text-property w xa-wm-name))
|
|
|
|
(define (get-wm-icon-name w)
|
|
(get-text-property w xa-wm-icon-name))
|
|
|
|
(define (get-wm-client-machine w)
|
|
(get-text-property w xa-wm-client-machine))
|
|
|
|
(define (set-wm-name! w s)
|
|
(set-text-property! w s xa-wm-name))
|
|
|
|
(define (set-wm-icon-name! w s)
|
|
(set-text-property! w s xa-wm-icon-name))
|
|
|
|
(define (set-wm-client-machine! w s)
|
|
(set-text-property! w s xa-wm-client-machine))
|
|
|
|
;; an enumerated type for XSizeHints used by get-wm-normal-hints and
|
|
;; set-wm-normal-hints!
|
|
|
|
(define-enumerated-type size-hint :size-hint
|
|
size-hint?
|
|
size-hints
|
|
size-hint-name
|
|
size-hint-index
|
|
;; aspect should have the form ((min-x . min-y) . (max-x . max-y))
|
|
;; for win-gravity see gravity in create-window.
|
|
;; the other hints must be pairs of integers - (x . y) or (width . height)
|
|
;; us-position, us-size .....!!??
|
|
(us-position us-size position size min-size max-size resize-inc aspect
|
|
base-size win-gravity))
|
|
|
|
(define-syntax make-size-hint-alist
|
|
(syntax-rules
|
|
()
|
|
((make-size-hint-alist (attr arg) rest ...)
|
|
(cons (cons (size-hint attr) arg)
|
|
(make-size-hint-alist rest ...)))
|
|
((make-size-hint-alist)
|
|
'())))
|
|
|
|
(define size-hint-alist->integer+vector
|
|
(make-enum-alist->integer+vector
|
|
size-hints size-hint-index
|
|
(lambda (v)
|
|
(cond
|
|
((eq? v (size-hint win-gravity))
|
|
gravity->integer)
|
|
(else (lambda (x) x))))))
|
|
|
|
(define integer+vector->size-hint-alist
|
|
(make-integer+vector->enum-alist
|
|
size-hints size-hint-index
|
|
(lambda (v)
|
|
(cond
|
|
((eq? v (size-hint win-gravity))
|
|
integer->gravity)
|
|
(else (lambda (x) x))))))
|
|
|
|
;; get-wm-normal-hints/set-wm-normal-hints! get or set the size hints
|
|
;; stored in the WM_NORMAL_HINTS property on the specified window. The
|
|
;; hints are '(x y width height us-position us-size min-width
|
|
;; min-height max-width max-height width-inc height-inc min-aspect-x
|
|
;; min-aspect-y max-aspect-x max-aspect-y base-width base-height
|
|
;; gravity). See XGetWMNormalHints, XSetWMNormalHints.
|
|
|
|
(define (get-wm-normal-hints window)
|
|
(let* ((v (%wm-normal-hints (display-Xdisplay (window-display window))
|
|
(window-Xwindow window))))
|
|
(integer+vector->size-hint-alist v)))
|
|
|
|
(import-lambda-definition %wm-normal-hints (Xdisplay Xwindow)
|
|
"scx_Wm_Normal_Hints")
|
|
|
|
(define (set-wm-normal-hints! window size-hint-alist)
|
|
(%set-wm-normal-hints! (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(size-hint-alist->integer+vector size-hint-alist)))
|
|
|
|
(import-lambda-definition %set-wm-normal-hints! (Xdisplay Xwindow alist)
|
|
"scx_Set_Wm_Normal_Hints")
|
|
|
|
;; get-icon-sizes returns the icon sizes specified by a window manager as
|
|
;; a list. If no icon sizes are specified the list is empty. An icon
|
|
;; size itself is a list consisting of integers meaning '(min-width
|
|
;; min-height max-width max-height width-inc height-inc). See
|
|
;; XGetIconSizes.
|
|
|
|
(define (get-icon-sizes window)
|
|
(let ((r (%icon-sizes (display-Xdisplay (window-display window))
|
|
(window-Xwindow window))))
|
|
(map vector->list
|
|
(vector->list r))))
|
|
|
|
(import-lambda-definition %icon-sizes (Xdisplay Xwindow)
|
|
"scx_Icon_Sizes")
|
|
|
|
;; set-icon-sizes! is used only by window managers to set the
|
|
;; supported icon sizes. See icon-sizes, XSetIconSizes.
|
|
|
|
(define (set-icon-sizes! window icon-sizes)
|
|
(%set-icon-sizes! (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(list->vector (map list->vector icon-sizes))))
|
|
|
|
(import-lambda-definition %set-icon-sizes! (Xdisplay Xwindow sizes)
|
|
"scx_Set_Icon_Sizes")
|