Update of /project/eclipse/cvsroot/eclipse In directory clnet:/tmp/cvs-serv3505a

Modified Files: widgets.lisp wm.lisp Log Message: Fix: fullscreen state handling when decorating an application.

--- /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/24 08:24:45 1.53 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/25 08:42:44 1.54 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.53 2008/04/24 08:24:45 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.54 2008/04/25 08:42:44 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -290,29 +290,39 @@ (and (if max-w (= max-w (screen-width)) t) (if max-h (= max-h (screen-height)) t))))))

+(defun fullscreen-sizes (display) + "Returns the fullscreen x, y, width and height as a multiple value." + (if (xlib:query-extension display "XFree86-VidModeExtension") + (let* ((screen (xlib:display-default-screen display)) + (ml (xlib:xfree86-vidmode-get-mode-line display screen))) + (multiple-value-bind (x y) + (xlib:xfree86-vidmode-get-viewport display screen) + (values x y (xlib:mode-info-hdisplay ml) (xlib:mode-info-vdisplay ml))) + (values 0 0 (screen-width) (screen-height))))) + ;; Maximization helpers. (defun find-max-geometry (application direction fill-p &key x y w h) (multiple-value-bind (rx ry rw rh) (rectangle-geometry - (find-largest-empty-area - application - :area-include-me-p (or (/= 1 direction) fill-p) - :panels-only-p (not fill-p) - :direction (case direction (2 :vertical) (3 :horizontal) (t :both)))) + (find-largest-empty-area + application + :area-include-me-p (or (/= 1 direction) fill-p) + :panels-only-p (not fill-p) + :direction (case direction (2 :vertical) (3 :horizontal) (t :both)))) (with-slots (window master) application (with-slots ((hm hmargin) (vm vmargin)) - (if master (decoration-frame-style master) - (theme-default-style (lookup-theme "no-decoration"))) - (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))) - (let* ((wmsh (recompute-wm-normal-hints window hm vm)) - (ww (or w (check-size (- rw hm) basew incw minw maxw))) - (hh (or h (check-size (- rh vm) baseh inch minh maxh)))) - (when (> (+ ww hm) rw) (decf ww incw)) - (when (> (+ hh vm) rh) (decf hh inch)) - (make-geometry :w ww :h hh :x (or x rx) :y (or y ry)))))))) + (if master (decoration-frame-style master) + (theme-default-style (lookup-theme "no-decoration"))) + (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))) + (let* ((wmsh (recompute-wm-normal-hints window hm vm)) + (ww (or w (check-size (- rw hm) basew incw minw maxw))) + (hh (or h (check-size (- rh vm) baseh inch minh maxh)))) + (when (> (+ ww hm) rw) (decf ww incw)) + (when (> (+ hh vm) rh) (decf hh inch)) + (make-geometry :w ww :h hh :x (or x rx) :y (or y ry))))))))

