Commit 3d01339b authored by Iban Hatchondo's avatar Iban Hatchondo
Browse files

Fix: fullscreen state handling when decorating an application.

parent db1167fb
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.52 2008/04/23 15:16:32 ihatchondo Exp $
;;; $Id: widgets.lisp,v 1.53 2008/04/24 08:24:45 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.
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: wm.lisp,v 1.52 2007/05/04 08:26:14 ihatchondo Exp $
;;; $Id: wm.lisp,v 1.53 2008/04/23 09:54:46 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+))
......
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