[Eclipse-cvs] CVS eclipse - eclipse-cvs@common-lisp.net - mailman3.common-lisp.net

23 Apr 2008

Update of /project/eclipse/cvsroot/eclipse
In directory clnet:/tmp/cvs-serv23411
Modified Files:
    global.lisp input.lisp misc.lisp wm.lisp 
Log Message:
Fix: netwm-user-time usage, and some withdrawal glitches.

--- /project/eclipse/cvsroot/eclipse/global.lisp	2005/03/01 22:41:31	1.29
+++ /project/eclipse/cvsroot/eclipse/global.lisp	2008/04/23 09:54:46	1.30
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: global.lisp,v 1.29 2005/03/01 22:41:31 ihatchondo Exp $
+;;; $Id: global.lisp,v 1.30 2008/04/23 09:54:46 ihatchondo Exp $
 ;;;
 ;;; This file is part of Eclipse.
 ;;; Copyright (C) 2001, 2002 Iban HATCHONDO
@@ -37,7 +37,7 @@
     :_net_current_desktop :_net_active_window :_net_close_window :_net_workarea
     :_net_wm_desktop :_net_wm_window_type :_net_desktop_names
     :_net_restack_window :_net_moveresize_window :_net_wm_user_time
-    :_net_request_frame_extents :_net_frame_extents 
+    :_net_wm_user_time_window :_net_request_frame_extents :_net_frame_extents 
     :_net_wm_strut_partial :_net_wm_state :_net_wm_strut
     :_net_wm_window_type_desktop :_net_wm_window_type_dock
     :_net_wm_window_type_toolbar :_net_wm_window_type_menu
--- /project/eclipse/cvsroot/eclipse/input.lisp	2007/05/07 13:22:50	1.47
+++ /project/eclipse/cvsroot/eclipse/input.lisp	2008/04/23 09:54:46	1.48
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: input.lisp,v 1.47 2007/05/07 13:22:50 ihatchondo Exp $
+;;; $Id: input.lisp,v 1.48 2008/04/23 09:54:46 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -146,7 +146,14 @@
    	 (undecore-application widget :state 0)
    	 (setf (wm-state window) 3)))))
    (decoration 
-	 (setf (wm-state (get-child widget :application :window t)) 3))))))
+         (let ((application (get-child widget :application)))
+           (if (application-iconic-p application)
+               (setf (wm-state (widget-window application)) 3)
+               (with-slots (window send-event-p) event
+                 (setf send-event-p t)
+                 (setf window (widget-window application))
+                 (format t "about to withdraw: ~a ~%" (wm-name window))
+                 (event-process event root)))))))))
(defmethod event-process ((event destroy-notify) (root root))
   (let ((app (lookup-widget (event-window event))))
@@ -427,9 +434,9 @@
     (with-slots ((pwindow window)) (root-property-holder *root*)
       (let* ((length (length data))
    	  (time (if (> length 1) (aref data 1) 0))
-		  (wtime (or (netwm:net-wm-user-time pwindow) 0)))
+		  (wtime (or (net-wm-user-time pwindow) 0)))
         (unless (> wtime time 0)
-	       (setf (netwm:net-wm-user-time pwindow) time)
+	       ;;(setf (netwm:net-wm-user-time pwindow) time)
           (focus-widget application time)
           (put-on-top application)))))
    (:_net_wm_desktop (migrate-application application (aref data 0)))
--- /project/eclipse/cvsroot/eclipse/misc.lisp	2007/11/02 09:33:08	1.40
+++ /project/eclipse/cvsroot/eclipse/misc.lisp	2008/04/23 09:54:46	1.41
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: misc.lisp,v 1.40 2007/11/02 09:33:08 ihatchondo Exp $
+;;; $Id: misc.lisp,v 1.41 2008/04/23 09:54:46 ihatchondo Exp $
 ;;;
 ;;; This file is part of Eclipse.
 ;;; Copyright (C) 2002 Iban HATCHONDO
@@ -44,10 +44,11 @@
 (defmacro current-desk () `(current-vscreen *root-window*))
(defmacro id->atom-name (id)
-  `(xlib:atom-name *display* ,id))
+  `(when (typep ,id 'xlib:card29)
+     (xlib:atom-name *display* ,id)))
(defmacro atom-name->id (name)
- `(xlib:find-atom *display* ,name))
+  `(xlib:find-atom *display* ,name))
(defmacro with-root-cursor ((new-cursor) &body body)
   `(unwind-protect
@@ -176,6 +177,19 @@
   (or (= (or (window-desktop-num window) -1) +any-desktop+)
       (logbitp 0 (or (gnome:win-state window :result-type t) 0))))
+(defun net-wm-user-time (window) 
+  "Returns the _net_wm_user_time property using the _net_wm_user_time_window
+   if present. If the property is not defined return NIL."
+  (let ((user-time-window (netwm:net-wm-user-time-window window)))
+    (netwm:net-wm-user-time (or user-time-window window))))
+
+(defsetf net-wm-user-time (window) (timestamp)
+  "Sets the _net_wm_user_time property using the _net_wm_user_time_window
+   if present, otherwise window is the property holder."
+  (let ((time-window (gensym)))
+    `(let ((,time-window (netwm:net-wm-user-time-window ,window)))
+       (setf (netwm:net-wm-user-time (or ,time-window ,window)) ,timestamp))))
+
 ;;;; Miscellaneous functions.
(defun grab-root-pointer (&key cursor owner-p confine-to)
--- /project/eclipse/cvsroot/eclipse/wm.lisp	2007/05/04 08:26:14	1.52
+++ /project/eclipse/cvsroot/eclipse/wm.lisp	2008/04/23 09:54:46	1.53
@@ -1,5 +1,5 @@
 ;;; -*- 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
@@ -686,7 +686,7 @@
(defun procede-decoration (window)
   "Decore, if necessary, add/update properties, map or not, etc a window."
-  (let* ((time (or (ignore-errors (netwm:net-wm-user-time window)) 1))
+  (let* ((time (or (ignore-errors (net-wm-user-time window)) 1))
     (rw (xlib:drawable-root window))
     (scr-num (current-vscreen rw))
     (application (create-application window nil))

    