Commit 8cbc2b22 authored by Iban Hatchondo's avatar Iban Hatchondo
Browse files

Fix incorect handling of the states _net_wm_state_{above, below}.

They are permanent as the other states (see inpout.lisp).

It implies that the (setf window-priority) should take those state in account when modifying the stack order (see misc.lisp)

This have as last implication, that we should work with an external list of window for the window circulation keystrokes. Indeed, if one window has the _net_wm_state_above state then it will always be on top of the others. What means, that will stay stuck on this window during circulation. (see minor signature modification of circulate-window in virtual-screen.lisp, and small hack in gestures.lisp)
parent cf2d7ffd
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: gestures.lisp,v 1.8 2003/09/30 12:18:36 hatchond Exp $
;;; $Id: gestures.lisp,v 1.9 2003/10/06 17:57:26 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -329,6 +329,7 @@
(defvar *depth* nil)
(defvar *current-widget-info* nil)
(defvar *windows* nil)
(defun initialize-circulate-window (root-window dpy)
"Initialize gestures internal hooks before circulating windows."
......@@ -341,7 +342,9 @@
(xlib:grab-keyboard root-window)
(unless *current-widget-info*
(setf *current-widget-info* (create-message-box nil :parent root-window)))
(setf *depth* 0))
(let ((i (current-vscreen root-window)))
(setf *windows* (reverse (get-screen-content i :iconify-p *cycle-icons-p*))
*depth* 0)))
(defun circulate-window-modifier-callback (event)
(when (typep event 'key-release)
......@@ -351,30 +354,43 @@
for code = (unless (eq mod :and) (kb:keyname->keycodes *display* mod))
when code
do (remhash (cons (if (listp code) (car code) code) #x8000) map))
(let ((widget (lookup-widget (input-focus *display*))))
(let ((widget (lookup-widget (car *windows*))))
(when widget (setf (application-wants-iconic-p widget) nil)))
(xlib:unmap-window (widget-window *current-widget-info*))
(setf *depth* nil)))
(setf *depth* nil *windows* nil)))
(defun circulate-window-up-and-down (event dir)
"Make window circulating according to the `dir' argument (or :above :below)."
(defun circulate-window-up-and-down (event direction)
"Circulate windows according to the `direction' argument (or :above :below)."
(when (typep event 'key-press)
(with-slots ((root-win root)) event
(unless *depth*
(initialize-circulate-window root-win (xlib:drawable-display root-win)))
(if (eq dir :above) (incf *depth*) (decf *depth*))
(let ((widget (circulate-window
(lookup-widget root-win)
:direction dir
:nth *depth*
:icon-p *cycle-icons-p*)))
(when (and *verbose-window-cycling* widget)
(with-slots (window)
(if (decoration-p widget) (get-child widget :application) widget)
(setf (message-pixmap *current-widget-info*)
(clx-ext::wm-hints-icon-pixmap window))
(setf (button-item-to-draw *current-widget-info*) (wm-name window)))
(with-slots (window) *current-widget-info*
(xlib:map-window window)
(setf (xlib:window-priority window) :above)
(repaint *current-widget-info* nil nil)))))))
(unless *windows* (return-from circulate-window-up-and-down nil))
(circulate-window
(lookup-widget root-win)
:direction direction
:nth (if (eq direction :above) (incf *depth*) (decf *depth*))
:windows *windows*
:icon-p *cycle-icons-p*))
(let* ((length (length *windows*))
(depth-aux (mod *depth* length)))
(cond
((<= length 1) nil)
((and (eq direction :above) (= depth-aux 0))
(setf (cdr (last *windows*)) (list (pop *windows*))))
((and (eq direction :below) (= depth-aux (1- length)))
(let ((penultimate-cons (last *windows* 2)))
(push (cadr penultimate-cons) *windows*)
(setf (cdr penultimate-cons) nil)))
(t
(when (eq direction :below) (incf depth-aux))
(rotatef (nth 0 *windows*) (nth depth-aux *windows*)))))
(when (and *verbose-window-cycling* (car *windows*))
(with-slots (window) (lookup-widget (car *windows*))
(setf (message-pixmap *current-widget-info*)
(clx-ext::wm-hints-icon-pixmap window))
(setf (button-item-to-draw *current-widget-info*) (wm-name window)))
(with-slots (window) *current-widget-info*
(xlib:map-window window)
(setf (xlib:window-priority window) :above)
(repaint *current-widget-info* nil nil)))))
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.19 2003/10/09 11:38:18 ihatchondo Exp $
;;; $Id: input.lisp,v 1.20 2003/10/12 21:59:17 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -361,10 +361,15 @@
(maximize-window application 3))
(when (and master (or-eql :_net_wm_state_shaded p1 p2))
(shade master))
(when (or-eql :_net_wm_state_above p1 p2)
(put-on-top application))
(when (or-eql :_net_wm_state_below p1 p2)
(put-on-bottom application)))))
(flet ((set-stack-state (s)
(setf (netwm:net-wm-state window)
(if (= 0 mode) (remove s p) (pushnew s p)))))
(when (or-eql :_net_wm_state_above p1 p2)
(set-stack-state :_net_wm_state_above)
(put-on-top application))
(when (or-eql :_net_wm_state_below p1 p2)
(set-stack-state :_net_wm_state_below)
(put-on-bottom application))))))
(:_NET_WM_DESKTOP
(let* ((cur-desk (window-desktop-num window))
(new-desk (aref data 0))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: misc.lisp,v 1.11 2003/09/16 14:47:12 hatchond Exp $
;;; $Id: misc.lisp,v 1.12 2003/10/06 17:57:26 ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -32,6 +32,10 @@
;;;; Helpers macros.
(defmacro with-gensym (symbols &body body)
`(let ,(loop for s in symbols collect `(,s (gensym)))
,@body))
(defmacro screen-width ()
`(xlib:screen-width (xlib:display-default-screen *display*)))
......@@ -142,13 +146,62 @@
:format 32
:data (cons (atom-name->id atom) data)))
(defun screen-windows-layers (window &aux (i (window-desktop-num window)))
"Returns, as multiple value, three window lists that corresponds to the
three layers (:_net_wm_state_below none :_net_wm_state_above) of the
virtual screen that the given `window' argument belongs to. The given
window will be filtered."
(loop with n = (if (eql i +any-desktop+) (current-desk) i)
for w in (get-screen-content n)
for nwm-state = (netwm:net-wm-state w)
unless (xlib:window-equal w window)
if (member :_net_wm_state_above nwm-state) collect w into aboves
else if (member :_net_wm_state_below nwm-state) collect w into belows
else collect w into no-stack-state
finally (return (values belows no-stack-state aboves))))
(defsetf window-priority (window &optional sibling) (priority)
"Set the window priority such as (setf xlib:window-priority) but
also invoke update-client-list-stacking to reflect the priority
change in all the root properties that are involved in."
`(progn
(setf (xlib:window-priority ,window ,sibling) ,priority)
(update-client-list-stacking *root*)))
"Set the window priority such as if done by (setf xlib:window-priority) and
guaranty that stacking order constraints described in the extended window
manager protocol will be respected. Then invokes update-client-list-stacking
to reflect the new order in all the root properties that are involved in."
(with-gensym (above-p wnwm-state snwm-state win sib b m a %priority)
`(flet ((lookup-app-w (widget)
(when (decoration-p widget)
(get-child widget :application :window t)))
(first (windows &optional above-p)
(car (if above-p (last windows) windows))))
(let* ((,%priority ,priority)
(,win (or (lookup-app-w (lookup-widget ,window)) ,window))
(,sib (or (lookup-app-w (lookup-widget ,sibling)) ,sibling))
(,above-p (eq ,priority :above))
(,wnwm-state (netwm:net-wm-state ,win))
(,snwm-state (and ,sib (netwm:net-wm-state ,sib))))
(if (not (application-p (lookup-widget ,win)))
(setf (xlib:window-priority ,window ,sibling) ,priority)
(multiple-value-bind (,b ,m ,a) (screen-windows-layers ,win)
(cond ((member :_net_wm_state_below ,wnwm-state)
(unless (member ,sib ,b)
(setf ,sib (first (or ,b ,m ,a) (and ,b ,above-p)))
(unless ,b (setf ,%priority :below))))
((member :_net_wm_state_above ,wnwm-state)
(unless (member ,sib ,a)
(unless (member :_net_wm_state_fullscreen ,snwm-state)
(setf ,sib (first ,a ,above-p))
(unless ,a (setf ,%priority :above)))))
((member :_net_wm_state_fullscreen ,wnwm-state)
(when (member ,sib ,b)
(setf ,sib (first (or ,m ,a)))
(setf ,%priority :below)))
((not (member ,sib ,m))
(setf ,sib (first (or ,m ,b ,a) (if ,m ,above-p ,b)))
(unless ,m (setf ,%priority (if ,b :above :below)))))
(when (and ,sib (application-master (lookup-widget ,sib)))
(with-slots (master) (lookup-widget ,sib)
(setf ,sib (widget-window master))))
(when (or ,b ,m ,a)
(setf (xlib:window-priority ,window ,sib) ,%priority)
(update-client-list-stacking *root*))))))))
(defun grab-root-pointer (&key cursor owner-p confine-to)
(xlib:grab-pointer
......@@ -217,8 +270,7 @@
(car (member name (application-list) :test #'equal :key #'application-name)))
(defun application-class (app)
(multiple-value-bind (name type)
(xlib:get-wm-class (widget-window app))
(multiple-value-bind (name type) (xlib:get-wm-class (widget-window app))
(cons name type)))
(defun application-class-name (app)
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: virtual-screen.lisp,v 1.9 2003/10/06 17:57:26 ihatchondo Exp $
;;; $Id: virtual-screen.lisp,v 1.10 2003/10/09 11:39:41 ihatchondo Exp $
;;;
;;;Copyright (C) 2002 Iban HATCHONDO
;;; contact : hatchond@yahoo.fr
......@@ -129,14 +129,16 @@
(unless given-p
(xlib:set-input-focus *display* :pointer-root :pointer-root))))
(defmethod circulate-window ((root root) &key direction (nth 0) icon-p)
(let* ((wins (reverse (get-screen-content (current-desk) :iconify-p icon-p)))
(length (length wins)))
(or wins (return-from circulate-window nil))
(defmethod circulate-window
((root root) &key direction (nth 0) icon-p windows (desk (current-desk)))
(unless windows
(setf windows (reverse (get-screen-content desk :iconify-p icon-p))))
(or windows (return-from circulate-window nil))
(let ((length (length windows)))
(setf nth (mod nth length))
(let ((above-p (eq direction :above))
(focus-dest (nth nth wins))
(first (lookup-widget (car wins))))
(focus-dest (nth nth windows))
(first (lookup-widget (car windows))))
;; Grab the pointer to avoid enter notify events race concurrence
;; between the window hierarchy change and the warp-pointer call.
(with-pointer-grabbed ((widget-window root) nil)
......@@ -151,15 +153,15 @@
(setf (window-priority window sibling) priority)))
(cond ((= length 1) (set-window-priority focus-dest nil :above))
((= nth 0)
(let ((sibling (if above-p (last wins) (cdr wins))))
(set-window-priority (car wins) (car sibling) :below)
(setf focus-dest (second wins))))
(let ((sibling (if above-p (last windows) (cdr windows))))
(set-window-priority (car windows) (car sibling) :below)
(setf focus-dest (second windows))))
((or (and (= nth (1- length)) (not above-p))
(and (= nth 1) above-p))
(set-window-priority focus-dest nil :above))
(t (unless above-p
(setf focus-dest (nth (incf nth) wins)))
(set-window-priority (car wins) focus-dest :below)
(setf focus-dest (nth (incf nth) windows)))
(set-window-priority (car windows) focus-dest :below)
(set-window-priority focus-dest nil :above))))
(with-slots (master) (setf focus-dest (lookup-widget focus-dest))
(when (and icon-p (application-iconic-p focus-dest))
......@@ -168,6 +170,6 @@
(when master (setf focus-dest master)))
(when *warp-pointer-when-cycle*
(xlib:warp-pointer (widget-window focus-dest) 8 5)))
(when (and (eq *focus-type* :on-click) *focus-when-window-cycle*)
(when *focus-when-window-cycle*
(focus-widget focus-dest 0))
focus-dest)))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment