eclipse-cvs April 2008

eclipse-cvs@common-lisp.net

1 participants
9 discussions

[Eclipse-cvs] CVS eclipse
by ihatchondo 28 Apr '08

28 Apr '08

Update of /project/eclipse/cvsroot/eclipse In directory clnet:/tmp/cvs-serv3373 Modified Files: input.lisp wm.lisp Log Message: Fix: frame extents request handling and frame entents property on undecorate window. --- /project/eclipse/cvsroot/eclipse/input.lisp 2008/04/28 12:29:38 1.50 +++ /project/eclipse/cvsroot/eclipse/input.lisp 2008/04/28 16:09:16 1.51 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: input.lisp,v 1.50 2008/04/28 12:29:38 ihatchondo Exp $ +;;; $Id: input.lisp,v 1.51 2008/04/28 16:09:16 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -97,7 +97,8 @@ (event-process e (or (lookup-widget child) *root*)))))))) (defmethod event-process ((event client-message) window) - (when (xlib:window-p window) + (declare (ignorable window)) + (with-slots ((window event-window)) event (case (event-type event) (:_net_request_frame_extents (with-slots (left-margin right-margin top-margin bottom-margin) --- /project/eclipse/cvsroot/eclipse/wm.lisp 2008/04/25 16:02:49 1.55 +++ /project/eclipse/cvsroot/eclipse/wm.lisp 2008/04/28 16:09:16 1.56 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: wm.lisp,v 1.55 2008/04/25 16:02:49 ihatchondo Exp $ +;;; $Id: wm.lisp,v 1.56 2008/04/28 16:09:16 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -711,6 +711,7 @@ (decore-application window application :map nil)) (update-lists application 1 *root*))) ((window-not-decorable-p window (application-type application)) + (setf (netwm:net-frame-extents window) (values 0 0 0 0)) (setf (wm-state window) 1) (xlib:map-window window)) (t (decore-application window application :map t)))

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 28 Apr '08

28 Apr '08

Update of /project/eclipse/cvsroot/eclipse In directory clnet:/tmp/cvs-serv20203 Modified Files: input.lisp misc.lisp Log Message: fix: nil event window --- /project/eclipse/cvsroot/eclipse/input.lisp 2008/04/25 16:02:49 1.49 +++ /project/eclipse/cvsroot/eclipse/input.lisp 2008/04/28 12:29:38 1.50 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: input.lisp,v 1.49 2008/04/25 16:02:49 ihatchondo Exp $ +;;; $Id: input.lisp,v 1.50 2008/04/28 12:29:38 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -91,7 +91,7 @@ (if (eq *focus-type* :on-click) (give-focus-to-next-widget-in-desktop) (multiple-value-bind (x y s child) - (xlib:query-pointer (xlib:drawable-root window)) + (xlib:query-pointer (xlib:drawable-root (widget-window widget))) (declare (ignore x y s)) (let ((e (make-event :enter-notify :kind :nonlinear :mode :normal))) (event-process e (or (lookup-widget child) *root*)))))))) --- /project/eclipse/cvsroot/eclipse/misc.lisp 2008/04/25 16:02:49 1.42 +++ /project/eclipse/cvsroot/eclipse/misc.lisp 2008/04/28 12:29:39 1.43 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: misc.lisp,v 1.42 2008/04/25 16:02:49 ihatchondo Exp $ +;;; $Id: misc.lisp,v 1.43 2008/04/28 12:29:39 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -91,16 +91,14 @@ (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." - (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) + (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) :WM_STATE 32))))

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 25 Apr '08

25 Apr '08

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))

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 25 Apr '08

25 Apr '08

Update of /project/eclipse/cvsroot/eclipse In directory clnet:/tmp/cvs-serv3505a Modified Files: widgets.lisp wm.lisp Log Message: Fix: fullscreen state handling when decorating an application. --- /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/24 08:24:45 1.53 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/25 08:42:44 1.54 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.53 2008/04/24 08:24:45 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.54 2008/04/25 08:42:44 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. --- /project/eclipse/cvsroot/eclipse/wm.lisp 2008/04/23 09:54:46 1.53 +++ /project/eclipse/cvsroot/eclipse/wm.lisp 2008/04/25 08:42:45 1.54 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: wm.lisp,v 1.53 2008/04/23 09:54:46 ihatchondo Exp $ +;;; $Id: wm.lisp,v 1.54 2008/04/25 08:42:45 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+))

