November 2009 - eclipse-cvs@common-lisp.net

[Eclipse-cvs] CVS eclipse/themes/Step
by ihatchondo 17 Nov '09

17 Nov '09

Update of /project/eclipse/cvsroot/eclipse/themes/Step In directory cl-net:/tmp/cvs-serv12329/themes/Step Modified Files: theme.lisp Log Message: Fix: theme rework to remove eql specializer on theme name in favor of theme object. --- /project/eclipse/cvsroot/eclipse/themes/Step/theme.lisp 2005/05/18 20:42:16 1.6 +++ /project/eclipse/cvsroot/eclipse/themes/Step/theme.lisp 2009/11/17 21:17:29 1.7 @@ -41,8 +41,8 @@ (:right ("side")) (:left ("side")))))) -(defmethod repaint ((widget title-bar) (name (eql +Step+)) (focus t)) - (declare (ignorable name focus)) +(defmethod repaint ((widget title-bar) (theme Step) (focus t)) + (declare (ignorable theme focus)) (with-slots ((window eclipse::window) (item-to-draw eclipse::item-to-draw) (gcontext eclipse::gcontext) @@ -54,8 +54,8 @@ (xlib:draw-rectangle window gcontext 0 0 width height t))))) (draw-centered-text window gcontext item-to-draw :color *white*))) -(defmethod repaint ((widget title-bar) (name (eql +Step+)) (focus null)) - (declare (ignorable name focus)) +(defmethod repaint ((widget title-bar) (theme Step) (focus null)) + (declare (ignorable theme focus)) (with-slots ((window eclipse::window) (item-to-draw eclipse::item-to-draw) (gcontext eclipse::gcontext)) widget

1 0

[Eclipse-cvs] CVS eclipse/themes/CoolClean
by ihatchondo 17 Nov '09

17 Nov '09

Update of /project/eclipse/cvsroot/eclipse/themes/CoolClean In directory cl-net:/tmp/cvs-serv12329/themes/CoolClean Modified Files: theme.lisp Log Message: Fix: theme rework to remove eql specializer on theme name in favor of theme object. --- /project/eclipse/cvsroot/eclipse/themes/CoolClean/theme.lisp 2005/05/18 20:42:15 1.6 +++ /project/eclipse/cvsroot/eclipse/themes/CoolClean/theme.lisp 2009/11/17 21:17:29 1.7 @@ -48,8 +48,8 @@ (:right ("right")) (:left ("left")))))) -(defmethod repaint ((widget title-bar) (name (eql +CoolClean+)) (focus t)) - (declare (ignorable name focus)) +(defmethod repaint ((widget title-bar) (theme CoolClean) (focus t)) + (declare (ignorable theme focus)) (with-slots ((window eclipse::window) (item-to-draw eclipse::item-to-draw) (gcontext eclipse::gcontext) @@ -61,8 +61,8 @@ (xlib:draw-rectangle window gcontext 0 0 width height t))))) (draw-centered-text window gcontext item-to-draw :color *white* :x 5))) -(defmethod repaint ((widget title-bar) (name (eql +CoolClean+)) (focus null)) - (declare (ignorable name focus)) +(defmethod repaint ((widget title-bar) (theme CoolClean) (focus null)) + (declare (ignorable theme focus)) (with-slots ((window eclipse::window) (item-to-draw eclipse::item-to-draw) (gcontext eclipse::gcontext)) widget

1 0

[Eclipse-cvs] CVS eclipse/lib
by ihatchondo 17 Nov '09

17 Nov '09

Update of /project/eclipse/cvsroot/eclipse/lib In directory cl-net:/tmp/cvs-serv5426/lib Modified Files: manager-commons.lisp Log Message: Fix: xlib:window-equal is the predicate when removing a window from a list window --- /project/eclipse/cvsroot/eclipse/lib/manager-commons.lisp 2005/02/10 23:45:51 1.8 +++ /project/eclipse/cvsroot/eclipse/lib/manager-commons.lisp 2009/11/17 20:51:56 1.9 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: MANAGER-COMMONS -*- -;;; $Id: manager-commons.lisp,v 1.8 2005/02/10 23:45:51 ihatchondo Exp $ +;;; $Id: manager-commons.lisp,v 1.9 2009/11/17 20:51:56 ihatchondo Exp $ ;;; ;;; This is the CLX support for the managing with gnome. ;;; @@ -254,23 +254,26 @@ :reader-documentation (string): the reader function documentation string. :writer-documentation (string): the setf function documentation string." - (let ((reader (intern (with-standard-io-syntax (format nil "~A" name))))) + (let ((reader (intern (with-standard-io-syntax (format nil "~A" name)))) + (seter (intern (with-standard-io-syntax (format nil "SET-~A" name))))) `(progn - (defun ,reader (window &key window-list) ,@(when reader-documentation `(,reader-documentation)) (get-window-property window ,property-atom window-list)) - (defsetf ,reader (window &key (mode :replace) window-id) (win) + (defun ,seter (window value &key (mode :replace) window-id) + (unless (null value) + (change-property window ',property-atom + (cond ((eq mode :remove) + (let ((prop (,reader window :window-list (not window-id))) + (test (if window-id #'eql #'xlib:window-equal))) + (remove value prop :test test))) + ((listp value) value) + (t (list value))) + ',data-type 32 + :mode (if (eq mode :remove) :replace mode) + :transform (unless window-id #'xlib:window-id)))) + + (defsetf ,reader (window &key (mode :replace) window-id) (value) ,@(when writer-documentation `(,writer-documentation)) - `(when ,win - (change-property ,window ,',property-atom - (cond ((eq ,mode :remove) - (remove ,win - (,',reader ,window :window-list (not ,window-id)))) - ((listp ,win) ,win) - (t (list ,win))) - ,',data-type - 32 - :mode (if (eq ,mode :remove) :replace ,mode) - :transform (unless ,window-id #'xlib:window-id))))))) + `(,',seter ,window ,value :mode ,mode :window-id ,window-id)))))

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 17 Nov '09

17 Nov '09

Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv30487 Modified Files: themer.lisp Log Message: Fix: array creation is macroexpanded instead of creating it during macroexpansion. --- /project/eclipse/cvsroot/eclipse/themer.lisp 2005/03/01 10:06:37 1.11 +++ /project/eclipse/cvsroot/eclipse/themer.lisp 2009/11/17 18:08:43 1.12 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: themer.lisp,v 1.11 2005/03/01 10:06:37 ihatchondo Exp $ +;;; $Id: themer.lisp,v 1.12 2009/11/17 18:08:43 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -348,26 +348,22 @@ (bottom-left-w eclipse::bottom-left-w) (bottom-left-h eclipse::bottom-left-h)) ,style-to-define ,@(loop for (key names) in items - for array = (make-array 4 :initial-element nil) - when (eq key :custom) - do (setf array (make-array (length names))) end when (case key ((:close :icon-b :maximize) t)) collect `(incf nb-buttons) end - collect `(setf (gethash ,key frame-item-pixmaps) ,array) + collect `(setf (gethash ,key frame-item-pixmaps) + (make-array + ,(if (eq key :custom) (length names) 4))) nconc (loop for name in names for i from 0 for k = (eclipse::make-keyword name) - for pix = (gensym) - for form = - `(let ((,pix - (or ,(and style - `(eclipse:get-pixmap ,style ,k)) - (eclipse:load-pnm->pixmap - ,directory ,name ,window)))) - (setf (gethash ,k pixmap-table) ,pix) - (setf (aref ,array ,i) ,pix)) - collect form)) + collect + `(setf (aref (gethash ,key frame-item-pixmaps) ,i) + (setf (gethash ,k pixmap-table) + (or ,(when style + `(eclipse:get-pixmap ,style ,k)) + (eclipse:load-pnm->pixmap + ,directory ,name ,window)))))) (multiple-value-setq (top-left-w top-left-h) (eclipse:frame-item-sizes ,style-to-define :top-left)) (multiple-value-setq (top-right-w top-right-h)

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 17 Nov '09

17 Nov '09

Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv21062 Modified Files: menu.lisp widgets.lisp Log Message: Fix: use the window hashtable machinery. --- /project/eclipse/cvsroot/eclipse/menu.lisp 2004/11/30 23:48:10 1.8 +++ /project/eclipse/cvsroot/eclipse/menu.lisp 2009/11/17 17:33:21 1.9 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: menu.lisp,v 1.8 2004/11/30 23:48:10 ihatchondo Exp $ +;;; $Id: menu.lisp,v 1.9 2009/11/17 17:33:21 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO, Robert STRANDH @@ -114,7 +114,7 @@ :key-press :key-release :owner-grab-button))) - (setf (gethash window *widget-table*) item) + (save-widget window item) (incf y *default-menu-height*) (when map (xlib:map-window window)))) items)) @@ -240,8 +240,8 @@ :background (make-background-pixmap root-window subwidth - subheight)) - (gethash item-container *widget-table*) sub-menu)) + subheight)))) + (save-widget item-container sub-menu) (decf subwidth (* 2 *menu-item-margin*)) (realize-menu-items item-container subwidth items)))) @@ -250,10 +250,10 @@ (when has-substructure (mapc #'(lambda (item) (destroy-substructure item) - (remhash (slot-value item 'window) *widget-table*) + (clear-widget (slot-value item 'window)) (setf (slot-value item 'window) nil)) items) - (remhash item-container *widget-table*) + (clear-widget item-container) (xlib:destroy-window item-container)) (setf armed nil has-substructure nil @@ -320,8 +320,8 @@ root-window (+ subwidth (* 2 *menu-item-margin*)) (+ subheight (* 2 *menu-item-margin*)))) - (gethash window *widget-table*) pop-up-menu armed t) + (save-widget window pop-up-menu) (xlib:map-window window) (realize-menu-items window subwidth items :map t)))) @@ -330,11 +330,11 @@ (when window (mapc #'(lambda (item) (destroy-substructure item) - (remhash (slot-value item 'window) *widget-table*) + (clear-widget (slot-value item 'window)) (setf (slot-value item 'window) nil)) items) (xlib:destroy-window window) - (remhash window *widget-table*) + (clear-widget window) (setf (slot-value pop-up-menu 'armed) nil window nil)))) --- /project/eclipse/cvsroot/eclipse/widgets.lisp 2009/02/20 18:07:01 1.57 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2009/11/17 17:33:21 1.58 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.57 2009/02/20 18:07:01 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.58 2009/11/17 17:33:21 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -111,10 +111,10 @@ (defmethod initialize-instance :after ((widget base-widget) &rest rest) (declare (ignore rest)) - (setf (gethash (widget-window widget) *widget-table*) widget)) + (save-widget (widget-window widget) widget)) (defmethod remove-widget ((widget base-widget)) - (remhash (widget-window widget) *widget-table*)) + (clear-widget (widget-window widget))) (defmethod put-on-top ((widget base-widget)) (setf (xlib:window-priority (widget-window widget)) :above)) @@ -127,10 +127,20 @@ (defun lookup-widget (window) "Returns the associated widget if any." - (declare (optimize (speed 3) (safety 1))) - (gethash window *widget-table*)) + (declare (optimize (speed 3) (safety 0))) + (declare (inline getwinhash)) + (getwinhash window *widget-table*)) + +(defun save-widget (window widget) + (declare (optimize (speed 3) (safety 0))) + (setf (getwinhash window *widget-table*) widget)) + +(defun clear-widget (window) + (declare (optimize (speed 3) (safety 0))) + (declare (inline remwinhash)) + (remwinhash window *widget-table*)) -(declaim (inline lookup-widget)) +(declaim (inline lookup-widget save-widget clear-widget)) (defclass standard-property-holder (base-widget) ()) @@ -245,11 +255,12 @@ (defmethod focused-p ((application application)) (loop with window = (widget-window application) with foc = (xlib:input-focus *display*) - until (or (xlib:window-equal window foc) (not (xlib:window-p foc))) + until (or (not (xlib:window-p foc)) (xlib:window-equal window foc)) do (multiple-value-bind (children parent) (xlib:query-tree foc) (declare (ignore children)) (setq foc parent)) - finally (return (xlib:window-equal window foc)))) + finally + (return (and (xlib:window-p foc) (xlib:window-equal window foc))))) (defmethod shaded-p ((widget application)) (member :_net_wm_state_shaded (netwm:net-wm-state (widget-window widget)))) @@ -656,12 +667,13 @@ (defun timed-message-box (window &rest messages) "Map a small box, of parent `window', displaying the given string messages. This box will automatically destroyed two seconds after being mapped." - (with-slots (window) (create-message-box messages :parent window) - (xlib:map-window window) - (pt:arm-timer 2 (lambda () - (xlib:display-finish-output *display*) - (remhash window *widget-table*) - (xlib:destroy-window window))))) + (let ((box (create-message-box messages :parent window))) + (with-slots (window) box + (xlib:map-window window) + (pt:arm-timer 2 (lambda () + (xlib:display-finish-output *display*) + (remove-widget box) + (xlib:destroy-window window)))))) ;;;; Push button ;; Everybody knows what a push button is.

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 17 Nov '09

17 Nov '09

Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv20975 Modified Files: global.lisp Log Message: Fix: add some backtrace stuff. --- /project/eclipse/cvsroot/eclipse/global.lisp 2009/02/23 00:00:35 1.33 +++ /project/eclipse/cvsroot/eclipse/global.lisp 2009/11/17 17:32:09 1.34 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: global.lisp,v 1.33 2009/02/23 00:00:35 ihatchondo Exp $ +;;; $Id: global.lisp,v 1.34 2009/11/17 17:32:09 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2001, 2002 Iban HATCHONDO @@ -270,6 +270,9 @@ (format *stderr* "X error ~A ~:[~;with id~]~%=> ~{~A ~}~%" err resource-id keys) + (unless asynchronous + ;;#+:cmu (debug::backtrace most-positive-fixnum *stderr*) + ) (when resource-id (let* ((resource (xlib::lookup-window dpy resource-id)) (widget (lookup-widget resource)))

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 17 Nov '09

17 Nov '09

Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv20917 Modified Files: wm.lisp Log Message: Fix: use window hash table machinery. --- /project/eclipse/cvsroot/eclipse/wm.lisp 2008/08/29 14:57:47 1.57 +++ /project/eclipse/cvsroot/eclipse/wm.lisp 2009/11/17 17:31:25 1.58 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: wm.lisp,v 1.57 2008/08/29 14:57:47 ihatchondo Exp $ +;;; $Id: wm.lisp,v 1.58 2009/11/17 17:31:25 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -653,7 +653,7 @@ (defun remove-window-from-client-lists (window root) "Removes a window from the client lists root properties." (with-slots ((rw window) client-list) root - (remhash window client-list) + (remwinhash window client-list) (setf (netwm:net-client-list-stacking rw :mode :remove) window (gnome:win-client-list rw :mode :remove) window (netwm:net-client-list rw :mode :remove) window))) @@ -661,8 +661,8 @@ (defun add-window-in-client-lists (window root) "Add a window in the client lists root properties." (with-slots ((rw window) client-list) root - (let ((up2date (gethash window client-list))) - (setf (gethash window client-list) window) + (let ((up2date (getwinhash window client-list))) + (setf (getwinhash window client-list) window) (update-client-list-stacking root) (unless up2date (setf (netwm:net-client-list rw :mode :append) window)) @@ -675,7 +675,7 @@ "Recompute and set the root property net_client_list_stacking." (with-slots (window client-list) root (loop for win in (query-application-tree window) - when (gethash win client-list) collect win into wins + when (getwinhash win client-list) collect win into wins finally (setf (netwm:net-client-list-stacking window) wins)))) (defun update-lists (app state root)

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 17 Nov '09

17 Nov '09

Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv20089 Modified Files: misc.lisp Log Message: Add: wrapper functions around hash table to get window as key. --- /project/eclipse/cvsroot/eclipse/misc.lisp 2009/11/04 19:24:59 1.45 +++ /project/eclipse/cvsroot/eclipse/misc.lisp 2009/11/17 17:30:00 1.46 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: misc.lisp,v 1.45 2009/11/04 19:24:59 ihatchondo Exp $ +;;; $Id: misc.lisp,v 1.46 2009/11/17 17:30:00 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -71,6 +71,29 @@ (make-error-handler (error :return t)) (make-error-handler (end-of-file :throw end)) +;;;; Window hashtable +;; Wrapper functions over hashtable using xlib:window as hash keys. +;; Since we can't pass a custom predicate to make-hash-table, those +;; wrappers are there to deal with it using window-id and null window. + +(defun getwinhash (window hashtable &optional default) + (declare (type (or null xlib:window) window)) + (declare (type hash-table hashtable)) + (declare (optimize (speed 3) (safety 0))) + (gethash (and window (xlib:window-id window)) hashtable default)) + +(defun remwinhash (window hashtable) + (declare (type (or null xlib:window) window)) + (declare (type hash-table hashtable)) + (declare (optimize (speed 3) (safety 0))) + (remhash (and window (xlib:window-id window)) hashtable)) + +(defsetf getwinhash (window hashtable &optional default) (value) + (let ((key (gensym))) + `(let ((,key ,window)) + (setf (gethash (and ,key (xlib:window-id ,key)) ,hashtable ,default) + ,value)))) + ;;;; Property readers. ;; They are not defined in the clx-ext package, because we customize them ;; to allow a single manipulation for all properties that appears in the

1 0

[Eclipse-cvs] CVS eclipse/lib/clx-ext
by ihatchondo 17 Nov '09

17 Nov '09

Update of /project/eclipse/cvsroot/eclipse/lib/clx-ext In directory cl-net:/tmp/cvs-serv20028/lib/clx-ext Modified Files: clx-patch.lisp Log Message: Fix: <mumble>-equal now accept null arguments. --- /project/eclipse/cvsroot/eclipse/lib/clx-ext/clx-patch.lisp 2004/03/03 09:05:12 1.6 +++ /project/eclipse/cvsroot/eclipse/lib/clx-ext/clx-patch.lisp 2009/11/17 17:29:13 1.7 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp -*- -;;; $Id: clx-patch.lisp,v 1.6 2004/03/03 09:05:12 ihatchondo Exp $ +;;; $Id: clx-patch.lisp,v 1.7 2009/11/17 17:29:13 ihatchondo Exp $ ;;; ;;; This file contains the patch fixing a bug in CLX as distributed ;;; with vanilla CMUCL versions up to 18d. @@ -51,6 +51,33 @@ (t (xlib::lookup-window dpy id)))) (xlib::member8-get 1 :none :pointer-root :parent)))) +;; This is a patch for the equality functions. Not accepting at least +;; nil arguments is pretty anoying. It will still complain if at least +;; one is not of the proper type but this should save us from lots of +;; testing. + +(macrolet ((make-mumble-equal (type) + ;; Since caching is only done for objects created by the + ;; client, we must always compare ID and display for + ;; non-identical mumbles. + (let ((predicate (xintern type '-equal)) + (id (xintern type '-id)) + (dpy (xintern type '-display))) + `(within-definition (,type make-mumble-equal) + (defun ,predicate (a b) + (declare (type (or null ,type) a b)) + (when (and a b) + (or (eql a b) + (and (= (,id a) (,id b)) + (eq (,dpy a) (,dpy b)))))))))) + (make-mumble-equal window) + (make-mumble-equal pixmap) + (make-mumble-equal cursor) + (make-mumble-equal font) + (make-mumble-equal gcontext) + (make-mumble-equal colormap) + (make-mumble-equal drawable)) + ;; It seems that sometimes some id are still present in the clx display ;; internal cache even when those resources have been destroyed. This has ;; for effect that when the X server reallocate this id to a resource of

1 0

[Eclipse-cvs] CVS eclipse
by ihatchondo 17 Nov '09

17 Nov '09

Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv18082 Modified Files: move-resize.lisp Log Message: Fix: cosmetic. --- /project/eclipse/cvsroot/eclipse/move-resize.lisp 2008/04/25 16:02:49 1.19 +++ /project/eclipse/cvsroot/eclipse/move-resize.lisp 2009/11/17 09:32:27 1.20 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: move-resize.lisp,v 1.19 2008/04/25 16:02:49 ihatchondo Exp $ +;;; $Id: move-resize.lisp,v 1.20 2009/11/17 09:32:27 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -428,7 +428,7 @@ (with-slots (window active-p) widget (setf (window-priority window) :above) (unless (widget-position-fix-p widget) - (setf active-p t + (setf active-p t *delta-x* (- (event-root-x event) (xlib:drawable-x window)) *delta-y* (- (event-root-y event) (xlib:drawable-y window)) *screen-windows* (screen-content (current-desk) @@ -442,4 +442,4 @@ (send-configuration-notify (get-child master :application :window t))) (defmethod finalize-move ((application application)) - (send-configuration-notify (widget-window application))) \ No newline at end of file + (send-configuration-notify (widget-window application)))

1 0