[Eclipse-cvs] CVS eclipse
ihatchondo
ihatchondo at common-lisp.net
Fri Apr 25 08:42:45 UTC 2008
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+))
More information about the Eclipse-cvs
mailing list