scsh-conservatory
/
orion-wm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

removed warning from get-wm-protocols 

fixed rectangles-overlap?
This commit is contained in:
frese 2003-05-07 13:24:02 +00:00
parent ac5860aed0
commit 8b65473e1a
1 changed files with 5 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/utils.scm
View File

@ -341,13 +341,9 @@
(define (delete-window dpy window time) (define (delete-window dpy window time)
(let* ((protocols (get-wm-protocols dpy window)) (let* ((protocols (get-wm-protocols dpy window))
(wm-delete-window (intern-atom dpy "WM_DELETE_WINDOW" #f))) (wm-delete-window (intern-atom dpy "WM_DELETE_WINDOW" #f)))
(if protocols (if (and protocols (member wm-delete-window protocols))
(if (member wm-delete-window protocols) (send-protocol-message dpy window wm-delete-window time)
(send-protocol-message dpy window wm-delete-window time) (destroy-window dpy window))))
(destroy-window dpy window))
(begin
(warn "get-wm-protocols #f" dpy window)
(destroy-window dpy window)))))
(define (move-resize-window* dpy window rect) (define (move-resize-window* dpy window rect)
(move-resize-window dpy window (move-resize-window dpy window
@ -543,8 +539,8 @@
(define (rectangles-overlap? r1 r2) (define (rectangles-overlap? r1 r2)
(let ((x1 (rectangle:x r2)) (let ((x1 (rectangle:x r2))
(y1 (rectangle:y r2)) (y1 (rectangle:y r2))
(x2 (+ (rectangle:x r2) (rectangle:width r2))) (x2 (+ -1 (rectangle:x r2) (rectangle:width r2)))
(y2 (+ (rectangle:y r2) (rectangle:height r2)))) (y2 (+ -1 (rectangle:y r2) (rectangle:height r2))))
(any (lambda (p) (any (lambda (p)
(point-in-rectangle? r1 (car p) (cdr p))) (point-in-rectangle? r1 (car p) (cdr p)))
(list (cons x1 y1) (cons x1 y2) (cons x2 y1) (cons x2 y2))))) (list (cons x1 y1) (cons x1 y2) (cons x2 y1) (cons x2 y2)))))