Update of /project/eclipse/cvsroot/eclipse In directory clnet:/tmp/cvs-serv19826

Modified Files: eclipse.lisp global.lisp input.lisp misc.lisp move-resize.lisp widgets.lisp wm.lisp Log Message: Fix: hacking around *root-window* ...

--- /project/eclipse/cvsroot/eclipse/eclipse.lisp 2007/05/08 22:33:17 1.26 +++ /project/eclipse/cvsroot/eclipse/eclipse.lisp 2008/04/25 16:02:49 1.27 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: eclipse.lisp,v 1.26 2007/05/08 22:33:17 ihatchondo Exp $ +;;; $Id: eclipse.lisp,v 1.27 2008/04/25 16:02:49 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -129,7 +129,7 @@ (let ((first-desknum (current-vscreen window)) (nb-vs (number-of-virtual-screens window)) (srcw (screen-width)) (srch (screen-height))) - (xlib:with-server-grabbed (*display*) + (xlib:with-server-grabbed (display) (delete-properties window +netwm-protocol+) (unless (< -1 first-desknum nb-vs) (setf first-desknum 0)) (setf (gnome:win-protocols window) +gnome-protocols+ @@ -166,7 +166,7 @@ (xlib:display-after-function display) #'xlib:display-force-output) (setf *root* (make-instance 'root :window root-window :manager manager) *root-window* root-window - (root-default-cursor *root*) (get-x-cursor *display* :xc_left_ptr) + (root-default-cursor *root*) (get-x-cursor display :xc_left_ptr) (root-sm-conn *root*) (connect-to-session-manager display-specification sm-client-id)) ;; init all gnome properties on root. @@ -177,7 +177,7 @@ *white* (xlib:screen-white-pixel screen) *background1* (xlib:alloc-color colormap *menu-color*) *background2* (xlib:alloc-color colormap *menu-hilighted-color*) - *cursor-2* (get-x-cursor *display* :xc_fleur) + *cursor-2* (get-x-cursor display :xc_fleur) *gctxt* (xlib:create-gcontext :drawable root-window :font menu-font) *max-char-width* (xlib:max-char-width menu-font) *gcontext* (xlib:create-gcontext --- /project/eclipse/cvsroot/eclipse/global.lisp 2008/04/23 09:54:46 1.30 +++ /project/eclipse/cvsroot/eclipse/global.lisp 2008/04/25 16:02:49 1.31 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: global.lisp,v 1.30 2008/04/23 09:54:46 ihatchondo Exp $ +;;; $Id: global.lisp,v 1.31 2008/04/25 16:02:49 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2001, 2002 Iban HATCHONDO @@ -119,17 +119,20 @@ (defsetf decoration-theme (&key free-old-theme-p) (name) "Sets the theme that must be used for window decoration. This theme will be used for all existing applications as well as futur one." - `(with-slots (decoration-theme) *root* - (let ((theme (load-theme *root-window* ,name))) - (when decoration-theme - (loop with old-name = (theme-name decoration-theme) - for val being each hash-value in *widget-table* - when (and (application-p val) (application-master val)) do - (with-slots (window master) val + `(set-decoration-theme ,name ,free-old-theme-p)) + +(defun set-decoration-theme (name free-old-theme-p) + (with-slots (decoration-theme window) *root* + (let ((theme (load-theme window name))) + (when decoration-theme + (loop with old-name = (theme-name decoration-theme) + for val being each hash-value in *widget-table* + when (and (application-p val) (application-master val)) do + (with-slots (window master) val (setf (decoration-frame-style master) (find-decoration-frame-style theme window))) - finally (and ,free-old-theme-p (free-theme old-name)))) - (setf decoration-theme theme)))) + finally (and free-old-theme-p (free-theme old-name)))) + (setf decoration-theme theme))))

(defsetf maximize-modifier () (modifier-key) "Sets the modifier to use to activate window maximization second behavior." --- /project/eclipse/cvsroot/eclipse/input.lisp 2008/04/23 09:54:46 1.48 +++ /project/eclipse/cvsroot/eclipse/input.lisp 2008/04/25 16:02:49 1.49 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: input.lisp,v 1.48 2008/04/23 09:54:46 ihatchondo Exp $ +;;; $Id: input.lisp,v 1.49 2008/04/25 16:02:49 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -90,7 +90,8 @@ (when (or (decoration-p widget) (application-p (lookup-widget window))) (if (eq *focus-type* :on-click) (give-focus-to-next-widget-in-desktop) - (multiple-value-bind (x y s child) (xlib:query-pointer *root-window*) + (multiple-value-bind (x y s child) + (xlib:query-pointer (xlib:drawable-root window)) (declare (ignore x y s)) (let ((e (make-event :enter-notify :kind :nonlinear :mode :normal))) (event-process e (or (lookup-widget child) *root*)))))))) @@ -316,7 +317,7 @@ (with-slots (master window) application (unless (eql (event-mode event) :grab) (when master (dispatch-repaint master :focus t)) - (setf (netwm:net-active-window *root-window*) window) + (setf (netwm:net-active-window (xlib:drawable-root window)) window) (xlib:delete-property (widget-window (root-property-holder *root*)) :_net_active_window)))) --- /project/eclipse/cvsroot/eclipse/misc.lisp 2008/04/23 09:54:46 1.41 +++ /project/eclipse/cvsroot/eclipse/misc.lisp 2008/04/25 16:02:49 1.42 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: misc.lisp,v 1.41 2008/04/23 09:54:46 ihatchondo Exp $ +;;; $Id: misc.lisp,v 1.42 2008/04/25 16:02:49 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -91,14 +91,16 @@ (defsetf wm-state (window &key (icon-id 0)) (state) "Sets the wm_state property of a window. Note that its _net_wm_state property will be updated accordingly to the value given for the wm_state." - (let ((net-wm-state (gensym))) - `(let ((,net-wm-state (netwm:net-wm-state ,window))) - (if (or (= ,state 3) (= ,state 0)) - (pushnew :_net_wm_state_hidden ,net-wm-state) - (setf ,net-wm-state (delete :_net_wm_state_hidden ,net-wm-state))) - (setf (netwm:net-wm-state ,window) ,net-wm-state) - (xlib:change-property ,window :WM_STATE - (list ,state ,icon-id) + (with-gensym (_window _state _net-wm-state) + `(let* ((,_window ,window) + (,_state ,state) + (,_net-wm-state (netwm:net-wm-state ,_window))) + (if (or (= ,_state 3) (= ,_state 0)) + (pushnew :_net_wm_state_hidden ,_net-wm-state) + (setf ,_net-wm-state (delete :_net_wm_state_hidden ,_net-wm-state))) + (setf (netwm:net-wm-state ,_window) ,_net-wm-state) + (xlib:change-property ,_window :WM_STATE + (list ,_state ,icon-id) :WM_STATE 32))))

@@ -107,12 +109,12 @@ between _net_wm_desktop_names and _win_workspace_names respectively." (or (netwm:net-desktop-names window) (gnome:win-workspace-names window)))

-(defsetf workspace-names () (names) +(defsetf workspace-names (window) (names) "Sets both the _win_workspace_names and the _net_wm_desktop_names properties to the given list of name." `(when ,names - (setf (netwm:net-desktop-names *root-window*) ,names - (gnome:win-workspace-names *root-window*) ,names))) + (setf (netwm:net-desktop-names ,window) ,names + (gnome:win-workspace-names ,window) ,names)))

(defun wm-name (window) "Returns the name of the window according to the first property that is set --- /project/eclipse/cvsroot/eclipse/move-resize.lisp 2005/01/17 09:30:40 1.18 +++ /project/eclipse/cvsroot/eclipse/move-resize.lisp 2008/04/25 16:02:49 1.19 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: move-resize.lisp,v 1.18 2005/01/17 09:30:40 ihatchondo Exp $ +;;; $Id: move-resize.lisp,v 1.19 2008/04/25 16:02:49 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -31,9 +31,9 @@ (when *geometry-info-box* (xlib:unmap-window (widget-window *geometry-info-box*))))

-(defun initialize-geometry-info-box () +(defun initialize-geometry-info-box (parent-window) (unless *geometry-info-box* - (setf *geometry-info-box* (create-message-box nil :parent *root-window*))) + (setf *geometry-info-box* (create-message-box nil :parent parent-window))) (with-slots (window) *geometry-info-box* (xlib:map-window window) (setf (xlib:window-priority window) :above))) @@ -59,9 +59,9 @@

(defparameter *clone* nil)

-(defun initialize-clone () +(defun initialize-clone (parent-window) (let ((win (xlib:create-window - :parent *root-window* :x 0 :y 0 :width 100 :height 100))) + :parent parent-window :x 0 :y 0 :width 100 :height 100))) (setf *clone* (make-decoration win (create-application win nil)))))

(defun update-*clone* (x y w h decoration-frame-style &optional wm-hints) @@ -96,13 +96,13 @@ (with-slots (resize-status move-status current-active-widget window) root (with-slots ((widget-window window) gcontext active-p) widget (when (and active-p (not (or resize-status move-status))) - (or *clone* (initialize-clone)) + (or *clone* (initialize-clone window)) (update-clone widget) (grab-root-pointer) (setf (slot-value root status) t current-active-widget widget) (when verbose-p - (initialize-geometry-info-box) + (initialize-geometry-info-box window) (multiple-value-bind (x y w h) (window-geometry widget-window) (if (and (eq status 'resize-status) (decoration-p widget)) (multiple-value-bind (a b c d iw ih bw bh) @@ -255,7 +255,8 @@ ;; called when button-release on root and root-resize-status is not nil. (with-slots (window gcontext) master (when (and (decoration-active-p master) (eql mode :box)) - (draw-window-grid (widget-window *clone*) gcontext *root-window*) + (draw-window-grid + (widget-window *clone*) gcontext (xlib:drawable-root window)) (multiple-value-bind (x y w h) (window-geometry (widget-window *clone*)) (setf (window-position window) (values x y) @@ -296,9 +297,10 @@ (update-edges-geometry master) (resize-from master)) (with-slots (window gcontext) *clone* - (draw-window-grid window gcontext *root-window*) - (resize-internal *clone* event verbose-p) - (draw-window-grid window gcontext *root-window*)))) + (let ((root-window (xlib:drawable-root window))) + (draw-window-grid window gcontext root-window) + (resize-internal *clone* event verbose-p) + (draw-window-grid window gcontext root-window)))))

;;;; Move.

@@ -403,10 +405,11 @@ (when verbose-p (display-coordinates new-x new-y)) (if (and (or (decoration-p widget) (application-p widget)) (eql mode :box)) - (with-slots (window) *clone* - (draw-window-grid window gcontext *root-window*) - (setf (window-position window) (values new-x new-y)) - (draw-window-grid window gcontext *root-window*)) + (with-slots (window) *clone* + (let ((root-window (xlib:drawable-root window))) + (draw-window-grid window gcontext root-window) + (setf (window-position window) (values new-x new-y)) + (draw-window-grid window gcontext root-window))) (setf (window-position window) (values new-x new-y)))))))

(defun finish-move (widget &optional verbose-p mode) @@ -414,7 +417,7 @@ (with-slots ((widget-window window) active-p) widget (when (eql mode :box) (with-slots (window gcontext) *clone* - (draw-window-grid window gcontext *root-window*) + (draw-window-grid window gcontext (xlib:drawable-root window)) (setf (window-position widget-window) (window-position window)))) (setf active-p nil) (when verbose-p (undraw-geometry-info-box))) --- /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/25 08:42:44 1.54 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/25 16:02:49 1.55 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.54 2008/04/25 08:42:44 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.55 2008/04/25 16:02:49 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -400,7 +400,7 @@ (setf (netwm:net-wm-state window) prop)) (if (eq mode :on) ;; put in fullscreen mode. - (with-event-mask (*root-window*) + (with-event-mask ((xlib:drawable-root window)) (multiple-value-bind (x y w h) (window-geometry window) (when master (with-slots (children (master-win window) frame-style) master @@ -414,7 +414,7 @@ (configure-window window :x x :y y :width w :height h)) (focus-widget application 0)) ;; revert: restore precedent geometry and decoration style. - (with-event-mask (*root-window*) + (with-event-mask ((xlib:drawable-root window)) (setf (drawable-sizes window) (geometry-sizes fgeometry)) (unless (window-not-decorable-p window) (setf (decoration-frame-style master) @@ -440,7 +440,7 @@ (with-slots (master window) application (when (shaded-p application) (shade application)) (setf (window-desktop-num window) new-screen-number) - (with-event-mask (*root-window*) + (with-event-mask ((xlib:drawable-root window)) (let ((master-window (when master (widget-window master)))) (funcall operation (or master-window window)) (when master-window @@ -457,10 +457,11 @@ "Removes all decoration of this application widget and reparent it to root." (with-slots (window master icon) application (if master - (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) master)) + (let ((root-window (xlib:drawable-root window))) + (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) master))) (event-process (make-event :destroy-notify :window window) *root*)) (when state (setf (wm-state window) state) @@ -823,7 +824,7 @@ (setf bkgrd pix)))) (setf icon (create-button 'icon :event-mask '(:pointer-motion-hint . #.+std-button-mask+) - :parent *root-window* :master master + :parent (xlib:drawable-root window) :master master :x 0 :y 0 :width width :height height :item (unless bkgrd (wm-icon-name window)) :background (or bkgrd bg-color))) --- /project/eclipse/cvsroot/eclipse/wm.lisp 2008/04/25 08:42:45 1.54 +++ /project/eclipse/cvsroot/eclipse/wm.lisp 2008/04/25 16:02:49 1.55 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: wm.lisp,v 1.54 2008/04/25 08:42:45 ihatchondo Exp $ +;;; $Id: wm.lisp,v 1.55 2008/04/25 16:02:49 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -362,16 +362,16 @@ (setf (drawable-sizes window) (values (max 1 (- width hm)) (max 1 (- height vm))))))))

-(defun initial-coordinates (app-window frame-style) +(defun initial-coordinates (window frame-style) "Returns as multiple values the decoration initial coordinates." - (let ((hint (ignore-errors (xlib:wm-normal-hints app-window)))) + (let ((hint (ignore-errors (xlib:wm-normal-hints window)))) (with-slots (top-margin left-margin vmargin hmargin) frame-style (flet ((default-coordinates () - (let* ((n (or (window-desktop-num app-window) 0)) + (let* ((n (or (window-desktop-num window) 0)) (k (if (= +any-desktop+ n) 0 (* 4 n))) - (areas (netwm:net-workarea *root-window*)) + (areas (netwm:net-workarea (xlib:drawable-root window))) (ax (aref areas k)) (ay (aref areas (1+ k)))) - (multiple-value-bind (x y) (window-position app-window) + (multiple-value-bind (x y) (window-position window) (values (max ax (- x left-margin)) (max ay (- y top-margin))))))) (if (and hint (xlib:wm-size-hints-user-specified-position-p hint))