[Eclipse-cvs] CVS eclipse
ihatchondo
ihatchondo at common-lisp.net
Wed Apr 23 09:54:47 UTC 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))
More information about the Eclipse-cvs
mailing list