(defun compute-max-geometry (application x y w h direction fill-p vert-p horz-p) @@ -399,14 +409,8 @@ (setf (decoration-frame-style master) (theme-default-style (lookup-theme "no-decoration"))))) (setf (geometry fgeometry) (values x y w h)) - (if (xlib:query-extension *display* "XFree86-VidModeExtension") - (let* ((scr (first (xlib:display-roots *display*))) - (ml (xlib:xfree86-vidmode-get-mode-line *display* scr))) - (multiple-value-setq (x y) - (xlib:xfree86-vidmode-get-viewport *display* scr)) - (setf w (xlib:mode-info-hdisplay ml) - h (xlib:mode-info-vdisplay ml))) - (setf x 0 y 0 w (screen-width) h (screen-height))) + (multiple-value-setq (x y w h) + (fullscreen-sizes (xlib:window-display window))) (configure-window window :x x :y y :width w :height h)) (focus-widget application 0)) ;; revert: restore precedent geometry and decoration style. --- /project/eclipse/cvsroot/eclipse/wm.lisp 2008/04/23 09:54:46 1.53 +++ /project/eclipse/cvsroot/eclipse/wm.lisp 2008/04/25 08:42:45 1.54 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: wm.lisp,v 1.53 2008/04/23 09:54:46 ihatchondo Exp $ +;;; $Id: wm.lisp,v 1.54 2008/04/25 08:42:45 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -392,48 +392,55 @@ (defun make-decoration (app-window application &key theme) "Returns a newly initialized decoration to hold the given application." (unless theme (setf theme (root-decoration-theme *root*))) - (let* ((dstyle (find-decoration-frame-style theme app-window)) - (style dstyle)) - (when (member :_net_wm_state_fullscreen (netwm:net-wm-state app-window)) + (let* ((netwm-states (ignore-errors (netwm:net-wm-state app-window))) + (dstyle (find-decoration-frame-style theme app-window)) + (style dstyle) + (fullscreen-p (member :_net_wm_state_fullscreen netwm-states))) + (when fullscreen-p (setf style (theme-default-style (lookup-theme "no-decoration")))) (with-slots (hmargin vmargin left-margin top-margin background) style - (multiple-value-bind (wm-sizes gravity) - (recompute-wm-normal-hints app-window hmargin vmargin) - (multiple-value-bind (width height) (drawable-sizes app-window) - (multiple-value-bind (x y) (initial-coordinates app-window style) - (let* ((window (xlib:create-window - :parent (xlib:drawable-root app-window) - :x x :y y - :width (+ width hmargin) - :height (+ height vmargin) - :background background - :event-mask +decoration-event-mask+ - :do-not-propagate-mask - '(:button-press :button-release))) - (master (make-instance 'decoration - :window window - :old-frame-style dstyle :frame-style style - :children (list :application application) - :application-gravity gravity - :wm-size-hints wm-sizes))) - (make-frame-parts master) - (make-title-bar master (wm-name app-window)) - (update-edges-geometry master) - (with-slots (icon) application - (setf (getf (decoration-children master) :icon) icon - (slot-value icon 'master) master - (slot-value application 'master) master - (xlib:drawable-border-width app-window) 0)) - master))))))) + (multiple-value-bind (wm-sizes gravity) + (recompute-wm-normal-hints app-window hmargin vmargin) + (multiple-value-bind (width height) (drawable-sizes app-window) + (multiple-value-bind (x y) (initial-coordinates app-window style) + (let* ((window (xlib:create-window + :parent (xlib:drawable-root app-window) + :x x :y y + :width (+ width hmargin) + :height (+ height vmargin) + :background background + :event-mask +decoration-event-mask+ + :do-not-propagate-mask + '(:button-press :button-release))) + (master (make-instance 'decoration + :window window + :old-frame-style dstyle :frame-style style + :children (list :application application) + :application-gravity gravity + :wm-size-hints wm-sizes))) + (make-frame-parts master) + (make-title-bar master (wm-name app-window)) + (update-edges-geometry master) + (with-slots (icon (fgeometry full-geometry)) application + (setf (getf (decoration-children master) :icon) icon + (slot-value icon 'master) master + (slot-value application 'master) master + (xlib:drawable-border-width app-window) 0) + (when fullscreen-p + (multiple-value-bind (x y w h) + (fullscreen-sizes (xlib:window-display app-window)) + (configure-window app-window :x x :y y :width w :height h)) + (setf (geometry fgeometry) (values x y width height)))) + master)))))))

(defun decore-application (window application &key (map t) theme) "Decores an application and map the resulting decoration as indicated by the :map keyword argument. (default value is T). Returns the newly created decoration instance." (let* ((master (make-decoration window application :theme theme)) - (master-window (widget-window master)) - (left-margin (style-left-margin (decoration-frame-style master))) - (top-margin (style-top-margin (decoration-frame-style master)))) + (master-window (widget-window master)) + (left-margin (style-left-margin (decoration-frame-style master))) + (top-margin (style-top-margin (decoration-frame-style master)))) (with-event-mask (master-window) (xlib:map-subwindows master-window)) (with-event-mask (master-window (when map +decoration-event-mask+))