parent
1fdd6a1366
commit
dfd5b4d06b
|
@ -56,6 +56,11 @@
|
||||||
(release-lock lock)
|
(release-lock lock)
|
||||||
r))
|
r))
|
||||||
|
|
||||||
|
(define (send-message+wait channel message)
|
||||||
|
(let ((sp (make-sync-point)))
|
||||||
|
(send channel (list 'wait sp message))
|
||||||
|
(sync-point-wait sp)))
|
||||||
|
|
||||||
;; *** option utilities **********************************************
|
;; *** option utilities **********************************************
|
||||||
|
|
||||||
(define-record-type options :options
|
(define-record-type options :options
|
||||||
|
@ -78,13 +83,6 @@
|
||||||
(type-alist (map (lambda (s)
|
(type-alist (map (lambda (s)
|
||||||
(cons (first s) (second s)))
|
(cons (first s) (second s)))
|
||||||
spec))
|
spec))
|
||||||
; (default-alist (map (lambda (s)
|
|
||||||
; (let ((op (assq (first s) options)))
|
|
||||||
; (if op op
|
|
||||||
; (cons (first s) (third s)))))
|
|
||||||
; spec)))
|
|
||||||
;; TODO: options from config and the spec should form the
|
|
||||||
;; defaults (but not those from layout).
|
|
||||||
(default-alist (map (lambda (s)
|
(default-alist (map (lambda (s)
|
||||||
(cons (first s) (third s)))
|
(cons (first s) (third s)))
|
||||||
spec)))
|
spec)))
|
||||||
|
@ -95,6 +93,15 @@
|
||||||
(make-options dpy colormap option-alist value-alist type-alist
|
(make-options dpy colormap option-alist value-alist type-alist
|
||||||
default-alist)))
|
default-alist)))
|
||||||
|
|
||||||
|
(define (spec-defaults defaults spec)
|
||||||
|
(map (lambda (s)
|
||||||
|
(let ((name (first s))
|
||||||
|
(type (second s))
|
||||||
|
(def1 (third s)))
|
||||||
|
(let ((def2 (assq name defaults)))
|
||||||
|
(list name type (if def2 (cdr def2) def1)))))
|
||||||
|
spec))
|
||||||
|
|
||||||
;; if the colormap gets freed, then the colors don't have to
|
;; if the colormap gets freed, then the colors don't have to
|
||||||
(define (free-options options free-colors?)
|
(define (free-options options free-colors?)
|
||||||
(for-each (lambda (n.v)
|
(for-each (lambda (n.v)
|
||||||
|
@ -278,6 +285,10 @@
|
||||||
(eq? (window-attribute:map-state (get-window-attributes dpy window))
|
(eq? (window-attribute:map-state (get-window-attributes dpy window))
|
||||||
(map-state is-viewable)))
|
(map-state is-viewable)))
|
||||||
|
|
||||||
|
(define (window-mapped? dpy window)
|
||||||
|
(not (eq? (window-attribute:map-state (get-window-attributes dpy window))
|
||||||
|
(map-state is-unmapped))))
|
||||||
|
|
||||||
(define (window-focused? dpy window)
|
(define (window-focused? dpy window)
|
||||||
(eq? (get-input-focus-window dpy) window))
|
(eq? (get-input-focus-window dpy) window))
|
||||||
|
|
||||||
|
@ -294,7 +305,7 @@
|
||||||
(wm-hints (get-wm-hints dpy window))
|
(wm-hints (get-wm-hints dpy window))
|
||||||
(t (and wm-hints (assq (wm-hint input?) wm-hints)))
|
(t (and wm-hints (assq (wm-hint input?) wm-hints)))
|
||||||
(input? (if t (cdr t) #f)))
|
(input? (if t (cdr t) #f)))
|
||||||
(if input?
|
(if (and input? (window-mapped? dpy window))
|
||||||
(set-input-focus dpy window (revert-to parent) time))
|
(set-input-focus dpy window (revert-to parent) time))
|
||||||
(if (and protocols wm-take-focus
|
(if (and protocols wm-take-focus
|
||||||
(memq wm-take-focus protocols))
|
(memq wm-take-focus protocols))
|
||||||
|
@ -491,6 +502,15 @@
|
||||||
;; result ********************************************************
|
;; result ********************************************************
|
||||||
(cons width height)))
|
(cons width height)))
|
||||||
|
|
||||||
|
(define (minimal-size/hints dpy window default-width default-height)
|
||||||
|
(let ((hints (get-wm-normal-hints dpy window)) ;; or group-leader?
|
||||||
|
(default-size (cons default-width default-height)))
|
||||||
|
(if hints
|
||||||
|
(or (assq/false (size-hint min-size) hints)
|
||||||
|
(assq/false (size-hint base-size) hints) ;; according to ICCCM
|
||||||
|
default-size)
|
||||||
|
default-size)))
|
||||||
|
|
||||||
(define (point-in-rectangle? r x y)
|
(define (point-in-rectangle? r x y)
|
||||||
(and (>= x (rectangle:x r))
|
(and (>= x (rectangle:x r))
|
||||||
(>= y (rectangle:y r))
|
(>= y (rectangle:y r))
|
||||||
|
|
Loading…
Reference in New Issue