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))
