fixed take-focus

added some functions
This commit is contained in:
frese 2003-04-27 19:17:16 +00:00
parent 1fdd6a1366
commit dfd5b4d06b
1 changed files with 28 additions and 8 deletions

View File

@ -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))