1 0

[Eclipse-cvs] CVS eclipse/docs
by ihatchondo 24 Apr '08

24 Apr '08

Update of /project/eclipse/cvsroot/eclipse/docs In directory clnet:/tmp/cvs-serv28377/docs Modified Files: changelog eclipse.1 Log Message: update --- /project/eclipse/cvsroot/eclipse/docs/changelog 2004/02/12 23:30:23 1.6 +++ /project/eclipse/cvsroot/eclipse/docs/changelog 2008/04/24 15:29:15 1.7 @@ -1,5 +1,5 @@ -*- Mode: ChangeLog -*- -$Id: changelog,v 1.6 2004/02/12 23:30:23 ihatchondo Exp $ +$Id: changelog,v 1.7 2008/04/24 15:29:15 ihatchondo Exp $ 0.01 => 0.02 Eclipse should now compile on every ANSI-compliant Common Lisp @@ -333,7 +333,7 @@ - move resize improvements: - We now use the :pointer-potion-hint in the event-mask. The server + We now use the :pointer-motion-hint in the event-mask. The server is now free to send only one :motion-notify event, until either the key or button state changes, the pointer leaves the event window, or the client calls query-pointer or motion-events. @@ -375,24 +375,155 @@ - add event handling for map-request on decoration. - bug fix and code clean up and more hacking. - - error handling at start up. - - close-sm-connection (widget.lisp) - - (event-process selection-notify null) - - bug fix and typo in gestures.lisp - - bug fix in ewmh implementation. - - ... + - error handling at start up. + - close-sm-connection (widget.lisp) + - (event-process selection-notify null) + - bug fix and typo in gestures.lisp + - bug fix in ewmh implementation. + - ... O.10 => 0.11 + - Daniel's Barlow feedbacks implemented: + eclipse has now a new keyword parmeter: :die-on-init-error that is + used in the starting script. If nil then error during init will + drop in the debugger allowing you to debug nicely without any + "extra" hacking. If T then it will catch ini errors and quit. + + - Luca Capello Patch applied: When compiled without dumping an + image file, the way eclipse is started wasn't up to + date. (latest options of eclipse:eclipse was not handled by + the start function). + + - compile.lisp has been removed. Compilation/Load operations are + defined in eclipse/system.lisp. + + - system(s).lisp files now handles asdsf system description as + well as mk-defsystem. Both system are created if both package + present in the lisp environment. + + - added an asdf:operate :around overload for sbcl to avoid + compilation warnings relatives to structured constant + redefinition that break the compilation and drop the user into + the debuger. + + - six new configure options added: + + --with-load-switch : to indicate the command line argument of + the lisp machine for loading a file. + + + --with-eval-switch : to indicate the command line argument of + the lisp machine for evaluating forms. + + + --with-core-switch : to indicate the command line argument of + the lisp machine to start it with an alternative image. + + + --with-save-lisp : to indicate the function name for saving + a lisp image. + + + --with-quit-form : to indicate a particular quit form. + + + --with-lisp-system : to indicate the name (the same as the + one that is present in *features*) of the lisp system you + want to use in case we know it (currently sbcl and cmu are + known). Use this option if you have a lisp system we know but + its executable is not named as expected (lisp for cmucl and + sbcl for sbcl for instance). + + - eclipse: new option --activate-log + + - change in the movement handlers that allow undecorated windows + (xmms for example) to moved through mouse strokes or menu. + (input.lisp gestures.lisp move-resize.lisp wm.lisp) + + - group of windows (such as described in the ICCCM) are now honored: + transient-for windows are supposed to be stack under their + dialogs. As another effect, iconifying or sending to another + desktop one window of a group affect the entire group. + + - a new option is now available: + *save-and-restore-pointer-position-during-workspace-switch* + that allows to save pointer position before switching from a + desktop to another and restore previous position when arriving on + the new one. (misc.lisp virtual-screen.lisp) This has been done via + a private property on the root window named: + _ECLIPSE_DESKTOP_POINTER_POSITIONS + + - Update NETWM support: according to 1.4 draft2, note that + nothing has been done for the compositing manager selction + owning, since this is a complete process to be handled rather + than just a property ... + + _NET_MOVERESIZE_WINDOW client message is now supported. + + _NET_WM_STATE_STICKY is now supported. (is it correct since + Eclipse does not implements area's ?) + + an ECLIPSE-EXTENSIONS package is defined in order to export + all symbols provides by future Eclipse extensions. + + Removed useless property-manager-window from the root + object. Instead standard-property-holder class is defined in + widgets.lisp. + + - man page, compliance updated. - - - - - - - - - - - - + - enhancements: + - enhancement in the focus gestion (input.lisp) to be more + ICCCM complient. + - added error output when die-on-init-error is T (eclipse.lisp) + - start function has been removed from start-eclipse.lisp.in + configure.in updated. + + - documentation generally updated. + + - bug fix, code clean up and hacking: + - Fix: (setf window-priority) + - Fix: dead windows during window cycling (gestures.lisp) + - gestures.lisp: macrologie simplified (may need a few lines + of doc). + - Fix: window placement (wm.lisp) decoration where incorrectly + placed when user indicates its preferences (via the + wm_normal_hints property) + - minor changes in destroy-notify handling on decoration. + - Fix: theme default value for title bar position. + - Fix: hardcoded boole function value in draw-window-grid. It + now use the appropriated constant. + - %resize% => resize-internal + - Fix: event-mask wrong value: nil isn't an window-event-mask. + (virtual-screen.lisp) + - Fix: circulate-window keystroke: all modifiers keycodes were + not took in account. + - Fix: lib/clx-ext/keysyms.lisp: multiple-value-list surrounding + xlib:keysym->keycodes was missing. + - Fix sbcl issues with unicode and with-open-file. + - Fix bug in with-combo-realizer. Strokes were systematically + removed from the hash table. + - Fix: the settings of all the net-wm spec root properties is + now surrounded with a with-server-grabbed to avoid tones of + property change event on the root window. + - Fix: _net_wm_state_maximized were improperly handled when an + application is newly decorated. + - recomputation of the application geometry before + maximization when the wm-size-hints property is changed. + - Fix: handling of the _net_wm_state_maximized in configure-window + (misc.lisp) + - configure-window when configuring panel window should honor + size without guessing anything (misc.lisp). + - _net_wm__state property update before put an application in + fullscreen to avoid race conditions. (widgets.lisp) + - Fix: map-request race condition (input.lisp & widgets.lisp) + - application-panel-p predicate (widgets.lisp) + - Fix: initial-coordinates to work the with net-workarea + property. + - Fix: netwm-user-time usage, and some withdrawal glitches. + - Fix: the max sizes were not properly computed. + - screen-window-layer computation when the window doesn't have + any workspace number associated with. + - Fix: make-viewport-property has only one viewport since we + don't handled multiple viewport. + - Fix: improper variable usage in defsetf. So in order to avoid + glitches set-.. created, and defsetf calls it. + - Fix: window->rectangle transformation is now correct. + - Fix: rectangle->width/heigth computation is now correct. + - Fix: netwm-struts was used as coordinates rather than sizes. + - sub-rectangles computation now returns rectangles that does + not overlap anymore + - Fix: 'unix' type handling in the SESSION_MANAGER scheme in + ICE-lib.lisp + - Fix: ice & SM system load whan not loaded from the eclipse + directory. --- /project/eclipse/cvsroot/eclipse/docs/eclipse.1 2004/02/12 23:30:23 1.15 +++ /project/eclipse/cvsroot/eclipse/docs/eclipse.1 2008/04/24 15:29:15 1.16 @@ -1,12 +1,12 @@ .TH Eclipse 1 "(c) 2001 Iban HATCHONDO" -.\"$Id: eclipse.1,v 1.15 2004/02/12 23:30:23 ihatchondo Exp $ +.\"$Id: eclipse.1,v 1.16 2008/04/24 15:29:15 ihatchondo Exp $ .SH NAME eclipse - a window manager in Common Lisp .SH SYNOPSIS -.B eclipse [ --display=display_specification --sm-client-id=id ] +\fB eclipse \fP[ OPTIONS ] .SH DESCRIPTION @@ -70,9 +70,16 @@ .SH OPTIONS -\fIeclipse\fP accepts one argument. This argument allows you to -specify a particular display connection. To use this argument give it -as the DISPLAY environment variable. Use eclipse gandalf:2.0 for example +.TP +\fB--display\fP=display_specification +starts eclipse for managing the given X display. +.TP +\fB--sm-client-id\fP=ID +specify a session management ID. +.TP +\fB--activate-log\fP +specifies that errors must be logged in a file. The log file will be +named as follows: eclipse-YYYY-MM-DD.log .SH MENUS

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 24 Apr '08

24 Apr '08

Update of /project/eclipse/cvsroot/eclipse In directory clnet:/tmp/cvs-serv4432 Modified Files: widgets.lisp rectangles.lisp Log Message: Fix: - rectangles: window->rectangle transformation is now correct. rectangle->width/heigth computation is now correct. netwm-struts usage was partially incorrect and has been fixed. sub-rectangles computation now returns rectangles that does not overlap anymore - widgets: find-max-geometry updated according to changes in the rectangle api. --- /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/23 15:16:32 1.52 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/24 08:24:45 1.53 @@ -1,5 +1,5 @@ ;;; -*- 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 @@ -292,26 +292,27 @@ ;; Maximization helpers. (defun find-max-geometry (application direction fill-p &key x y w h) - (multiple-value-bind (ulx uly lrx lry) - (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))) + (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)))) (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 (- lrx ulx hm) basew incw minw maxw))) - (hh (or h (check-size (- lry uly vm) baseh inch minh maxh)))) - (when (> (+ ww hm) (- lrx ulx)) (decf ww incw)) - (when (> (+ hh vm) (- lry uly)) (decf hh inch)) - (make-geometry :w ww :h hh :x (or x ulx) :y (or y uly)))))))) + (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) --- /project/eclipse/cvsroot/eclipse/rectangles.lisp 2008/04/23 15:12:40 1.6 +++ /project/eclipse/cvsroot/eclipse/rectangles.lisp 2008/04/24 08:24:45 1.7 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: rectangles.lisp,v 1.6 2008/04/23 15:12:40 ihatchondo Exp $ +;;; $Id: rectangles.lisp,v 1.7 2008/04/24 08:24:45 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2003 Iban HATCHONDO @@ -36,17 +36,25 @@ "Compute the area of a rectangle. The value NIL represents an empty rectangle" (if (null rectangle) 0 (multiple-value-bind (ulx uly lrx lry) (rectangle-coordinates rectangle) - (* (- lrx ulx) (- lry uly))))) + (* (1+ (- lrx ulx)) (1+ (- lry uly)))))) (declaim (inline rectangle-width)) (defun rectangle-width (rect) "Returns the width of a rectangle." - (if (null rect) 0 (- (rectangle-lrx rect) (rectangle-ulx rect)))) + (if (null rect) 0 (1+ (- (rectangle-lrx rect) (rectangle-ulx rect))))) (declaim (inline rectangle-height)) (defun rectangle-height (rect) "Returns the height of a rectangle." - (if (null rect) 0 (- (rectangle-lry rect) (rectangle-uly rect)))) + (if (null rect) 0 (1+ (- (rectangle-lry rect) (rectangle-uly rect))))) + +(declaim (inline rectangle-height)) +(defun rectangle-geometry (rect) + "Returns the x y width and height of a rectangle as a multiple value." + (if (null rect) + (values 0 0 0 0) + (multiple-value-bind (ulx uly lrx lry) (rectangle-coordinates rect) + (values ulx uly (1+ (- lrx ulx)) (1+ (- lry uly)))))) (defun rectangle-surface< (rectangle1 rectangle2) (< (rectangle-surface rectangle1) (rectangle-surface rectangle2))) @@ -72,16 +80,16 @@ (declare (type (signed-byte 16) ulx1 uly1 lrx1 lry1)) (multiple-value-bind (ulx2 uly2 lrx2 lry2) (rectangle-coordinates inside) (declare (type (signed-byte 16) ulx2 uly2 lrx2 lry2)) - (let ((seq (list))) - (when (< uly1 uly2) ; defines the north sub rectangle. - (push (make-rectangle :ulx ulx1 :uly uly1 :lrx lrx1 :lry uly2) seq)) - (when (< ulx1 ulx2) ; defines the west sub rectangle. - (push (make-rectangle :ulx ulx1 :uly uly1 :lrx ulx2 :lry lry1) seq)) - (when (< lry2 lry1) ; defines the south sub rectangle. - (push (make-rectangle :ulx ulx1 :uly lry2 :lrx lrx1 :lry lry1) seq)) - (when (< lrx2 lrx1) ; defines the east sub rectangle. - (push (make-rectangle :ulx lrx2 :uly uly1 :lrx lrx1 :lry lry1) seq)) - (stable-sort seq #'rectangle-surface>=))))) + (let ((l (list))) + (when (< uly1 (1- uly2)) ; defines the north sub rectangle. + (push (make-rectangle :ulx ulx1 :uly uly1 :lrx lrx1 :lry (1- uly2)) l)) + (when (< ulx1 (1- ulx2)) ; defines the west sub rectangle. + (push (make-rectangle :ulx ulx1 :uly uly1 :lrx (1- ulx2) :lry lry1) l)) + (when (< (1+ lry2) lry1) ; defines the south sub rectangle. + (push (make-rectangle :ulx ulx1 :uly (1+ lry2) :lrx lrx1 :lry lry1) l)) + (when (< (1+ lrx2) lrx1) ; defines the east sub rectangle. + (push (make-rectangle :ulx (1+ lrx2) :uly uly1 :lrx lrx1 :lry lry1) l)) + (stable-sort l #'rectangle-surface>=))))) (defun overlap-p (rect1 rect2) "Returns true if rectangle1 intersects rectangle2." @@ -131,25 +139,27 @@ (defun window->rectangle (window) "Returns the rectangle that represent this window." (multiple-value-bind (x y w h) (window-geometry window) - (make-rectangle :ulx x :uly y :lrx (+ x w) :lry (+ y h)))) + (make-rectangle :ulx x :uly y :lrx (+ x (1- w)) :lry (+ y (1- h))))) + +(defun window->rectangle-coordinates (window) + "Returns the rectangle coordinates that represent this window." + (multiple-value-bind (x y w h) (window-geometry window) + (values x y (+ x (1- w)) (+ y (1- h))))) (defun compute-screen-rectangles (application &optional filter-overlap-p) "Gets screen content according to desktop number and filter all windows that are overlaped by the given one except if filter-overlap-p is NIL. Returns a list of rectangles that represent all the founded windows." (with-slots (window master) application - (multiple-value-bind (xx yy ww hh) - (window-geometry (if master (widget-window master) window)) + (let ((rect (window->rectangle (if master (widget-window master) window)))) (flet ((predicate (win n icon taskbar desktop dock) (cond ((xlib:window-equal window win) nil) ((window-belongs-to-vscreen-p win n icon taskbar desktop dock) (not (and filter-overlap-p - (multiple-value-bind (x y w h) - (with-slots ((m master)) (lookup-widget win) - (window-geometry (if m (widget-window m) win))) - (and (< xx (+ x w)) (< x (+ xx ww)) - (< yy (+ y h)) (< y (+ yy hh))))))) + (with-slots ((m master)) (lookup-widget win) + (let ((win2 (if m (widget-window m) win))) + (overlap-p rect (window->rectangle win2))))))) (t (window-panel-p win n icon))))) (mapcar (lambda (win) @@ -165,7 +175,9 @@ (lambda (win) (multiple-value-bind (l r to b lsy ley rsy rey tsx tex bsx bex) (netwm:net-wm-strut-partial win) - (multiple-value-bind (w h) (drawable-sizes (xlib:drawable-root win)) + (multiple-value-bind (x y w h) + (window->rectangle-coordinates (xlib:drawable-root win)) + (declare (ignorable x y)) (unless l (multiple-value-setq (l r to b) (netwm:net-wm-strut win)) (multiple-value-setq (lsy ley rsy rey tsx tex bsx bex) @@ -173,10 +185,14 @@ (unless (and l r to b) (setf (values l r to b) (values 0 0 0 0)))) (cond - ((/= 0 l) (make-rectangle :ulx 0 :uly lsy :lrx l :lry ley)) - ((/= 0 r) (make-rectangle :ulx (- w r) :uly rsy :lrx w :lry rey)) - ((/= 0 to) (make-rectangle :ulx tsx :uly 0 :lrx tex :lry to)) - ((/= 0 b) (make-rectangle :ulx bsx :uly (- h b) :lrx bex :lry h)) + ((/= 0 l) + (make-rectangle :ulx 0 :uly lsy :lrx (1- l) :lry ley)) + ((/= 0 r) + (make-rectangle :ulx (- w (1- r)) :uly rsy :lrx w :lry rey)) + ((/= 0 to) + (make-rectangle :ulx tsx :uly 0 :lrx tex :lry (1- to))) + ((/= 0 b) + (make-rectangle :ulx bsx :uly (- h (1- b)) :lrx bex :lry h)) (t (window->rectangle win)))))) (screen-content scr-num :predicate predicate))) @@ -210,7 +226,8 @@ - :direction (or :vertical :horizontal :both) to indicate wat kind of region the search should be looking for." (with-slots (window (m master)) application - (multiple-value-bind (w h) (drawable-sizes (xlib:drawable-root window)) + (multiple-value-bind (x y w h) + (window->rectangle-coordinates (xlib:drawable-root window)) (let ((app-rect (window->rectangle (if m (widget-window m) window))) (rectangles (find-empty-rectangles (make-rectangle :lrx w :lry h) @@ -224,18 +241,16 @@ (:vertical #'rectangle-height>=) (t #'rectangle-surface>=))))) ;; clip the application window rectangle to fit in the root one. - (when (< (rectangle-ulx app-rect) 0) (setf (rectangle-ulx app-rect) 0)) - (when (< (rectangle-uly app-rect) 0) (setf (rectangle-uly app-rect) 0)) + (when (< (rectangle-ulx app-rect) x) (setf (rectangle-ulx app-rect) x)) + (when (< (rectangle-uly app-rect) y) (setf (rectangle-uly app-rect) y)) (when (> (rectangle-lrx app-rect) w) (setf (rectangle-lrx app-rect) w)) (when (> (rectangle-lry app-rect) h) (setf (rectangle-lry app-rect) h)) ;; returns the appropriated area. - (multiple-value-call #'values - (if rectangles - (rectangle-coordinates - (if area-include-me-p - (loop for r in rectangles + (values + (cond ((and rectangles area-include-me-p) + (loop for r in rectangles when (include-p r app-rect) do (return r) - finally (return (car rectangles))) - (car rectangles))) - (values 0 0 w h)) - (if rectangles T NIL)))))) + finally (return (car rectangles)))) + (rectangles (car rectangles)) + (t (window->rectangle (xlib:drawable-root window)))) + (if rectangles T NIL))))))

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 23 Apr '08

23 Apr '08

Update of /project/eclipse/cvsroot/eclipse In directory clnet:/tmp/cvs-serv26700 Modified Files: widgets.lisp Log Message: Fix: improper variable usage in defsetf. So in order to avoid glitches set-.. created, and defsetf calls it. --- /project/eclipse/cvsroot/eclipse/widgets.lisp 2007/11/02 09:33:08 1.51 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/23 15:16:32 1.52 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.51 2007/11/02 09:33:08 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.52 2008/04/23 15:16:32 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -377,43 +377,46 @@ (defsetf fullscreen-mode (application) (mode) "Mode may be (or :on :off). Put or remove application in or from fullscreen." - `(with-slots (window (fgeometry full-geometry) master icon) ,application - ;; reset appropriately _net_wm_state property. - (let ((prop (netwm:net-wm-state window))) - (if (eq ,mode :on) - (pushnew :_net_wm_state_fullscreen prop) - (setf prop (delete :_net_wm_state_fullscreen prop))) - (setf (netwm:net-wm-state window) prop)) - (if (eq ,mode :on) - ;; put in fullscreen mode. - (with-event-mask (*root-window*) - (multiple-value-bind (x y w h) (window-geometry window) - (when master - (with-slots (children (master-win window) frame-style) master - (multiple-value-setq (x y) (window-position master-win)) - (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*))) - (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))) - (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*) - (setf (drawable-sizes window) (geometry-sizes fgeometry)) - (unless (window-not-decorable-p window) - (setf (decoration-frame-style master) - (slot-value master 'old-frame-style))) - (multiple-value-bind (x y) (geometry-coordinates fgeometry) - (with-slots (window) (or master ,application) - (configure-window window :x x :y y))))))) + `(set-fullscreen-mode ,application ,mode)) + +(defun set-fullscreen-mode (application mode) + (with-slots (window (fgeometry full-geometry) master icon) application + ;; reset appropriately _net_wm_state property. + (let ((prop (netwm:net-wm-state window))) + (if (eq mode :on) + (pushnew :_net_wm_state_fullscreen prop) + (setf prop (delete :_net_wm_state_fullscreen prop))) + (setf (netwm:net-wm-state window) prop)) + (if (eq mode :on) + ;; put in fullscreen mode. + (with-event-mask (*root-window*) + (multiple-value-bind (x y w h) (window-geometry window) + (when master + (with-slots (children (master-win window) frame-style) master + (multiple-value-setq (x y) (window-position master-win)) + (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*))) + (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))) + (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*) + (setf (drawable-sizes window) (geometry-sizes fgeometry)) + (unless (window-not-decorable-p window) + (setf (decoration-frame-style master) + (slot-value master 'old-frame-style))) + (multiple-value-bind (x y) (geometry-coordinates fgeometry) + (with-slots (window) (or master application) + (configure-window window :x x :y y))))))) (defun application-leader (application) "Returns the \"leader\" of an application. The leader is computed

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 23 Apr '08

23 Apr '08

Update of /project/eclipse/cvsroot/eclipse In directory clnet:/tmp/cvs-serv26372 Modified Files: rectangles.lisp Log Message: Fix: improper area returnes when no area includes the desired window. --- /project/eclipse/cvsroot/eclipse/rectangles.lisp 2007/05/08 22:30:47 1.5 +++ /project/eclipse/cvsroot/eclipse/rectangles.lisp 2008/04/23 15:12:40 1.6 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: rectangles.lisp,v 1.5 2007/05/08 22:30:47 ihatchondo Exp $ +;;; $Id: rectangles.lisp,v 1.6 2008/04/23 15:12:40 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2003 Iban HATCHONDO @@ -93,7 +93,7 @@ (and (< ulx1 lrx2) (< ulx2 lrx1) (< uly1 lry2) (< uly2 lry1))))) (defun include-p (rect1 rect2) - "Return true if rectangle1 is included in rectangle2." + "Return true if rectangle2 is included in rectangle1." (declare (optimize (speed 3) (safety 0))) (multiple-value-bind (ulx1 uly1 lrx1 lry1) (rectangle-coordinates rect1) (declare (type (signed-byte 16) ulx1 uly1 lrx1 lry1)) @@ -233,8 +233,9 @@ (if rectangles (rectangle-coordinates (if area-include-me-p - (loop for r in rectangles until (include-p r app-rect) - finally (return r)) + (loop for r in rectangles + when (include-p r app-rect) do (return r) + finally (return (car rectangles))) (car rectangles))) (values 0 0 w h)) (if rectangles T NIL))))))

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 23 Apr '08

23 Apr '08

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))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

eclipse-cvs April 2008