Update of /project/eclipse/cvsroot/eclipse In directory clnet:/tmp/cvs-serv20990
Modified Files: input.lisp misc.lisp widgets.lisp wm.lisp Log Message: Fix: - _net_wm_state_maximized were improperly handled when an application is newly decorated. - recomputation of the application geometry before maximization when the wm-size-hints property is changed. - handling of the _net_wm_state_maximized in configure-window (misc.lisp) - _net_wm__state property update before put an application in fullscreen to avoid race conditions. (widgets.lisp)
--- /project/eclipse/cvsroot/eclipse/input.lisp 2005/03/01 22:41:31 1.44 +++ /project/eclipse/cvsroot/eclipse/input.lisp 2007/05/04 08:26:14 1.45 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: input.lisp,v 1.44 2005/03/01 22:41:31 ihatchondo Exp $ +;;; $Id: input.lisp,v 1.45 2007/05/04 08:26:14 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -25,7 +25,7 @@ (deftype client-message-data () `(simple-array (or xlib:card8 xlib:card16 xlib:card32) (*)))
-;; Most generals methods. +;; Most general methods.
(defmethod event-process ((event mapping-notify) null-widget) (declare (ignorable null-widget)) @@ -211,10 +211,8 @@ (defmethod event-process :after ((event button-release) (root root)) (with-slots (move-status resize-status current-active-widget) root (when (or move-status resize-status) - (xlib:ungrab-server *display*) - (xlib:ungrab-pointer *display*) (setf (slot-value current-active-widget 'active-p) nil) - (setf (values current-active-widget move-status resize-status) nil)))) + (dismiss-move-resize root))))
;;; Events for master (type: decoration)
@@ -293,14 +291,28 @@ :_net_active_window))))
(defmethod event-process ((event property-notify) (app application)) - (with-slots (window master type transient-for) app + (with-slots (window master type transient-for initial-geometry) app (case (event-atom event) (:wm_normal_hints + ;; recompute decoration wm-size-hints and initial-geometry. (when master - (with-slots (hmargin vmargin) (decoration-frame-style master) - (with-slots (application-gravity wm-size-hints) master - (multiple-value-setq (wm-size-hints application-gravity) - (recompute-wm-normal-hints window hmargin vmargin)))))) + (with-slots (hmargin vmargin) (decoration-frame-style master) + (let ((old-wmsh (decoration-wm-size-hints master))) + (with-slots (application-gravity (wmsh wm-size-hints)) master + (multiple-value-setq (wmsh application-gravity) + (recompute-wm-normal-hints window hmargin vmargin)) + ;; wm-size-hints: '#(minw minh maxw maxh incw inch basew baseh). + (symbol-macrolet ((minw (aref wmsh 0)) (minh (aref wmsh 1)) + (maxw (aref wmsh 2)) (maxh (aref wmsh 3)) + (incw (aref wmsh 4)) (inch (aref wmsh 5)) + (basew (aref wmsh 6)) (baseh (aref wmsh 7))) + (multiple-value-bind (w h) (geometry-sizes initial-geometry) + (let ((rw (/ (- w (aref old-wmsh 6)) (aref old-wmsh 4))) + (rh (/ (- h (aref old-wmsh 7)) (aref old-wmsh 5)))) + (setf (geometry-w initial-geometry) + (max (min (+ (* rw incw) basew) maxw) minw)) + (setf (geometry-h initial-geometry) + (max (min (+ (* rh inch) baseh) maxh) minh)))))))))) ((:wm_name :_net_wm_name) (when (and master (get-child master :title-bar)) (with-slots (window item-to-draw) (get-child master :title-bar) @@ -390,12 +402,12 @@ (iconic-p (uniconify icon))) (with-slots ((pwindow window)) (root-property-holder *root*) (let* ((length (length data)) - (source (if (> length 0) (aref data 0) 0)) (time (if (> length 1) (aref data 1) 0)) (wtime (or (netwm:net-wm-user-time pwindow) 0))) - (unless (or (= source 1) (> wtime time 0)) + (unless (> wtime time 0) (setf (netwm:net-wm-user-time pwindow) time) - (focus-widget application time))))) + (focus-widget application time) + (put-on-top application))))) (:_net_wm_desktop (migrate-application application (aref data 0))) (:_net_close_window (close-widget application))))))
--- /project/eclipse/cvsroot/eclipse/misc.lisp 2006/01/21 19:15:57 1.35 +++ /project/eclipse/cvsroot/eclipse/misc.lisp 2007/05/04 08:26:14 1.36 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: misc.lisp,v 1.35 2006/01/21 19:15:57 ihatchondo Exp $ +;;; $Id: misc.lisp,v 1.36 2007/05/04 08:26:14 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -331,6 +331,16 @@ ;; update sizes. (when (or width height) (with-event-mask ((or parent win)) + (when application + ;; ensure width or height are compatible with wm-size-hints. + (multiple-value-bind (w h) + (geometry-sizes (find-max-geometry application 1 nil)) + (let* ((prop (netwm:net-wm-state win)) + (horz-p (member :_net_wm_state_maximized_horz prop)) + (vert-p (member :_net_wm_state_maximized_vert prop))) + (unless (member :_net_wm_state_fullscreen prop) + (when width (setf width (if horz-p w (min width w)))) + (when height (setf height (if vert-p h (min height h)))))))) (xlib:with-state (win) (when width (setf (xlib:drawable-width win) width)) (when height (setf (xlib:drawable-height win) height))) --- /project/eclipse/cvsroot/eclipse/widgets.lisp 2005/03/01 22:41:31 1.46 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2007/05/04 08:26:14 1.47 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.46 2005/03/01 22:41:31 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.47 2007/05/04 08:26:14 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -370,6 +370,12 @@ (defsetf fullscreen-mode (application) (mode) "Mode may be (or :on :off). Put or remove application in or from fullscreen." `(with-slots (window (fgeometry full-geometry) master icon) ,application + ;; reset appropriately _net_wm_state property. + (let ((prop (netwm:net-wm-state window))) + (if (eq ,mode :on) + (pushnew :_net_wm_state_fullscreen prop) + (setf prop (delete :_net_wm_state_fullscreen prop))) + (setf (netwm:net-wm-state window) prop)) (if (eq ,mode :on) ;; put in fullscreen mode. (with-event-mask (*root-window*) @@ -399,13 +405,7 @@ (slot-value master 'old-frame-style))) (multiple-value-bind (x y) (geometry-coordinates fgeometry) (with-slots (window) (or master ,application) - (configure-window window :x x :y y))))) - ;; reset appropriately _net_wm_state property. - (let ((prop (netwm:net-wm-state window))) - (if (eq ,mode :on) - (pushnew :_net_wm_state_fullscreen prop) - (setf prop (delete :_net_wm_state_fullscreen prop))) - (setf (netwm:net-wm-state window) prop)))) + (configure-window window :x x :y y)))))))
(defun application-leader (application) "Returns the "leader" of an application. The leader is computed --- /project/eclipse/cvsroot/eclipse/wm.lisp 2005/03/13 23:37:07 1.51 +++ /project/eclipse/cvsroot/eclipse/wm.lisp 2007/05/04 08:26:14 1.52 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: wm.lisp,v 1.51 2005/03/13 23:37:07 ihatchondo Exp $ +;;; $Id: wm.lisp,v 1.52 2007/05/04 08:26:14 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -366,22 +366,28 @@ "Returns as multiple values the decoration initial coordinates." (let ((hint (ignore-errors (xlib:wm-normal-hints app-window)))) (with-slots (top-margin left-margin vmargin hmargin) frame-style - (if (and hint (xlib:wm-size-hints-user-specified-position-p hint)) - (let ((x (xlib:wm-size-hints-x hint)) - (y (xlib:wm-size-hints-y hint))) - (case (xlib:wm-size-hints-win-gravity hint) - (:north-east (values (- x hmargin) y)) - (:south-east (values (- x hmargin) (- y vmargin))) - (:south-west (values x (- y vmargin))) - (:static (values (- x left-margin) (- y top-margin))) - (t (values x y)))) - (let* ((n (or (window-desktop-num app-window) 0)) - (k (if (= +any-desktop+ n) 0 (* 4 n))) - (areas (netwm:net-workarea *root-window*)) - (ax (aref areas k)) (ay (aref areas (1+ k)))) - (multiple-value-bind (x y) (window-position app-window) - (values (max ax (- x left-margin)) - (max ay (- y top-margin))))))))) + (flet ((default-coordinates () + (let* ((n (or (window-desktop-num app-window) 0)) + (k (if (= +any-desktop+ n) 0 (* 4 n))) + (areas (netwm:net-workarea *root-window*)) + (ax (aref areas k)) (ay (aref areas (1+ k)))) + (multiple-value-bind (x y) (window-position app-window) + (values (max ax (- x left-margin)) + (max ay (- y top-margin))))))) + (if (and hint (xlib:wm-size-hints-user-specified-position-p hint)) + (let ((x (xlib:wm-size-hints-x hint)) + (y (xlib:wm-size-hints-y hint))) + (if (and x y) + (case (xlib:wm-size-hints-win-gravity hint) + (:north-east (values (- x hmargin) y)) + (:south-east (values (- x hmargin) (- y vmargin))) + (:south-west (values x (- y vmargin))) + (:static (values (- x left-margin) (- y top-margin))) + (t (values x y))) + (progn + (format t "user-specified-position-p t but x or y isn't.") + (default-coordinates)))) + (default-coordinates))))))
(defun make-decoration (app-window application &key theme) "Returns a newly initialized decoration to hold the given application." @@ -431,8 +437,18 @@ (with-event-mask (master-window) (xlib:map-subwindows master-window)) (with-event-mask (master-window (when map +decoration-event-mask+)) - (xlib:reparent-window window master-window left-margin top-margin)) + (xlib:reparent-window window master-window left-margin top-margin) + (send-configuration-notify window)) (setf (application-frame-style application) (decoration-frame-style master)) + ;; handle maximized states. + (let* ((prop (netwm:net-wm-state window)) + (vert-p (member :_net_wm_state_maximized_vert prop)) + (horz-p (member :_net_wm_state_maximized_horz prop))) + (when (or vert-p horz-p) + (setf prop (delete :_net_wm_state_maximized_vert prop)) + (setf prop (delete :_net_wm_state_maximized_horz prop)) + (setf (netwm:net-wm-state window) prop) + (maximize application (if (and horz-p vert-p) 1 (if horz-p 3 2))))) (when map (xlib:map-window window)) master))