- eclipse-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[Eclipse-cvs] CVS update: eclipse/virtual-screen.lisp
by Iban Hatchondo 09 Oct '03

09 Oct '03

Update of /project/eclipse/cvsroot/eclipse In directory common-lisp.net:/tmp/cvs-serv23033 Modified Files: virtual-screen.lisp Log Message: added missing test in window-belongs-to-vscreen-p: the window should be in our cache. Date: Thu Oct 9 07:39:42 2003 Author: ihatchondo Index: eclipse/virtual-screen.lisp diff -u eclipse/virtual-screen.lisp:1.9 eclipse/virtual-screen.lisp:1.10 --- eclipse/virtual-screen.lisp:1.9 Mon Oct 6 13:57:26 2003 +++ eclipse/virtual-screen.lisp Thu Oct 9 07:39:41 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: virtual-screen.lisp,v 1.9 2003/10/06 17:57:26 ihatchondo Exp $ +;;; $Id: virtual-screen.lisp,v 1.10 2003/10/09 11:39:41 ihatchondo Exp $ ;;; ;;; Copyright (C) 2002 Iban HATCHONDO ;;; contact : hatchond(a)yahoo.fr @@ -23,16 +23,17 @@ ;;;; Private -(defun window-belongs-to-vscreen-p (window scr-num iconify-p) - (let ((n (or (window-desktop-num window) -1)) - (wm-state (car (wm-state window))) - (netwm-type (netwm:net-wm-window-type window))) - (and (or (= n scr-num) (= n +any-desktop+)) - (or (eq wm-state 1) (and iconify-p (eq wm-state 3))) - (not (member :win_hints_skip_taskbar (gnome:win-hints window))) - (not (member :_net_wm_state_skip_taskbar (netwm:net-wm-state window))) - (not (member :_net_wm_window_type_desktop netwm-type)) - (not (member :_net_wm_window_type_dock netwm-type))))) +(defun window-belongs-to-vscreen-p (win scr-num iconify-p) + (when (lookup-widget win) + (let ((n (or (window-desktop-num win) -1)) + (wm-state (car (wm-state win))) + (netwm-type (netwm:net-wm-window-type win))) + (and (or (= n scr-num) (= n +any-desktop+)) + (or (eq wm-state 1) (and iconify-p (eq wm-state 3))) + (not (member :win_hints_skip_taskbar (gnome:win-hints win))) + (not (member :_net_wm_state_skip_taskbar (netwm:net-wm-state win))) + (not (member :_net_wm_window_type_desktop netwm-type)) + (not (member :_net_wm_window_type_dock netwm-type)))))) (defun map-or-unmap-vscreen (fun scr-num) (loop for widget being each hash-value in *widget-table*

1 0

[Eclipse-cvs] CVS update: eclipse/input.lisp
by Iban Hatchondo 09 Oct '03

09 Oct '03

Update of /project/eclipse/cvsroot/eclipse In directory common-lisp.net:/tmp/cvs-serv22610 Modified Files: input.lisp Log Message: minor change in undecore-application and the handling of configure-notify. Date: Thu Oct 9 07:38:18 2003 Author: ihatchondo Index: eclipse/input.lisp diff -u eclipse/input.lisp:1.18 eclipse/input.lisp:1.19 --- eclipse/input.lisp:1.18 Mon Oct 6 13:57:26 2003 +++ eclipse/input.lisp Thu Oct 9 07:38:18 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: input.lisp,v 1.18 2003/10/06 17:57:26 ihatchondo Exp $ +;;; $Id: input.lisp,v 1.19 2003/10/09 11:38:18 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -75,7 +75,8 @@ ;; Acording to the ICCCM we should send a synthetic configure-notify, ;; when we move a window but without resizing it. (unless (or (logbitp 2 value-mask) (logbitp 3 value-mask)) - (send-configuration-notify window)) + (when (application-p (lookup-widget window)) + (send-configuration-notify window))) )) (defmethod event-process :after ((event destroy-notify) (widget base-widget)) @@ -222,12 +223,13 @@ (when (application-p (lookup-widget (event-window event))) (with-slots ((master-win event-window) (app-window window) x y) event (with-slots (left-margin top-margin) (decoration-frame-style master) - (multiple-value-bind (old-x old-y) (window-position app-window) - (when (eql (decoration-application-gravity master) :static) - (decf x left-margin) (decf y top-margin)) - (unless (= old-x left-margin) (setf (xlib:drawable-x master-win) x)) - (unless (= old-y top-margin) (setf (xlib:drawable-y master-win) y))) - (resize-from (lookup-widget app-window)) + (if (eql (decoration-application-gravity master) :static) + (setf (window-position master-win) (values (- x left-margin) + (- y top-margin))) + (multiple-value-bind (ax ay) (window-position app-window) + (unless (= ax left-margin) (setf (xlib:drawable-x master-win) x)) + (unless (= ay top-margin) (setf (xlib:drawable-y master-win) y)))) + (resize-from (lookup-widget app-window)) (with-event-mask (master-win) (update-edges-geometry master) (setf (window-position app-window) (values left-margin top-margin))

1 0

[Eclipse-cvs] CVS update: eclipse/widgets.lisp eclipse/wm.lisp
by Iban Hatchondo 09 Oct '03

09 Oct '03

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 :

1 0

[Eclipse-cvs] CVS update: eclipse/move-resize.lisp eclipse/global.lisp
by Iban Hatchondo 09 Oct '03

09 Oct '03

Update of /project/eclipse/cvsroot/eclipse In directory common-lisp.net:/tmp/cvs-serv21678 Modified Files: move-resize.lisp global.lisp Log Message: - The screen edges resistance is implemented. To configure it use *screen-edge-resistant-p*. Set it to nil if you don't want to feel any resistance when attempting to move a window outside the screen boundaries. Default value is t. - The window edges resistance is also implemented. To configure it use *standard-window-edge-resistant-p*. Set it to nil if you don't want to feel any resistance on edges of window(s) you are about to overlap. Default value is t. Date: Thu Oct 9 07:36:18 2003 Author: ihatchondo Index: eclipse/move-resize.lisp diff -u eclipse/move-resize.lisp:1.6 eclipse/move-resize.lisp:1.7 --- eclipse/move-resize.lisp:1.6 Mon Oct 6 13:57:26 2003 +++ eclipse/move-resize.lisp Thu Oct 9 07:36:18 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: move-resize.lisp,v 1.6 2003/10/06 17:57:26 ihatchondo Exp $ +;;; $Id: move-resize.lisp,v 1.7 2003/10/09 11:36:18 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -278,12 +278,88 @@ (setf *card-point* nil)) ;;;; Move. - + +(defvar *screen-windows* nil) + +(defun region-intersect-region-p (x y w h x2 y2 w2 h2) + "Returns true if the rectangular regions, described by the two four-uple + `x y w h', have a not empty intersection." + (declare (optimize (speed 3) (safety 0))) + (declare (type (signed-byte 16) x y x2 y2)) + (declare (type (unsigned-byte 16) w h w2 h2)) + (or (and (<= x (+ x2 w2)) (<= x2 (+ x w)) (<= y (+ y2 h2)) (<= y2 (+ y h))) + (and (<= x2 (+ x w)) (<= x (+ x2 w2)) (<= y2 (+ y h)) (<= y (+ y2 h2))))) + +(defun region-intersect-window-in-screen (x y w h &rest windows-to-skip) + "Returns a window list that has an intersection with the given region + (defines by the four-uple `x y w h'). The windows-to-skip argument is + a list of window that should not be used." + (declare (optimize (speed 3) (safety 0))) + (declare (type (signed-byte 16) x y)) + (declare (inline region-intersect-region-p)) + (declare (type (unsigned-byte 16) w h)) + (loop for win in *screen-windows* + for master = (application-master (lookup-widget win)) + when master do (setf win (widget-window master)) end + when (and (not (member win windows-to-skip :test #'xlib:window-equal)) + (multiple-value-bind (x2 y2 w2 h2) (window-geometry win) + (declare (type (signed-byte 16) x2 y2)) + (declare (type (unsigned-byte 16) w2 h2)) + (region-intersect-region-p x y w h x2 y2 w2 h2))) + collect win)) + +(defun perform-dock (window x y) + "Returns the new coordinates of the window if it needs do be docked on + one or two window present on that desktop. Otherwise x and y will be + returned. Arguments x, y represent the hypotheticals future coordinates." + (declare (optimize (speed 3) (safety 0))) + (declare (type (signed-byte 16) x y)) + (multiple-value-bind (x1 y1 w1 h1) (window-geometry window) + (declare (type (signed-byte 16) x1 y1)) + (declare (type (unsigned-byte 16) w1 h1)) + (loop with x-already-set-p and y-already-set-p + for win in (region-intersect-window-in-screen x y w1 h1 window) + do (multiple-value-bind (x2 y2 w2 h2) (window-geometry win) + (declare (type (signed-byte 16) x2 y2)) + (declare (type (unsigned-byte 16) w2 h2)) + (unless x-already-set-p + (cond ((and (<= (+ x1 w1) x2) (<= -40 (- x2 x w1) 0)) + (setf x (- x2 w1)) (setf x-already-set-p t)) + ((and (>= x1 (+ x2 w2)) (<= -40 (- x x2 w2) 0)) + (setf x (+ x2 w2)) (setf x-already-set-p t)))) + (unless y-already-set-p + (cond ((and (>= y1 (+ y2 h2)) (<= -40 (- y y2 h2) 0)) + (setf y (+ y2 h2)) (setf y-already-set-p t)) + ((and (<= (+ y1 h1) y2) (<= -40 (- y2 y h1) 0)) + (setf y (- y2 h1)) (setf y-already-set-p t))))) + when (and x-already-set-p y-already-set-p) do (loop-finish) + finally (return (values x y))))) + +(defun perform-root-dock (window x y) + "Returns the new coordinates of the window if it needs do be docked + on the root window. Otherwise x and y will be returned. + Arguments x, y represent the hypotheticals future coordinates." + (declare (optimize (speed 3) (safety 0))) + (declare (type (signed-byte 16) x y)) + (multiple-value-bind (x1 y1 w1 h1) (window-geometry window) + (declare (type (signed-byte 16) x1 y1)) + (declare (type (unsigned-byte 16) w1 h1)) + (and (>= x1 0) (< -40 x 0) (setf x 0)) + (and (>= y1 0) (< -40 y 0) (setf y 0)) + (let ((scr-w (screen-width)) (scr-h (screen-height))) + (declare (type (unsigned-byte 16) scr-w scr-h)) + (and (>= (- scr-w x1 w1) 0) (< -40 (- scr-w x w1) 0) + (setf x (- scr-w w1))) + (and (>= (- scr-h y1 h1) 0) (< -40 (- scr-h y h1) 0) + (setf y (- scr-h h1))))) + (values x y)) + (defmethod initialize-move ((widget base-widget) (event button-press)) "Initialize internal values for animating the future widget movements." (with-slots (window active-p) widget (setf (window-priority window) :above) (setf active-p t + *screen-windows* (get-screen-content (current-desk)) *delta-x* (- (event-root-x event) (xlib:drawable-x window)) *delta-y* (- (event-root-y event) (xlib:drawable-y window))))) @@ -291,27 +367,24 @@ (let ((app-window (get-child master :application :window t))) (when (or (member :win_state_fixed_position (gnome:win-state app-window)) (member :_net_wm_state_sticky (netwm:net-wm-state app-window))) - (setf (decoration-active-p master) nil)))) + (setf (decoration-active-p master) nil + *screen-windows* nil)))) (defun move-widget (widget event &optional verbose-p mode) (declare (optimize (speed 3) (safety 0))) (with-slots (window active-p gcontext) widget (when active-p (let ((new-x (- (the (signed-byte 16) (event-root-x event)) *delta-x*)) - (new-y (- (the (signed-byte 16) (event-root-y event)) *delta-y*)) - (scr-w (screen-width)) (scr-h (screen-height))) + (new-y (- (the (signed-byte 16) (event-root-y event)) *delta-y*))) (declare (type (signed-byte 16) new-x new-y)) - (declare (type (unsigned-byte 16) scr-w scr-h)) - (multiple-value-bind (x y w h) - (window-geometry (if (eq mode :box) (widget-window *clone*) window)) - (declare (type (signed-byte 16) x y)) - (declare (type (unsigned-byte 16) w h)) - (when (and (>= x 0) (< -40 new-x 0)) (setf new-x 0)) - (when (and (>= y 0) (< -40 new-y 0)) (setf new-y 0)) - (when (and (>= (- scr-w x w) 0) (< -40 (- scr-w new-x w) 0)) - (setf new-x (- scr-w w))) - (when (and (>= (- scr-h y h) 0) (< -40 (- scr-h new-y h) 0)) - (setf new-y (- scr-h h)))) + (let ((aux (if (eq mode :box) (widget-window *clone*) window))) + (declare (inline perform-dock perform-root-dock)) + (when *standard-window-edge-resistant-p* + (multiple-value-setq (new-x new-y) + (perform-dock aux new-x new-y))) + (when *screen-edge-resistant-p* + (multiple-value-setq (new-x new-y) + (perform-root-dock aux new-x new-y)))) (when verbose-p (display-coordinates new-x new-y)) (if (and (decoration-p widget) (eql mode :box)) (with-slots (window) *clone* @@ -331,4 +404,5 @@ (when (get-child master :title-bar) (with-slots (armed active-p) (get-child master :title-bar) (setf armed nil active-p nil))) - (send-configuration-notify (get-child master :application :window t))) + (send-configuration-notify (get-child master :application :window t)) + (setf *screen-windows* nil)) Index: eclipse/global.lisp diff -u eclipse/global.lisp:1.12 eclipse/global.lisp:1.13 --- eclipse/global.lisp:1.12 Mon Oct 6 13:57:26 2003 +++ eclipse/global.lisp Thu Oct 9 07:36:18 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: global.lisp,v 1.12 2003/10/06 17:57:26 ihatchondo Exp $ +;;; $Id: global.lisp,v 1.13 2003/10/09 11:36:18 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2001, 2002 Iban HATCHONDO @@ -66,6 +66,8 @@ (defparameter *cycle-icons-p* t "Alt-Tab shows or not iconified windows.") (defparameter *focus-new-mapped-window* t) (defparameter *focus-when-window-cycle* t) +(defparameter *screen-edge-resistant-p* t) +(defparameter *standard-window-edge-resistant-p* t) (defparameter *double-click-speed* 200 "the speed of the double click") (defparameter *move-mode* :opaque "values are: :box :opaque") (defparameter *resize-mode* :opaque "values are: :box :opaque")

1 0

[Eclipse-cvs] CVS update: eclipse/docs/changelog eclipse/docs/eclipse.1
by Iban Hatchondo 06 Oct '03

06 Oct '03

Update of /project/eclipse/cvsroot/eclipse/docs In directory common-lisp.net:/tmp/cvs-serv32136/docs Modified Files: changelog eclipse.1 Log Message: - Window rotation (Alt-Tab) re-designed. It now works as in almost every window managers. Press Alt-Tab once will raise the next application, on the current desktop, according to the current stacking order. If Alt is released then pressing again Alt-Tab will put back the precedent application. Otherwise if you kipped Alt down then Tab again and the next application will be brought on top of the others, and the precedent one is back on its depth. And so on until you come back on the first one. The same mechanism is available with say Alt-a. It just rotate windows on the other sens. - The window rotation may be verbose by displaying a small window indicating the name and the icon, if provided, of the application that comes on top of the others. To disable it do (setf *verbose-window-cycling* nil) in your eclipse config file. - The window rotation may also cycle the current desktop iconified applications. To disable it do (setf *cycle-icons-p* nil) in your eclipse config file. - Screen edges are now resistant. - fix menu bug. They don't anymore appear below their applications. - a maximized window does not allow anymore to be resized in the directions in which it has been maximized. - the message-box may now display a centered pixmap before the text. - package.lisp updated. - man page updated. - changelog updated. Date: Mon Oct 6 13:57:27 2003 Author: ihatchondo Index: eclipse/docs/changelog diff -u eclipse/docs/changelog:1.4 eclipse/docs/changelog:1.5 --- eclipse/docs/changelog:1.4 Thu Nov 7 09:54:27 2002 +++ eclipse/docs/changelog Mon Oct 6 13:57:27 2003 @@ -1,5 +1,5 @@ -*- Mode: ChangeLog -*- -$Id: changelog,v 1.4 2002/11/07 14:54:27 hatchond Exp $ +$Id: changelog,v 1.5 2003/10/06 17:57:27 ihatchondo Exp $ 0.01 => 0.02 Eclipse should now compile on every ANSI-compliant Common Lisp @@ -54,4 +54,174 @@ - added coordinates display during move and resize. - added opaque resize mode. - new theme interface (needs to be documented). - - some new themes have been added (CoolClean, brushed-metal, Step). \ No newline at end of file + - some new themes have been added (CoolClean, brushed-metal, Step). + +0.03=>0.04 + + - created an eclipse-internals package. + - some bugs fix. + - some functionalities added. + - file splitting to reorganize the project a little: + - wm.lisp and global.lisp had been splitted into: + - widgets.lisp (base-widget, root, application, buttons, ...) + - input.lisp (general event processing) + - gestures.lisp (key-combo, cursor movement) + - eclipse.lisp (Top level functions) + - move-resize (moving and resizing master) + - misc.lisp (...) + - lib/clx-ext/clx-extensions.lisp + - gnome-manager.lisp had been splitted into: + - manager-commons.lisp + - gnome-manager.lisp + - netwm-manager.lisp + - one directory added with one sub-directory: lib and lib/clx-ext + - a new package clx-extensions in lib/clx-ext + - some files had moved: + - image-reader.lisp into lib + - event.lisp ...... into lib/clx-ext + - cursor.lisp ..... ---------------- + - cursordef.lisp .. ---------------- + - keysysms.lisp ... ---------------- + - keysymdef.lisp .. ---------------- + + - commit Christian Lynbech patch: + CMUCL seems to have tighten the handling of certain things so this + patch will do three necessary things: + + - in system.lisp (compile-theme) remove path from :output-file name as + this includes path specs from the input file. + + - in wm.lisp (menu-3-prcess) removes the &allow-other-keys which CMUCL + 18d chokes on (some previous versions seemed more lax, they also + accepted (lambda (&rest) ...) which 18d does not but you have gotten + rid of that). + + - in lib/image-reader.lisp (load-ppm) changes function to use two + streams as there are many things you cannot do on a non-character + string including calling `unread-char'. + +0.04=>0.05 + + - various bug fix. (with-state missing, undecore-application, some + unhandle events during menu-3 loop, ...) + - procede-decoration code is inside an unwind-protect. + - support for focus-new-mapped-window + - support for :_net_wm_state_maximized_{horz/vert}, + and :_net_wm_state_fullscreen. + - fix typo parenthesis, and grid undraw in mouse stroke resize/move. + - more netwm complience improvement (fullscreen, hidden, + icon-name, maximized) + - Christian Lynbech patch for icon managment has been applied. + "It provides an icon box, ie. a configurable place where icons are + stacked. As part of this change, I have changed the default location + of icons from (750,50) to (0,0). If the icon box overflows, icons will + be created ayt (0,0). I have also decreased the default height from 60 + to 20 to minimize the space waste (if the application supplies an + icon, it will of course take precedence). + + The patch allso adds different kinds of sorting options. Icons can be + sorted by creation time (I have added a new slot in the `icon' class) + or name or class (or whatever else you can think of). + + It still needs a few things, such as the possibility of disabling the + icon box and other fill orders than :top-right (ie. filling from the + top right corner of the box)." + + - Unrelated to the icon box thing, the patch also contains a set of + application inspection function (see the end of "misc.lisp"), A + disabling of the expression that removes the "Exit" entry in the root + menu so that you can close Eclipse down and finally a new option, + *close-display-p*, that regulates whether exiting Eclipse also kills + the entire X session (if *close-display-p* is nil, Eclipse will just + exit). + + - ICCCM complience and extended window manager specification complience. + - bugs fix relative to extended wm spec (i.e.: we now should interact + correctly with gnome 2.2) + - added ICCCM session managment complience: we now use/react to the + owning of the WM_S{screen number} selection. see ICCCM 2.8 + +0.05=>0.06 + + - The package now exports almost every symbols. They are sorted in + alphabetical order and type order (class, generic function, + function, ...) + + - An application that does not support to be maximized in fullscreen + don't have the _net_wm_state_fullscreentom present in its + _net_wm_state property anymore. + + - lib/clx-patch.lisp: fixed bug found in input-focus. + + - few new methods: + dispatch-repaint: new method for the repaint protocol. + repaint: the main method of the repaint protocol. + (draw-focused-decoration & draw-unfocused-decoration: removed.) + + - themes are now defined in their own packages. + All theme are updated. + +0.06=>0.07 + + - shade is now implemented (wm.lisp). + To {un}shade a window double click on title bar. + + - *double-click-speed* for user configuration. + use it to customize the time you want for double click. + Default value: 200 (timestamp unit of the X server) + + - added support for the xvidmode extension + (lib/clx-ext/xvidmode.lisp). + + - added support for :net_wm_state_{below, above} + + - various changes in window stacking order manipulation. + (see put-on-top, and put-on-bottom) + + - buttons are now able to display a pixmap that shows its state (e.g: + pressed or not). + + - added support for _net_active_window message + + - various bug fix and improvements: + + - typo fix *wRAp-pointer-when-cycle* => *wARp-pointer-when-cycle* + full-screen-mode => fullscreen-mode + + - changing the focus now cares of the map state of the window it + is supose to gives the focus to. (Should avoid lots of match-error). + Wrong nil timestamp has been fixed. + + - fullscreen-mode should now be correct: the spec say it would be + better to undecore the window when in fullscreen. It does now. + + + - maximize-window signature changes. It now expect an application + instead of a decoration. + => STROKES USING MAXIMIZE-WINDOW SHOULD BE UPDATED. + + - minor changes in update-edges-geometry, and move-resize.lisp. + + - virtual-screen.lisp re-implementation. It now use the X server + data such the root window tree, and window property that hold the + desktop number instead of an internal substructure that has to be + updated each time you destroy, un/iconify, shade, unshade, etc. + + - fix incorect placement of the menu button when the title bar is + vertical. + + - fix handling of message of type :_WIN_WORKSPACE :_NET_CURRENT_DESKTOP. + + - fix the _net_active_window property handling for undecorated windows. + + - fix missplaced handling for message of type _net_close_window. + + - some code clean up (removed some unused code). + + - lots of documentations added almost every where. + +0.07=>0.08 + + + + \ No newline at end of file Index: eclipse/docs/eclipse.1 diff -u eclipse/docs/eclipse.1:1.7 eclipse/docs/eclipse.1:1.8 --- eclipse/docs/eclipse.1:1.7 Wed Oct 1 05:02:53 2003 +++ eclipse/docs/eclipse.1 Mon Oct 6 13:57:27 2003 @@ -1,5 +1,5 @@ .TH Eclipse 1 "(c) 2001 Iban HATCHONDO" -.\"$Id: eclipse.1,v 1.7 2003/10/01 09:02:53 hatchond Exp $ +.\"$Id: eclipse.1,v 1.8 2003/10/06 17:57:27 ihatchondo Exp $ .SH NAME eclipse - a window manager in Common Lisp @@ -144,6 +144,15 @@ If you want to have a small window that presents you the sizes of the window you are resizing set it to \fIt\fP otherwise \fInil\fP. The default value is \fIt\fP. +.TP +.B\-*verbose-window-cycling*\ \fIboolean\fP +During window rotation, if set to \fIt\fP eclipse will display, in a +small window, the name of the focus window and its icon if +exist. Default value is \fIt\fP. +.TP +.B\-*cycle-icons-p*\ \fIboolean\fP +During window rotation, if set to \fIt\fP iconified window will be +included in the rotation. Default value is \fIt\fP. .TP .B\-*warp-pointer-when-cycle*\ \fIboolean\fP If set to \fIt\fP, the mouse pointer is warped around the upper-left

1 0

[Eclipse-cvs] CVS update: eclipse/Makefile.in eclipse/eclipse.lisp eclipse/gestures.lisp eclipse/global.lisp eclipse/input.lisp eclipse/misc.lisp eclipse/move-resize.lisp eclipse/package.lisp eclipse/programmed-tasks.lisp eclipse/virtual-screen.lisp eclipse/widgets.lisp eclipse/wm.lisp
by Iban Hatchondo 06 Oct '03

06 Oct '03

Update of /project/eclipse/cvsroot/eclipse In directory common-lisp.net:/tmp/cvs-serv32136 Modified Files: Makefile.in eclipse.lisp gestures.lisp global.lisp input.lisp misc.lisp move-resize.lisp package.lisp programmed-tasks.lisp virtual-screen.lisp widgets.lisp wm.lisp Log Message: - Window rotation (Alt-Tab) re-designed. It now works as in almost every window managers. Press Alt-Tab once will raise the next application, on the current desktop, according to the current stacking order. If Alt is released then pressing again Alt-Tab will put back the precedent application. Otherwise if you kipped Alt down then Tab again and the next application will be brought on top of the others, and the precedent one is back on its depth. And so on until you come back on the first one. The same mechanism is available with say Alt-a. It just rotate windows on the other sens. - The window rotation may be verbose by displaying a small window indicating the name and the icon, if provided, of the application that comes on top of the others. To disable it do (setf *verbose-window-cycling* nil) in your eclipse config file. - The window rotation may also cycle the current desktop iconified applications. To disable it do (setf *cycle-icons-p* nil) in your eclipse config file. - Screen edges are now resistant. - fix menu bug. They don't anymore appear below their applications. - a maximized window does not allow anymore to be resized in the directions in which it has been maximized. - the message-box may now display a centered pixmap before the text. - package.lisp updated. - man page updated. - changelog updated. Date: Mon Oct 6 13:57:26 2003 Author: ihatchondo Index: eclipse/Makefile.in diff -u eclipse/Makefile.in:1.6 eclipse/Makefile.in:1.7 --- eclipse/Makefile.in:1.6 Mon Apr 7 09:35:32 2003 +++ eclipse/Makefile.in Mon Oct 6 13:57:25 2003 @@ -1,5 +1,5 @@ # -*- Mode: Makefile -*- -# $Id: Makefile.in,v 1.6 2003/04/07 13:35:32 hatchond Exp $ +# $Id: Makefile.in,v 1.7 2003/10/06 17:57:25 ihatchondo Exp $ # # Makefile for Eclipse window manager. @@ -101,7 +101,8 @@ for theme in ${themes} ; do \ test -f "themes/$$theme/theme.o" && \ $(install) -d ${themedir}/$$theme && \ - for file in themes/$$theme/* ; do \ + $(install) ${themedir}/$$theme/theme.o && \ + for file in themes/$$theme/*.pnm ; do \ $(install) $$file ${themedir}/$$theme/. ; \ done ; \ done ; \ Index: eclipse/eclipse.lisp diff -u eclipse/eclipse.lisp:1.9 eclipse/eclipse.lisp:1.10 --- eclipse/eclipse.lisp:1.9 Tue Sep 30 08:18:36 2003 +++ eclipse/eclipse.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: eclipse.lisp,v 1.9 2003/09/30 12:18:36 hatchond Exp $ +;;; $Id: eclipse.lisp,v 1.10 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -150,6 +150,7 @@ :exposures :OFF :font (xlib:open-font display *font-name*))) (setf (xlib:window-cursor root-window) (root-default-cursor *root*)) + (setf (slot-value *root* 'gcontext) *gcontext*) (unless (root-decoration-theme *root*) (setf (decoration-theme) "microGUI")) (init-edges-cursors)))) Index: eclipse/gestures.lisp diff -u eclipse/gestures.lisp:1.8 eclipse/gestures.lisp:1.9 --- eclipse/gestures.lisp:1.8 Tue Sep 30 08:18:36 2003 +++ eclipse/gestures.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: gestures.lisp,v 1.8 2003/09/30 12:18:36 hatchond Exp $ +;;; $Id: gestures.lisp,v 1.9 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -30,11 +30,13 @@ (defun lookup-keystroke (code state) "Find the associated callback if any for this pair code modifier state." - (gethash (cons code state) *keystroke-map*)) + (or (gethash (cons code state) *keystroke-map*) + (gethash (cons code #x8000) *keystroke-map*))) (defun lookup-mouse-stroke (button state) "Find the associated callback if any for this pair button modifier state." - (gethash (cons button state) *mouse-stroke-map*)) + (or (gethash (cons button state) *mouse-stroke-map*) + (gethash (cons button #x8000) *keystroke-map*))) (defun keycode-registered-p (keycode &optional (count 1)) "Returns t if this keycode is used for any keystroke." @@ -104,7 +106,7 @@ :keysyms (mapcar #'kb:keyname->keysym key-name-set) :default-modifiers-p default-modifiers-p :modifiers modifiers - :action action)) + :action (or action (action-key->lambda name)))) (defun keystroke-p (stroke) (typep stroke 'keystroke)) @@ -129,7 +131,7 @@ :button (list button) :default-modifiers-p default-modifiers-p :modifiers modifiers - :action action)) + :action (or action (action-key->lambda name)))) (defun mouse-stroke-p (stroke) (typep stroke 'mouse-stroke)) @@ -156,10 +158,8 @@ (defun action-key->lambda (action-keyword) "Returns the associated predefined callback for the given action keyword." (case action-keyword - (:switch-win-up - (action () (:press (circulate-window *root* :direction :above)))) - (:switch-win-down - (action () (:press (circulate-window *root* :direction :below)))) + (:switch-win-up #'(lambda (e) (circulate-window-up-and-down e :above))) + (:switch-win-down #'(lambda (e) (circulate-window-up-and-down e :below))) (:switch-screen-left (action (:press (change-vscreen *root* :direction #'-)) ())) (:switch-screen-right @@ -207,7 +207,7 @@ for mask in (translate-modifiers dpy modifiers) do (loop for key in (stroke-keys ,stroke) do (unrealize (,dest-window :mouse-p ,mouse-p) key mask) - (when (and default-modifiers-p (not (eql mask :any))) + (when (and default-modifiers-p (not (eql mask #x8000))) (when caps-l (unrealize (,dest-window :mouse-p ,mouse-p) key (+ mask caps-l))) @@ -218,40 +218,38 @@ (unrealize (,dest-window :mouse-p ,mouse-p) key (+ mask num-l caps-l)))))))) -(defmacro realize ((window &key mouse-p) code mask action-keyword action) +(defmacro realize ((window &key mouse-p) code mask action) `(progn ,@(if mouse-p - `((setf (gethash (cons ,code ,mask) *mouse-stroke-map*) - (or ,action (action-key->lambda ,action-keyword))) + `((setf (gethash (cons ,code ,mask) *mouse-stroke-map*) ,action) (xlib:grab-button ,window ,code '(:button-press) :modifiers ,mask :sync-pointer-p t)) - `((setf (gethash (cons ,code ,mask) *keystroke-map*) - (or ,action (action-key->lambda ,action-keyword))) + `((setf (gethash (cons ,code ,mask) *keystroke-map*) ,action) (setf (aref *registered-keycodes* ,code) 1) (xlib:grab-key ,window ,code :modifiers ,mask :owner-p nil))))) (defmacro define-combo-internal (stroke dest-window &key mouse-p) - `(with-slots (name modifiers default-modifiers-p action) ,stroke + `(with-slots (modifiers default-modifiers-p action) ,stroke (loop with dpy = (xlib:drawable-display ,dest-window) with num-l = (kb:modifier->modifier-mask dpy :NUM-LOCK) with caps-l = (kb:modifier->modifier-mask dpy :CAPS-LOCK) for mask in (translate-modifiers dpy modifiers) do (loop for key in (stroke-keys ,stroke) do (realize (,dest-window :mouse-p ,mouse-p) - key mask name action) - (when (and default-modifiers-p (not (eql mask :any))) + key mask action) + (when (and default-modifiers-p (not (eql mask #x8000))) (when caps-l (realize (,dest-window :mouse-p ,mouse-p) - key (+ mask caps-l) name action )) + key (+ mask caps-l) action )) (when num-l (realize (,dest-window :mouse-p ,mouse-p) - key (+ mask num-l) name action)) + key (+ mask num-l) action)) (when (and num-l caps-l) (realize (,dest-window :mouse-p ,mouse-p) - key (+ mask num-l caps-l) name action))))))) + key (+ mask num-l caps-l) action))))))) (defun define-key-combo (name &key keys (default-modifiers-p t) @@ -326,3 +324,57 @@ (xlib:grab-pointer (event-child event) +pointer-event-mask+) (menu-3-process event widget :key action) (funcall (define-menu-3 action)))) + +;;; Hook and Callbacks for :switch-win-{up, down} keystrokes. + +(defvar *depth* nil) +(defvar *current-widget-info* nil) + +(defun initialize-circulate-window (root-window dpy) + "Initialize gestures internal hooks before circulating windows." + (loop with map = *keystroke-map* + for mod in (stroke-modifiers (gethash :switch-win-up *keystrokes*)) + for code = (unless (eq mod :and) (kb:keyname->keycodes dpy mod)) + when code + do (setf (gethash (cons (if (listp code) (car code) code) #x8000) map) + #'circulate-window-modifier-callback)) + (xlib:grab-keyboard root-window) + (unless *current-widget-info* + (setf *current-widget-info* (create-message-box nil :parent root-window))) + (setf *depth* 0)) + +(defun circulate-window-modifier-callback (event) + (when (typep event 'key-release) + (xlib:ungrab-keyboard *display*) + (loop with map = *keystroke-map* + for mod in (stroke-modifiers (gethash :switch-win-up *keystrokes*)) + for code = (unless (eq mod :and) (kb:keyname->keycodes *display* mod)) + when code + do (remhash (cons (if (listp code) (car code) code) #x8000) map)) + (let ((widget (lookup-widget (input-focus *display*)))) + (when widget (setf (application-wants-iconic-p widget) nil))) + (xlib:unmap-window (widget-window *current-widget-info*)) + (setf *depth* nil))) + +(defun circulate-window-up-and-down (event dir) + "Make window circulating according to the `dir' argument (or :above :below)." + (when (typep event 'key-press) + (with-slots ((root-win root)) event + (unless *depth* + (initialize-circulate-window root-win (xlib:drawable-display root-win))) + (if (eq dir :above) (incf *depth*) (decf *depth*)) + (let ((widget (circulate-window + (lookup-widget root-win) + :direction dir + :nth *depth* + :icon-p *cycle-icons-p*))) + (when (and *verbose-window-cycling* widget) + (with-slots (window) + (if (decoration-p widget) (get-child widget :application) widget) + (setf (message-pixmap *current-widget-info*) + (clx-ext::wm-hints-icon-pixmap window)) + (setf (button-item-to-draw *current-widget-info*) (wm-name window))) + (with-slots (window) *current-widget-info* + (xlib:map-window window) + (setf (xlib:window-priority window) :above) + (repaint *current-widget-info* nil nil))))))) Index: eclipse/global.lisp diff -u eclipse/global.lisp:1.11 eclipse/global.lisp:1.12 --- eclipse/global.lisp:1.11 Tue Sep 30 08:18:36 2003 +++ eclipse/global.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: global.lisp,v 1.11 2003/09/30 12:18:36 hatchond Exp $ +;;; $Id: global.lisp,v 1.12 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2001, 2002 Iban HATCHONDO @@ -55,12 +55,15 @@ (defvar +xa-wm+ nil) ;; Default value of all the "customisable" environment variables +(defparameter *menu-1-exit-p* t) (defparameter *close-display-p* t) (defparameter *menu-1-items* nil) (defparameter *change-desktop-message-active-p* t) (defparameter *verbose-move* t) (defparameter *verbose-resize* t) +(defparameter *verbose-window-cycling* t) (defparameter *warp-pointer-when-cycle* t) +(defparameter *cycle-icons-p* t "Alt-Tab shows or not iconified windows.") (defparameter *focus-new-mapped-window* t) (defparameter *focus-when-window-cycle* t) (defparameter *double-click-speed* 200 "the speed of the double click") @@ -79,8 +82,8 @@ "icon box fill strategy, one of :{top,bottom}-{left,right}") (defparameter *icon-box-sort-function* nil "Function determining icon order within the box. -NIL corresponds to the default which is to sort on order of creation -$aka `icon-sort-creation-order'$.") + NIL corresponds to the default which is to sort on order of creation + $aka `icon-sort-creation-order'$.") (defsetf font-name () (name) `(setf *font-name* ,name @@ -101,7 +104,7 @@ (defmacro deftypedparameter (type symbol value &optional documentation) "define a parameter with the same syntax and behavior as defparameter - except that its type must be given first." + except that its type must be given first." `(progn (defparameter ,symbol ,value ,documentation) (declaim (type ,type ,symbol)))) Index: eclipse/input.lisp diff -u eclipse/input.lisp:1.17 eclipse/input.lisp:1.18 --- eclipse/input.lisp:1.17 Tue Sep 30 08:18:36 2003 +++ eclipse/input.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: input.lisp,v 1.17 2003/09/30 12:18:36 hatchond Exp $ +;;; $Id: input.lisp,v 1.18 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -283,8 +283,8 @@ (set-focus input-model window (event-time event))))) (defmethod event-process ((event button-press) (application application)) - (xlib:allow-events *display* :replay-pointer) - (put-on-top application)) + (put-on-top application) + (xlib:allow-events *display* :replay-pointer)) (defmethod event-process ((event focus-out) (application application)) (with-slots (master) application @@ -294,7 +294,7 @@ (defmethod event-process ((event focus-in) (application application)) (with-slots (master window) application - (unless (eql (event-mode event) :ungrab) + (unless (eql (event-mode event) :grab) (when master (dispatch-repaint master :focus t)) (setf (netwm:net-active-window *root-window*) window)))) @@ -472,3 +472,8 @@ (defmethod event-process ((event button-release) (icon icon)) (when (icon-desiconify-p icon) (uniconify icon))) + +;;; Events for Message Box + +(defmethod event-process ((event visibility-notify) (box box-button)) + (setf (window-priority (widget-window box)) :above)) \ No newline at end of file Index: eclipse/misc.lisp diff -u eclipse/misc.lisp:1.11 eclipse/misc.lisp:1.12 --- eclipse/misc.lisp:1.11 Tue Sep 16 10:47:12 2003 +++ eclipse/misc.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: misc.lisp,v 1.11 2003/09/16 14:47:12 hatchond Exp $ +;;; $Id: misc.lisp,v 1.12 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -121,7 +121,7 @@ (defun motif-wm-decoration (window) "Returns the state (or :on :off) of the :_MOTIF_WM_HINT property that - indicates the application wants or not to be decorated." + indicates the application wants or not to be decorated." (let ((prop (xlib:get-property window :_MOTIF_WM_HINTS))) (or (and prop (logbitp 1 (first prop)) (zerop (third prop)) :OFF) :ON))) @@ -133,7 +133,7 @@ (defun send-wm-protocols-client-message (window atom &rest data) "Send a client-message of type :wm-protocol to the specified window - with data being the given atom plus the rest of the function args." + with data being the given atom plus the rest of the function args." (xlib:send-event window :client-message nil @@ -144,8 +144,8 @@ (defsetf window-priority (window &optional sibling) (priority) "Set the window priority such as (setf xlib:window-priority) but - also invoke update-client-list-stacking to reflect the priority - change in all the root properties that are involved in." + also invoke update-client-list-stacking to reflect the priority + change in all the root properties that are involved in." `(progn (setf (xlib:window-priority ,window ,sibling) ,priority) (update-client-list-stacking *root*))) @@ -160,8 +160,8 @@ (defun query-application-tree (root-window) "Returns the children of the specified root-window as if all applications - where undecorated. The children are returned as a sequence of windows in - current stacking order, from bottom-most (first) to top-most (last)." + where undecorated. The children are returned as a sequence of windows in + current stacking order, from bottom-most (first) to top-most (last)." (loop for window in (xlib:query-tree root-window) for obj = (lookup-widget window) for appw = (typecase obj @@ -175,8 +175,8 @@ (defun run-application (program &rest arguments) "Returns a lambda of zero arguments which when funcalled will try to - run the program named `program' with arguments `arguments'. If the - invocation failed a pop-up window will appear reporting the error." + run the program named `program' with arguments `arguments'. If the + invocation failed a pop-up window will appear reporting the error." (lambda () (catch 'wrong-name (handler-bind ((error #'handle-wrong-name-condition)) Index: eclipse/move-resize.lisp diff -u eclipse/move-resize.lisp:1.5 eclipse/move-resize.lisp:1.6 --- eclipse/move-resize.lisp:1.5 Tue Sep 30 08:18:36 2003 +++ eclipse/move-resize.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: move-resize.lisp,v 1.5 2003/09/30 12:18:36 hatchond Exp $ +;;; $Id: move-resize.lisp,v 1.6 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -33,8 +33,7 @@ (defun initialize-geometry-info-box () (unless *geometry-info-box* - (setf *geometry-info-box* - (create-message-box '("nil") :parent *root-window* :border-width 0))) + (setf *geometry-info-box* (create-message-box nil :parent *root-window*))) (with-slots (window) *geometry-info-box* (xlib:map-window window) (setf (xlib:window-priority window) :above))) @@ -114,16 +113,28 @@ (defun initialize-resize (master edge pointer-event) "Initialize the internal settings for the resize process." - (setf (window-priority (widget-window master)) :above - (decoration-active-p master) t) + (setf (window-priority (widget-window master)) :above) (if (base-widget-p edge) (where-is-pointer edge) (with-slots (root-x root-y) pointer-event - (find-corner root-x root-y (widget-window master))))) + (find-corner root-x root-y (widget-window master)))) + (let ((prop (netwm:net-wm-state (get-child master :application :window t)))) + (when (member :_net_wm_state_maximized_vert prop) + (case *card-point* + ((:ne :se) (setf *card-point* :east)) + ((:nw :sw) (setf *card-point* :west)) + ((:north :south) (setf *card-point* nil)))) + (when (member :_net_wm_state_maximized_horz prop) + (case *card-point* + ((:ne :nw) (setf *card-point* :north)) + ((:se :sw) (setf *card-point* :south)) + ((:east :west) (setf *card-point* nil)))) + (setf (decoration-active-p master) (if *card-point* t nil)))) (defgeneric resize-from (widget) - (:documentation "Resize an application or a master according - to the given master or application respectively.")) + (:documentation + "Resize an application or a master according to the given master or + application respectively.")) (defmethod resize-from ((master decoration)) (declare (optimize (speed 3) (safety 0))) @@ -166,7 +177,7 @@ (defun find-corner (root-x root-y window) "Initialize the resize process when activated from somewhere else - than a decoration edge." + than a decoration edge." (declare (optimize (speed 3) (safety 0)) (type xlib:int16 root-x root-y)) (multiple-value-bind (x y w h) (window-geometry window) @@ -183,7 +194,7 @@ (defun check-size (size base inc min-size max-size) "If the given size respects all the given constraints, then return size. - Otherwise returns the nearest satisfying size." + Otherwise returns the nearest satisfying size." (declare (optimize (speed 3) (safety 0)) (type xlib:card16 size base inc min-size max-size)) (if (< min-size size max-size) @@ -287,7 +298,20 @@ (with-slots (window active-p gcontext) widget (when active-p (let ((new-x (- (the (signed-byte 16) (event-root-x event)) *delta-x*)) - (new-y (- (the (signed-byte 16) (event-root-y event)) *delta-y*))) + (new-y (- (the (signed-byte 16) (event-root-y event)) *delta-y*)) + (scr-w (screen-width)) (scr-h (screen-height))) + (declare (type (signed-byte 16) new-x new-y)) + (declare (type (unsigned-byte 16) scr-w scr-h)) + (multiple-value-bind (x y w h) + (window-geometry (if (eq mode :box) (widget-window *clone*) window)) + (declare (type (signed-byte 16) x y)) + (declare (type (unsigned-byte 16) w h)) + (when (and (>= x 0) (< -40 new-x 0)) (setf new-x 0)) + (when (and (>= y 0) (< -40 new-y 0)) (setf new-y 0)) + (when (and (>= (- scr-w x w) 0) (< -40 (- scr-w new-x w) 0)) + (setf new-x (- scr-w w))) + (when (and (>= (- scr-h y h) 0) (< -40 (- scr-h new-y h) 0)) + (setf new-y (- scr-h h)))) (when verbose-p (display-coordinates new-x new-y)) (if (and (decoration-p widget) (eql mode :box)) (with-slots (window) *clone* Index: eclipse/package.lisp diff -u eclipse/package.lisp:1.8 eclipse/package.lisp:1.9 --- eclipse/package.lisp:1.8 Tue Sep 30 08:18:36 2003 +++ eclipse/package.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: User -*- -;;; $Id: package.lisp,v 1.8 2003/09/30 12:18:36 hatchond Exp $ +;;; $Id: package.lisp,v 1.9 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -73,6 +73,7 @@ "BASE-WIDGET-P" ;function "BUTTON-P" ;function "CHECK-SIZE" ;function + "CIRCULATE-WINDOW-UP-AND-DOWN" ;function "COPY-GEOMETRY" ;function "CREATE-APPLICATION" ;function "CREATE-BUTTON" ;function Index: eclipse/programmed-tasks.lisp diff -u eclipse/programmed-tasks.lisp:1.4 eclipse/programmed-tasks.lisp:1.5 --- eclipse/programmed-tasks.lisp:1.4 Tue Sep 30 08:18:36 2003 +++ eclipse/programmed-tasks.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: PROGRAMMED-TASKS -*- -;;; $Id: programmed-tasks.lisp,v 1.4 2003/09/30 12:18:36 hatchond Exp $ +;;; $Id: programmed-tasks.lisp,v 1.5 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2001 Iban HATCHONDO @@ -36,7 +36,7 @@ (defun arm-timer (delta-time lambda) "Arm a timer that expires in delta-time (unit is second). At expiration - the given lambda (with no parameter) will be executed." + the given lambda (with no parameter) will be executed." (push (cons (+ delta-time (get-universal-time)) lambda) preprogrammed-tasks)) Index: eclipse/virtual-screen.lisp diff -u eclipse/virtual-screen.lisp:1.8 eclipse/virtual-screen.lisp:1.9 --- eclipse/virtual-screen.lisp:1.8 Tue Sep 16 10:24:41 2003 +++ eclipse/virtual-screen.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: virtual-screen.lisp,v 1.8 2003/09/16 14:24:41 hatchond Exp $ +;;; $Id: virtual-screen.lisp,v 1.9 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; Copyright (C) 2002 Iban HATCHONDO ;;; contact : hatchond(a)yahoo.fr @@ -48,12 +48,12 @@ (defun current-vscreen (win) "Get the current virtual screen index. The window parameter must be - the window that owns the win_workspace or _net_current_desktop property." + the window that owns the win_workspace or _net_current_desktop property." (or (netwm:net-current-desktop win) (gnome:win-workspace win) 0)) (defun number-of-virtual-screens (win) "Get the number of virtual screens. The window parameter must be the window - that owns the win_workspace_count or _net_number_of_desktops property." + that owns the win_workspace_count or _net_number_of_desktops property." (or (gnome:win-workspace-count win) (netwm:net-number-of-desktops win) 1)) (defsetf number-of-virtual-screens () (n) @@ -97,6 +97,7 @@ (let ((widget (lookup-widget (input-focus *display*)))) (when (application-p widget) (setf (application-wants-focus-p widget) t)))) + (xlib:set-input-focus *display* :pointer-root :pointer-root) (with-pointer-grabbed (window nil) (map-or-unmap-vscreen #'xlib:map-window new) (map-or-unmap-vscreen #'xlib:unmap-window cur))) @@ -109,7 +110,7 @@ (defun get-screen-content (scr-num &key iconify-p) "Returns the list of application's windows that represent the contents - of the given virtual screen. Use :iconify-p t to includes iconfied windows" + of the given virtual screen. Use :iconify-p t to includes iconfied windows" (loop for win in (query-application-tree *root-window*) when (window-belongs-to-vscreen-p win scr-num iconify-p) collect win)) @@ -127,23 +128,45 @@ (unless given-p (xlib:set-input-focus *display* :pointer-root :pointer-root)))) -(defmethod circulate-window ((root root) &key direction) - (let ((screen-wins (get-screen-content (current-desk)))) - (or screen-wins (return-from circulate-window nil)) - (when (= 1 (length screen-wins)) (setf direction :above)) - (let* ((above-p (eq direction :above)) - (wins (if above-p screen-wins (reverse screen-wins))) - (desktop (and (eql direction :below) (get-root-desktop root t))) - (one (lookup-widget (first wins))) - (two (if above-p one (lookup-widget (second wins))))) - (with-slots (master) one (when master (setf one master))) - (with-slots (master) two (when master (setf two master))) - (when (and (eq direction :below) desktop) - (setf direction :above above-p t)) - (with-slots (window) two - (and (not above-p) *warp-pointer-when-cycle* - (xlib:warp-pointer window 8 5)) - (setf (window-priority (widget-window one) desktop) direction) - (and above-p *warp-pointer-when-cycle* (xlib:warp-pointer window 8 5)) - (and (eq *focus-type* :on-click) *focus-when-window-cycle* - (focus-widget two 0)))))) +(defmethod circulate-window ((root root) &key direction (nth 0) icon-p) + (let* ((wins (reverse (get-screen-content (current-desk) :iconify-p icon-p))) + (length (length wins))) + (or wins (return-from circulate-window nil)) + (setf nth (mod nth length)) + (let ((above-p (eq direction :above)) + (focus-dest (nth nth wins)) + (first (lookup-widget (car wins)))) + ;; Grab the pointer to avoid enter notify events race concurrence + ;; between the window hierarchy change and the warp-pointer call. + (with-pointer-grabbed ((widget-window root) nil) + (when (and (/= length 1) icon-p (application-wants-iconic-p first)) + (iconify first)) + (flet ((set-window-priority (window sibling priority) + (with-slots (master) (lookup-widget window) + (when master (setf window (widget-window master)))) + (when (lookup-widget sibling) + (with-slots (master) (lookup-widget sibling) + (when master (setf sibling (widget-window master))))) + (setf (window-priority window sibling) priority))) + (cond ((= length 1) (set-window-priority focus-dest nil :above)) + ((= nth 0) + (let ((sibling (if above-p (last wins) (cdr wins)))) + (set-window-priority (car wins) (car sibling) :below) + (setf focus-dest (second wins)))) + ((or (and (= nth (1- length)) (not above-p)) + (and (= nth 1) above-p)) + (set-window-priority focus-dest nil :above)) + (t (unless above-p + (setf focus-dest (nth (incf nth) wins))) + (set-window-priority (car wins) focus-dest :below) + (set-window-priority focus-dest nil :above)))) + (with-slots (master) (setf focus-dest (lookup-widget focus-dest)) + (when (and icon-p (application-iconic-p focus-dest)) + (uniconify (application-icon focus-dest)) + (setf (application-wants-iconic-p focus-dest) t)) + (when master (setf focus-dest master))) + (when *warp-pointer-when-cycle* + (xlib:warp-pointer (widget-window focus-dest) 8 5))) + (when (and (eq *focus-type* :on-click) *focus-when-window-cycle*) + (focus-widget focus-dest 0)) + focus-dest))) Index: eclipse/widgets.lisp diff -u eclipse/widgets.lisp:1.15 eclipse/widgets.lisp:1.16 --- eclipse/widgets.lisp:1.15 Tue Sep 30 08:18:36 2003 +++ eclipse/widgets.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.15 2003/09/30 12:18:36 hatchond Exp $ +;;; $Id: widgets.lisp,v 1.16 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -54,22 +54,35 @@ (:documentation "sets the widget stacking order on top of the others.")) (defgeneric put-on-bottom (widget) - (:documentation "sets the widget stacking order on bottom of the others -$except if any widget with :_net_wm_type_desktop is present and widget is or -an application or a decoration$.")) + (:documentation + "Sets the widget stacking order on bottom of the others $except if any + widget with :_net_wm_type_desktop is present and widget is or an + application or a decoration$.")) (defgeneric shade (widget) (:documentation "shade/un-shade an application that is decorated.")) (defgeneric shaded-p (widget) - (:documentation "Return true if the widget is shaded in the sens of -the extended window manager specification.")) + (:documentation + "Returns true if the widget is shaded in the sens of the extended window + manager specification.")) (defgeneric root-manager (widget) - (:documentation "Returns the root-window child that is the place holder for - indicating that a netwm manager is present.")) - -(defgeneric repaint (widget theme-name focus)) + (:documentation + "Returns the root-window child that is the place holder for indicating that + a netwm manager is present.")) + +(defgeneric repaint (widget theme-name focus) + (:documentation + "This method is dedicated to widget repaint such as every buttons, icons, + edges ... + It is specialized on widget type, theme name (via an eql specializer) and a + boolean that indicate if the corresponding toplevel (type decoration) is or + not focused. + + Except for standard expose events, the repaint dispatching on focus change + will be perform according to parts-to-redraw-on-focus list given in + define-theme.")) (defmethod initialize-instance :after ((widget base-widget) &rest rest) (declare (ignore rest)) @@ -155,12 +168,13 @@ (defconstant +properties-to-delete-on-withdrawn+ '(:_net_wm_state :_net_wm_desktop :_win_workspace)) - + (defclass application (base-widget) ((master :initarg :master :reader application-master) (input-model :initform nil :initarg :input :reader application-input-model) (icon :initform nil :initarg :icon :reader application-icon) (iconic-p :initform nil :accessor application-iconic-p) + (wants-iconic-p :initform nil :accessor application-wants-iconic-p) (wants-focus-p :initform nil :accessor application-wants-focus-p) (initial-geometry :initform (make-geometry)) (full-geometry :initform (make-geometry)))) @@ -295,6 +309,7 @@ (pushnew :_net_wm_state_skip_pager netwm-state) (pushnew :_net_wm_state_skip_taskbar netwm-state) (when desktop-p + (pushnew :_net_wm_state_sticky netwm-state) (add-desktop-application *root* app) (setf (window-priority window prec-desk) stack-mode)) (setf (netwm:net-wm-state window) netwm-state @@ -341,16 +356,20 @@ (typep widget 'button)) (declaim (inline draw-pixmap)) -(defun draw-pixmap (window gcontext pixmap) - "Draw and tile, if necessary, the pixmap in the window." - (multiple-value-bind (width height) (drawable-sizes window) - (xlib:with-gcontext (gcontext :tile pixmap :fill-style :tiled) - (xlib:draw-rectangle window gcontext 0 0 width height t)))) +(defun draw-pixmap (window gctxt pix &key (x 0) (y 0) width height) + "Draw, and tile if necessary, the pixmap in the given region in the window." + (multiple-value-bind (w h) (drawable-sizes window) + (unless width (setf width w)) + (unless height (setf height h))) + (if (= (xlib:drawable-depth pix) 1) + (xlib:copy-plane pix gctxt 1 0 0 width height window x y) + (xlib:with-gcontext (gctxt :tile pix :fill-style :tiled :ts-x x :ts-y y) + (xlib:draw-rectangle window gctxt x y width height t)))) ;; When calling this function arguments non optional are ;; :parent :x :y :width :height ;; the others are optional. -(defun create-button (button-type &key parent x y width height gcontext +(defun create-button (button-type &key parent x y width height item background master (border-width 0) (border *black*) (gravity :north-west) @@ -364,53 +383,55 @@ :background background :border border :gravity gravity :bit-gravity (if item :north-west :forget) :cursor cursor :event-mask event-mask) - :gcontext gcontext - :item-to-draw item - :master master)) + :item-to-draw item :master master)) ;;;; Box button ;; Use it for displaying short message in window, that do not require ;; any user intervention (no OK/Cancel confirmation). -(defclass box-button (button) ()) +(defclass box-button (button) + ((pixmap :initform nil :initarg :pixmap-to-display :accessor message-pixmap))) -(defun create-message-box (messages - &key parent (border-width 1) (background *white*)) +(defun create-message-box (messages &key parent pixmap + (border-width 1) + (background *white*)) (setf messages (apply #'concatenate 'string messages)) (let ((message-box (create-button 'box-button - :parent parent :event-mask '(:exposure) + :parent parent :event-mask '(:exposure :visibility-change) :x 0 :y 0 :width 1 :height 1 :border-width border-width - :background background :item messages - :gcontext *gcontext*))) + :background background :item messages))) (setf (xlib:window-override-redirect (widget-window message-box)) :on - (button-item-to-draw message-box) messages) + (button-item-to-draw message-box) messages + (message-pixmap message-box) pixmap) message-box)) -(defmethod (setf button-item-to-draw) (message (box box-button)) - (with-slots (window gcontext) box +(defmethod (setf button-item-to-draw) (m (box box-button)) + (with-slots (window (gctxt gcontext) pixmap) box (multiple-value-bind (width height) - (xlib:text-extents (xlib:gcontext-font gcontext) message) - (incf width 40) - (incf height 20) + (xlib:text-extents (xlib:gcontext-font gctxt) m :translate #'translate) + (incf width 20) (incf height 20) + (when pixmap + (setf height (max (+ 20 (xlib:drawable-height pixmap)) height)) + (incf width (+ 10 (xlib:drawable-width pixmap)))) (multiple-value-bind (children parent) (xlib:query-tree window) (declare (ignore children)) (let ((x (ash (- (xlib:drawable-width parent) width) -1)) (y (ash (- (xlib:drawable-height parent) height) -1))) (setf (drawable-sizes window) (values width height) (window-position window) (values x y) - (slot-value box 'item-to-draw) message)))))) + (slot-value box 'item-to-draw) m)))))) -(defmethod repaint ((widget box-button) theme-name focus) +(defmethod repaint ((widget box-button) theme-name focus &aux x) (declare (ignorable theme-name focus)) - (with-slots (window item-to-draw gcontext) widget - (xlib:clear-area window) - (multiple-value-bind (w h) (drawable-sizes window) - (declare (type (unsigned-byte 16) w h)) - (xlib:with-gcontext (gcontext :foreground *black*) - (xlib:draw-rectangle window gcontext 0 0 (1- w) (1- h)))) - (draw-centered-text window gcontext item-to-draw :color *black*))) + (with-slots (window item-to-draw gcontext pixmap) widget + (xlib:clear-area window) + (when pixmap + (multiple-value-bind (w h) (drawable-sizes pixmap) + (draw-pixmap window gcontext pixmap :x 10 :y 10 :width w :height h) + (setf x (+ w 20)))) + (draw-centered-text window gcontext item-to-draw :color *black* :x x))) ;; Self destructing message box after 2 seconds. (defun timed-message-box (window &rest messages) @@ -549,9 +570,8 @@ (defun icon-p (widget) (typep widget 'icon)) -(defun create-icon (application master - &optional (gcontext *gcontext*) (bg-color *black*)) - (with-slots (window icon) application +(defun create-icon (application master &optional (bg-color *black*)) + (with-slots (window icon gcontext) application (let ((background (clx-ext::wm-hints-icon-pixmap window)) (width 45) (height 20)) (if (typep background 'xlib:pixmap) @@ -568,7 +588,6 @@ 'icon :parent *root-window* :master master :x 0 :y 0 :width width :height height - :gcontext gcontext :item (unless background (wm-icon-name window)) :background (or background bg-color)) (slot-value icon 'application) application) Index: eclipse/wm.lisp diff -u eclipse/wm.lisp:1.20 eclipse/wm.lisp:1.21 --- eclipse/wm.lisp:1.20 Tue Sep 30 21:53:05 2003 +++ eclipse/wm.lisp Mon Oct 6 13:57:26 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: wm.lisp,v 1.20 2003/10/01 01:53:05 hatchond Exp $ +;;; $Id: wm.lisp,v 1.21 2003/10/06 17:57:26 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -170,7 +170,7 @@ (eq :horizontal (style-title-bar-direction (decoration-frame-style master)))) (defun make-menu-button (master parent-window) - (with-slots (children frame-style gcontext) master + (with-slots (children frame-style) master (when (frame-item-exist-p frame-style :menu-button) (let ((pixmaps (frame-item-pixmaps frame-style :menu-button)) (horizontal-p (title-bar-horizontal-p master))) @@ -184,12 +184,11 @@ :item (aref pixmaps 1) :width width :height height :event-mask '(:owner-grab-button . #.+push-button-mask+) - :gcontext gcontext :y (if horizontal-p (ash (- th height) -1) (- th height)) :x (if horizontal-p 0 (ash (- tw width) -1)))))))))) (defun make-buttons-bar (master parent-window) - (with-slots (children frame-style gcontext) master + (with-slots (children frame-style) master (flet ((make-container (horizontal-p) (xlib:create-window :parent parent-window @@ -211,8 +210,7 @@ :parent container :master master :background bkgrd :item (aref pixmaps 1) :x x :y y :width width :height height - :event-mask +push-button-mask+ - :gcontext gcontext)) + :event-mask +push-button-mask+)) (if horizontal-p (incf x width) (incf y height)) finally (multiple-value-bind (w h) (drawable-sizes parent-window) @@ -226,7 +224,7 @@ (return container)))))) (defun make-title-bar (master name) - (with-slots (children frame-style gcontext) master + (with-slots (children frame-style) master (unless (eq :none (style-title-bar-position frame-style)) (let* ((title-pos (style-title-bar-position frame-style)) (horizontal-p (case title-pos ((:top :bottom) t))) @@ -246,7 +244,7 @@ :width 1 :height 1 :x (if horizontal-p mbw 0) :y (if horizontal-p 0 bch) - :gcontext gcontext :event-mask +push-button-mask+ + :event-mask +push-button-mask+ :background (aref pixmaps 0) :item name) (slot-value title 'parent) parent-window (getf children :title-bar) title @@ -267,7 +265,7 @@ (:left (values 0 top-left-h))))) (defun make-edges (master) - (with-slots (children window frame-style gcontext) master + (with-slots (children window frame-style) master (multiple-value-bind (width height) (drawable-sizes window) (loop for type in '(right left top bottom) for child in '(:right :left :top :bottom) @@ -290,10 +288,10 @@ :x x :y y :width (pixmap-width background) :height (pixmap-height background) - :gcontext gcontext :cursor cursor)))))) + :cursor cursor)))))) (defun make-corner (master width height) - (with-slots (children window frame-style gcontext) master + (with-slots (children window frame-style) master (loop for type in '(top-left top-right bottom-left bottom-right) for gravity in '(:north-west :north-east :south-west :south-east) for child in '(:top-left :top-right :bottom-left :bottom-right) @@ -314,7 +312,7 @@ :x (or x (- width w)) :y (or y (- height h)) :width w :height h - :gcontext gcontext :cursor cursor))))) + :cursor cursor))))) (defun update-edges-geometry (master) (declare (optimize (speed 3) (safety 0)) @@ -406,7 +404,6 @@ 'decoration :window window :frame-style style - :gcontext *gcontext* :children (list :application application) :application-gravity gravity :wm-size-hints wm-sizes))) @@ -489,17 +486,18 @@ ;;;; Focus management. According to ICCCM (defgeneric set-focus (input-model window timestamp) - (:documentation "Set focus to the given window according to the input model. -Input model can be :globally-active :locally-active :passive :no-input. -For more information on the input-model sementic see ICCCM 4.1.7")) + (:documentation + "Set focus to the given window according to the input model. + Input model can be :globally-active :locally-active :passive :no-input. + For more information on the input-model sementic see ICCCM 4.1.7")) (defmethod set-focus ((input-model (eql :globally-active)) window timestamp) (send-wm-protocols-client-message window :wm_take_focus (or timestamp 0))) (defmethod set-focus ((input-model (eql :locally-active)) window timestamp) (when (eql (xlib:window-map-state window) :viewable) - (send-wm-protocols-client-message window :wm_take_focus (or timestamp 0)) - (xlib:set-input-focus *display* window :pointer-root))) + (xlib:set-input-focus *display* window :pointer-root) + (send-wm-protocols-client-message window :wm_take_focus (or timestamp 0)))) (defmethod set-focus ((input-model (eql :passive)) window timestamp) (declare (ignorable timestamp)) @@ -569,11 +567,11 @@ (defun make-desktop-menu (root callback-maker &key realize) "Realize a root pop-up menu with as many entry as existing desktop. It attach - to each entry a callback realized with the given `callback-maker' function. - The callback-maker function should be a function of one argument of type - integer that will be the index of the desktop entry. It may return a lambda - or sub menu entries. If :realize is nil (the default value) it returns the - menu entries otherwise a pop-up-menu object is return." + to each entry a callback realized with the given `callback-maker' function. + The callback-maker function should be a function of one argument of type + integer that will be the index of the desktop entry. It may return a lambda + or sub menu entries. If :realize is nil (the default value) it returns the + menu entries otherwise a pop-up-menu object is return." (loop with root-window = (widget-window root) with names = (workspace-names root-window) for i from 0 below (number-of-virtual-screens root-window) @@ -627,7 +625,7 @@ ;; win_client_list, net_client_list(_stacking). (defun update-lists (app state root) "Update root properties win_client_list, net_client_list(_stacking), - by adjoining or removing the given application depending of state." + by adjoining or removing the given application depending of state." (with-slots ((appw window) iconic-p) app (with-slots ((rw window) client-list) root (case (if (and (= state 3) (not iconic-p)) 0 state) @@ -676,7 +674,7 @@ (if (or (= win-workspace scr-num) stick-p) (xlib:map-window window) (with-event-mask (*root-window*) - (xlib:unmap-window window)))) + (xlib:unmap-window window)))) ((or (= win-workspace scr-num) stick-p) (decore-application window application)) (t (with-event-mask (*root-window*) @@ -695,7 +693,8 @@ (time)) ;; Sets the root window pop-up menu - (nconc *menu-1-items* (acons "Exit" (lambda () (setf exit 1)) '())) + (when *menu-1-exit-p* + (nconc *menu-1-items* (acons "Exit" (lambda () (setf exit 1)) '()))) (with-slots (menu1 menu3) *root* (setf menu1 (apply #'make-pop-up *root* *menu-1-items*) menu3 (make-pop-up *root*

1 0

[Eclipse-cvs] CVS update: public_html/download.shtml
by Erik Enge 01 Oct '03

01 Oct '03

Update of /project/eclipse/cvsroot/public_html In directory common-lisp.net:/home/eenge/tmp/eclipse-public_html Modified Files: download.shtml Log Message: correcting download link Date: Wed Oct 1 10:26:45 2003 Author: eenge Index: public_html/download.shtml diff -u public_html/download.shtml:1.1.1.1 public_html/download.shtml:1.2 --- public_html/download.shtml:1.1.1.1 Wed Oct 1 10:10:03 2003 +++ public_html/download.shtml Wed Oct 1 10:26:45 2003 @@ -16,19 +16,9 @@ <p>None.</p> - <h3>Nightly CVS tarballs</h3> - - <a href="downloads/eclipse-nightly.tar.gz">eclipse-nightly.tar.gz</a> - <h3>CVS access</h3> - <p>If you like your code fresh, get it directly from the oven:</p> - - <blockquote> - $ cvs -d :pserver:anoncvs@cvs.unlambda.com:/home/cvsroot login<br> - [your email address as password]<br> - $ cvs -d :pserver:anoncvs@cvs.unlambda.com:/home/cvsroot checkout eclipse<br> - </blockquote> + Read <a href="/faq.html">the common-lisp.net FAQ</a> <p>Happy Lisping!</p> @@ -40,4 +30,4 @@ </table> </td> </tr> - \ No newline at end of file +

1 0