64 lines
2.0 KiB
Scheme
64 lines
2.0 KiB
Scheme
;; the _MOTIF_WM_HINTS property
|
|
|
|
(define-record-type motif-wm-hints :motif-wm-hints
|
|
(make-motif-wm-hints functions decorations input-mode status)
|
|
motif-wm-hints?
|
|
(functions motif-wm-hints:functions)
|
|
(decorations motif-wm-hints:decorations)
|
|
(input-mode motif-wm-hints:input-mode)
|
|
(status motif-wm-hints:status))
|
|
|
|
(define _MOTIF_WM_HINTS #f)
|
|
|
|
(define-enumerated-type motif-decoration :motif-decoration
|
|
motif-decoration? motif-decoration-items motif-decoration-name
|
|
motif-decoration-index
|
|
(all border resize-horizontal title menu minimize maximize))
|
|
|
|
(define motif-decoration-codes
|
|
(list (cons 1 (motif-decoration all))
|
|
(cons 2 (motif-decoration border))
|
|
(cons 4 (motif-decoration resize-horizontal))
|
|
(cons 8 (motif-decoration title))
|
|
(cons 16 (motif-decoration menu))
|
|
(cons 32 (motif-decoration minimize))
|
|
(cons 64 (motif-decoration maximize))))
|
|
|
|
(define-enum-set-type motif-decorations :motif-decorations
|
|
motif-decorations? make-motif-decorations
|
|
motif-decoration motif-decoration? motif-decoration-items
|
|
motif-decoration-index)
|
|
|
|
(define (int->decorations i)
|
|
(make-motif-decorations
|
|
(map cdr (filter (lambda (code.v)
|
|
(> (bitwise-and (car code.v) i) 0))
|
|
motif-decoration-codes))))
|
|
|
|
(define flag:functions 1)
|
|
(define flag:decorations 2)
|
|
(define flag:input-mode 4)
|
|
(define flag:status 8)
|
|
|
|
(define (property->motif-wm-hints p)
|
|
(and (or (eq? (property:format p) (property-format short))
|
|
(eq? (property:format p) (property-format long)))
|
|
(>= (length (property:data p)) 5)
|
|
(let* ((data (property:data p))
|
|
(flags (first data)))
|
|
;; TODO: functions, input-mode, status
|
|
(make-motif-wm-hints
|
|
#f
|
|
(and (> (bitwise-and flags flag:decorations) 0)
|
|
(int->decorations (third data)))
|
|
#f
|
|
#f))))
|
|
|
|
(define (get-motif-wm-hints dpy window)
|
|
(if (not _MOTIF_WM_HINTS)
|
|
(set! _MOTIF_WM_HINTS (intern-atom dpy "_MOTIF_WM_HINTS" #f)))
|
|
(let ((p (get-full-window-property dpy window _MOTIF_WM_HINTS
|
|
#f _MOTIF_WM_HINTS)))
|
|
(and p
|
|
(property->motif-wm-hints p))))
|