[Eclipse-cvs] CVS update: eclipse/widgets.lisp eclipse/wm.lisp

[Iban Hatchondo]

Update of /project/eclipse/cvsroot/eclipse
In directory common-lisp.net:/tmp/cvs-serv22316

Modified Files:
	widgets.lisp wm.lisp 
Log Message:
- minor focus change:
  For application with a :no-input as focus model, we now gives the
  same event mask as the others. The problem was that an application
  with a globaly-active model can decide to sets the focus to one of
  its satellite window that have a no-input model. This is correct
  because the input model is indicate to the window manager how to
  give the focus to the application. But in any case, it indicates
  that the application will never have or not the focus.

- minor change in (setf fullscreen-mode): we now use the
  no-decoration-theme instead of undecorting.


Date: Thu Oct  9 07:37:08 2003
Author: ihatchondo

Index: eclipse/widgets.lisp
diff -u eclipse/widgets.lisp:1.16 eclipse/widgets.lisp:1.17
--- eclipse/widgets.lisp:1.16	Mon Oct  6 13:57:26 2003
+++ eclipse/widgets.lisp	Thu Oct  9 07:37:08 2003
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: widgets.lisp,v 1.16 2003/10/06 17:57:26 ihatchondo Exp $
+;;; $Id: widgets.lisp,v 1.17 2003/10/09 11:37:08 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -162,9 +162,8 @@
 
 ;;;; Application
 
-(defconstant +unfocusable-mask+
-  '(:property-change :enter-window :visibility-change))
-(defconstant +focusable-mask+ '(:focus-change . #.+unfocusable-mask+))
+(defconstant +application-mask+
+  '(:property-change :enter-window :visibility-change :focus-change))
 
 (defconstant +properties-to-delete-on-withdrawn+
   '(:_net_wm_state :_net_wm_desktop :_win_workspace))
@@ -233,18 +232,12 @@
 	 (with-event-mask (*root-window*)
 	   (multiple-value-bind (x y w h) (window-geometry window)
 	     (when master
-	       (with-slots (children (master-win window)) master
+	       (with-slots (children (master-win window) frame-style) master
 		 (multiple-value-setq (x y)
 		   (xlib:translate-coordinates master-win x y *root-window*))
-		 (with-event-mask (master-win)
-		   (xlib:reparent-window window *root-window* 0 0))
-		 (xlib:destroy-window master-win)
-		 (loop for (key widget) on children by #'cddr
-		       unless (or (eql key :application) (eql key :icon))
-		       do (remove-widget widget))
-		 (remove-widget master))
-	       (setf master nil
-		     (slot-value icon 'master) *root*))
+		 (setf (slot-value master 'old-frame-style) frame-style)
+		 (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*)))
@@ -261,7 +254,8 @@
 	   (setf (window-position window) (geometry-coordinates fgeometry)
 		 (drawable-sizes window) (geometry-sizes fgeometry))
 	   (unless (window-not-decorable-p window)
-	     (decore-application window application))))
+	     (setf (decoration-frame-style master)
+		   (slot-value master 'old-frame-style)))))
      (let ((prop (netwm:net-wm-state window)))
        (if (eq ,mode :on)
 	   (pushnew :_net_wm_state_fullscreen prop)
@@ -271,11 +265,9 @@
 (defun undecore-application (application &key state)
   (with-slots (window master icon) application
     (if master
-	(with-slots (frame-style (master-win window)) master
-	  (multiple-value-bind (x y) (window-position master-win)
-	    (incf x (style-left-margin frame-style)) 
-	    (incf y (style-top-margin frame-style))
-	    (xlib:reparent-window window *root-window* x y)))
+	(multiple-value-bind (x y)
+	    (xlib:translate-coordinates window 0 0 *root-window*)
+	  (xlib:reparent-window window *root-window* x y))
         (event-process (make-event :destroy-notify :window window) *root*))
     (when state
       (setf (wm-state window) state)
@@ -317,8 +309,7 @@
 	  (grab-button window :any '(:button-press) :sync-pointer-p t))
       (with-slots (initial-geometry) app
 	(setf (geometry initial-geometry) (window-geometry window)))
-      (setf (xlib:window-event-mask window) 
-	    (if (eq input :no-input) +unfocusable-mask+ +focusable-mask+)))
+      (setf (xlib:window-event-mask window) +application-mask+))
     app))
 
 (defun kill-client-window (window)


Index: eclipse/wm.lisp
diff -u eclipse/wm.lisp:1.21 eclipse/wm.lisp:1.22
--- eclipse/wm.lisp:1.21	Mon Oct  6 13:57:26 2003
+++ eclipse/wm.lisp	Thu Oct  9 07:37:08 2003
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: wm.lisp,v 1.21 2003/10/06 17:57:26 ihatchondo Exp $
+;;; $Id: wm.lisp,v 1.22 2003/10/09 11:37:08 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -36,6 +36,7 @@
    (time :initform 0 :accessor decoration-precedent-time :allocation :class)
    (wm-size-hints :initarg :wm-size-hints :reader decoration-wm-size-hints)
    (frame-style :initarg :frame-style :accessor decoration-frame-style)
+   (old-frame-style :initform nil)
    (application-gravity 
      :initarg :application-gravity
      :initform :north-west
@@ -506,7 +507,6 @@
 
 (defmethod set-focus ((input-model (eql :no-input)) window timestamp)
   (declare (ignorable window timestamp))
-  (xlib:set-input-focus *display* :pointer-root :pointer-root)
   (values))
 
 ;; Next is methods for menu-3 who permit to manage any window :