parent
1fdd6a1366
commit
dfd5b4d06b
|
@ -56,6 +56,11 @@
|
|||
(release-lock lock)
|
||||
r))
|
||||
|
||||
(define (send-message+wait channel message)
|
||||
(let ((sp (make-sync-point)))
|
||||
(send channel (list 'wait sp message))
|
||||
(sync-point-wait sp)))
|
||||
|
||||
;; *** option utilities **********************************************
|
||||
|
||||
(define-record-type options :options
|
||||
|
@ -78,13 +83,6 @@
|
|||
(type-alist (map (lambda (s)
|
||||
(cons (first s) (second s)))
|
||||
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)
|
||||
(cons (first s) (third s)))
|
||||
spec)))
|
||||
|
@ -95,6 +93,15 @@
|
|||
(make-options dpy colormap option-alist value-alist type-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
|
||||
(define (free-options options free-colors?)
|
||||
(for-each (lambda (n.v)
|
||||
|
@ -278,6 +285,10 @@
|
|||
(eq? (window-attribute:map-state (get-window-attributes dpy window))
|
||||
(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)
|
||||
(eq? (get-input-focus-window dpy) window))
|
||||
|
||||
|
@ -294,7 +305,7 @@
|
|||
(wm-hints (get-wm-hints dpy window))
|
||||
(t (and wm-hints (assq (wm-hint input?) wm-hints)))
|
||||
(input? (if t (cdr t) #f)))
|
||||
(if input?
|
||||
(if (and input? (window-mapped? dpy window))
|
||||
(set-input-focus dpy window (revert-to parent) time))
|
||||
(if (and protocols wm-take-focus
|
||||
(memq wm-take-focus protocols))
|
||||
|
@ -491,6 +502,15 @@
|
|||
;; result ********************************************************
|
||||
(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)
|
||||
(and (>= x (rectangle:x r))
|
||||
(>= y (rectangle:y r))
|
||||
|
|
Loading…
Reference in New Issue