Commit ce4d4770 authored by Iban Hatchondo's avatar Iban Hatchondo
Browse files

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)
parent 1d4a9ad6
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.43 2005/02/12 02:04:37 ihatchondo Exp $
;;; $Id: input.lisp,v 1.44 2005/03/01 22:41:31 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))))))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: misc.lisp,v 1.34 2005/09/21 16:34:40 ihatchondo Exp $
;;; $Id: misc.lisp,v 1.35 2006/01/21 19:15:57 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)))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.45 2005/02/10 23:45:44 ihatchondo Exp $
;;; $Id: widgets.lisp,v 1.46 2005/03/01 22:41:31 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
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: wm.lisp,v 1.50 2005/03/01 22:41:31 ihatchondo Exp $
;;; $Id: wm.lisp,v 1.51 2005/03/13 23:37:07 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))
......
Markdown is supported
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