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

- made window-configuration code more ICCM compliant 

- changed initial-size code, so that full-screen windows work now.
This commit is contained in:
frese 2004-02-09 14:07:38 +00:00
parent 779b0a7f6a
commit 312db73689
1 changed files with 83 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
src/move-wm.scm
View File

@ -70,12 +70,80 @@
((configure-window)
(let ((window (second msg))
(changes (third msg)))
;; TODO: exact sizes ?!
(configure-window dpy window
(append (make-window-change-alist
(border-width 0))
changes))))
(changes (third msg))
(client? (client-of-window wm window)))
(if (window-exists? dpy window) (begin
(mdisplay "move-wm: root-configure: " client? window changes "\n")
(let* ((r (window-rectangle dpy window))
(dx (cond
((assq (window-change x) changes) =>
(lambda (c.x) (- (cdr c.x) (rectangle:x r))))
(else 0)))
(dy (cond
((assq (window-change x) changes) =>
(lambda (c.x) (- (cdr c.x) (rectangle:x r))))
(else 0)))
(dw (cond
((assq (window-change width) changes) =>
(lambda (c.w) (- (cdr c.w) (rectangle:width r))))
(else 0)))
(dh (cond
((assq (window-change height) changes) =>
(lambda (c.h) (- (cdr c.h) (rectangle:height r))))
(else 0)))
(send-synthetic-event
(lambda ()
(let ((r (root-rectangle dpy window)))
(send-event dpy window #f (event-mask structure-notify)
(create-configure-event
(event-type configure-notify) 0 #t dpy
window window
;; TODO: border-width/gravity ?
(rectangle:x r) (rectangle:y r)
(rectangle:width r) (rectangle:height r)
0 none #f))))))
(cond
((or (assq (window-change width) changes)
(assq (window-change height) changes)
(assq (window-change border-width) changes))
(if client?
(let* ((cw (client:client-window client?))
(cr (window-rectangle dpy cw)))
(configure-window
dpy cw
(append (make-window-change-alist
(border-width 0)
(x (+ (rectangle:x cr) dx))
(y (+ (rectangle:y cr) dy))
(width (+ (rectangle:width cr) dw))
(height (+ (rectangle:height cr) dh)))
changes)))
(configure-window dpy window
(append (make-window-change-alist
(border-width 0))
changes))))
((or (assq (window-change x) changes)
(assq (window-change y) changes)
(assq (window-change stack-mode) changes))
(if client?
(let* ((cw (client:client-window client?))
(cr (window-rectangle dpy cw)))
(mdisplay "configuring client-window: " cw
(append (make-window-change-alist
(border-width 0)
(x (+ (rectangle:x cr) dx))
(y (+ (rectangle:y cr) dy)))
changes) "\n")
(configure-window
dpy cw
(append (make-window-change-alist
(border-width 0)
(x (+ (rectangle:x cr) dx))
(y (+ (rectangle:y cr) dy)))
changes))))
(send-synthetic-event))
(else (send-synthetic-event))))))))
((iconify-client)
(let ((client (second msg)))
@ -170,7 +238,8 @@
(let ((bw (get-option-value options 'border-width))
(th (get-option-value options 'titlebar-height)))
(move-resize-window dpy (client:client-window client)
(rectangle:x r) (rectangle:y r)
(- (rectangle:x r) bw)
(- (rectangle:y r) (+ bw th))
(+ (rectangle:width r) (* 2 bw))
(+ (rectangle:height r) (* 2 bw) th)))
(fit-client-windows wm client)
@ -323,7 +392,13 @@
(default-height (if maybe-rect (rectangle:height maybe-rect) 200))
(w.h (initial-client-size wm client default-width default-height))
;; TODO: Transients centered?
(maybe-x.y (find-free-position wm client w.h (cons 0 0)))
(options (wm:options wm))
(maybe-x.y
(let* ((bw (get-option-value options 'border-width))
(th (get-option-value options 'titlebar-height))
(x.y (find-free-position wm client w.h '(0 . 0))))
(cons (+ (car x.y) bw)
(+ (cdr x.y) (+ bw th)))))
(x.y (desired-position/hints dpy win maybe-x.y)))
(make-rectangle (car x.y) (cdr x.y)
(car w.h) (cdr w.h))))