From b909da1e5fad05135c53081e3ee8a956682ab07f Mon Sep 17 00:00:00 2001 From: frese Date: Tue, 1 Apr 2003 13:17:22 +0000 Subject: [PATCH] - added root-drop - added thread names --- src/move-wm-resizer.scm | 6 ------ src/move-wm.scm | 23 ++++++++++++++------- src/titlebar.scm | 11 ++++++---- src/utils.scm | 45 ++++++++++++++++++++++++++++++++--------- 4 files changed, 59 insertions(+), 26 deletions(-) diff --git a/src/move-wm-resizer.scm b/src/move-wm-resizer.scm index 03234b6..120b91b 100644 --- a/src/move-wm-resizer.scm +++ b/src/move-wm-resizer.scm @@ -215,9 +215,3 @@ (if (null? matches) 'none (car (car matches))))))) - -(define (point-in-rectangle? r x y) - (and (>= x (rectangle:x r)) - (>= y (rectangle:y r)) - (< x (+ (rectangle:x r) (rectangle:width r))) - (< y (+ (rectangle:y r) (rectangle:height r))))) diff --git a/src/move-wm.scm b/src/move-wm.scm index f782ebf..950e0a5 100644 --- a/src/move-wm.scm +++ b/src/move-wm.scm @@ -1,6 +1,6 @@ (define-options-spec move-wm-options-spec (titlebar-colors colors '("#aaaaaa" "#eeeeee" "#777777" "black")) - (titlebar-colors-active colors '("#666699" "#aaaacc" "#333366" "#eeeeee")) + (titlebar-colors-focused colors '("#666699" "#aaaacc" "#333366" "#eeeeee")) (titlebar-height int 18) (titlebar-style symbol 'flat) (font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*") @@ -52,7 +52,7 @@ (dpy (wm:dpy wm)) (window (client:window client)) (state (if (window-contains-focus? dpy window) - 'active + 'focused 'normal)) (titlebar (car (client:data client))) (name (client-name (wm:dpy wm) client))) @@ -90,9 +90,18 @@ (lambda (msg) (case (car msg) ((drop) - ;; TODO: check if outside... - (move-window dpy (client:client-window client) - (second msg) (third msg))) + ;; check if outside... + (let ((window-x (second msg)) + (window-y (third msg)) + (root-x (fourth msg)) + (root-y (fifth msg))) + (let ((r (root-rectangle dpy (wm:window wm)))) + (if (point-in-rectangle? r root-x root-y) + (move-window dpy (client:client-window client) + window-x window-y) + (send (wm:out-channel wm) + (list 'root-drop (client:window client) + root-x root-y)))))) ((kill-client) (let ((time (second msg))) (delete-window dpy (client:window client) time))))))) @@ -112,9 +121,9 @@ (list (cons 'normal-colors (get-option options 'titlebar-colors)) (cons 'active-colors - (get-option options'titlebar-colors-active)) + (get-option options'titlebar-colors-focused)) (cons 'focused-colors - (get-option options 'titlebar-colors-active)) + (get-option options 'titlebar-colors-focused)) (cons 'border-style (get-option options 'titlebar-style)))))) diff --git a/src/titlebar.scm b/src/titlebar.scm index ca26af9..1c9119f 100644 --- a/src/titlebar.scm +++ b/src/titlebar.scm @@ -30,6 +30,7 @@ ) (mdisplay "creating titlebar " window "\n") (spawn* + (list "titlebar " window) (lambda (release) (call-with-event-channel dpy window (event-mask exposure structure-notify) @@ -43,7 +44,8 @@ (lambda (xevent) (cond ((expose-event? xevent) - (if (= 0 (expose-event-count xevent)) + (if (and (= 0 (expose-event-count xevent)) + (window-exists? dpy window)) (draw-titlebar tb options gc))) ((destroy-window-event? xevent) (exit))))) @@ -52,14 +54,15 @@ (case (car msg) ((title) (set-titlebar:title! tb (cdr msg)) - (invalidate-window dpy window)) + (draw-titlebar tb options gc)) ((state) (set-titlebar:state! tb (cdr msg)) - (invalidate-window dpy window))))) + (draw-titlebar tb options gc))))) ) (loop)))))) (free-gc dpy gc) - (free-options options))) + ;; colormap might to exists anymore... + (free-options options #t))) tb)) (define (destroy-titlebar tb) diff --git a/src/utils.scm b/src/utils.scm index 2917b96..6024678 100644 --- a/src/utils.scm +++ b/src/utils.scm @@ -29,11 +29,20 @@ (define (sync-point-wait sp) (placeholder-value sp)) -(define (spawn* fun) - (let ((sp (make-sync-point))) - (spawn (lambda () - (fun (lambda () (sync-point-release sp))))) - (sync-point-wait sp))) +(define (spawn* id . fun) + (let ((id (if (null? fun) "unnamed" id)) + (fun (if (null? fun) id (car fun)))) + (let ((sp (make-sync-point))) + (spawn (lambda () + (with-handler + (lambda (condition punt) + (mdisplay "condition in " id ":\n " condition "\n") + (punt)) + (lambda () + (fun (lambda () (sync-point-release sp))) + (mdisplay "thread " id " returned\n") + )))) + (sync-point-wait sp)))) (define (with-lock lock thunk) (obtain-lock lock) @@ -76,7 +85,7 @@ (type (assq/false name (options:type-alist options)))) (cond ((eq? (option-type font) type) - (unload-font (options:dpy options) value)) + (free-font (options:dpy options) value)) ((eq? (option-type color) type) (free-colors (options:dpy options) (options:colormap options) (list value) 0)) @@ -338,9 +347,6 @@ (define (maximize-window dpy window . maybe-parent) (let ((r (apply maximal-rect/hints dpy window maybe-parent))) - (mdisplay "maximize-window: " window " " - (rectangle:x r) " " (rectangle:y r) " " - (rectangle:width r) " " (rectangle:height r) "\n") (move-resize-window dpy window (rectangle:x r) (rectangle:y r) (rectangle:width r) (rectangle:height r)))) @@ -462,3 +468,24 @@ ;; result ******************************************************** (cons width height))) + +(define (point-in-rectangle? r x y) + (and (>= x (rectangle:x r)) + (>= y (rectangle:y r)) + (< x (+ (rectangle:x r) (rectangle:width r))) + (< y (+ (rectangle:y r) (rectangle:height r))))) + +(define (window-level dpy win) + (length (window-path dpy win))) + +(define (with-prevent-events dpy window event-mask thunk) + (let* ((before (window-attribute:your-event-mask + (get-window-attributes dpy window))) + (new (enum-set-intersection before + (enum-set-negation event-mask)))) + (dynamic-wind + (lambda () + (display-select-input dpy window new)) + thunk + (lambda () + (display-select-input dpy window before)))))