From ihatchondo at common-lisp.net Fri Apr 2 09:57:53 2010 From: ihatchondo at common-lisp.net (ihatchondo) Date: Fri, 02 Apr 2010 05:57:53 -0400 Subject: [Eclipse-cvs] CVS eclipse Message-ID: Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv8701 Modified Files: eclipse.lisp input.lisp misc.lisp widgets.lisp wm.lisp Log Message: Fix: added some declaration type, and null verification so the clx patch should not be necessary anymore. Fix: wm-normal-hints returns some inproper values in fields that should be ignored. Now, we replace those obsolote fields values by the window geometry. --- /project/eclipse/cvsroot/eclipse/eclipse.lisp 2009/11/17 22:40:49 1.29 +++ /project/eclipse/cvsroot/eclipse/eclipse.lisp 2010/04/02 09:57:53 1.30 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: eclipse.lisp,v 1.29 2009/11/17 22:40:49 ihatchondo Exp $ +;;; $Id: eclipse.lisp,v 1.30 2010/04/02 09:57:53 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -113,6 +113,8 @@ :override-redirect :on :width 1 :height 1 :x 0 :y 0))) + (declare (type xlib:window manager)) + (declare (type (or null xlib:window) old-wm)) (when old-wm (setf (xlib:window-event-mask old-wm) '(:structure-notify))) @@ -132,8 +134,10 @@ (t nil))) ;; Are we the selection owner after all ? - (unless (xlib:window-equal manager (xlib:selection-owner display +xa-wm+)) - (error "ICCCM Error: failed to aquire selection ownership~%")) + (let ((owner (xlib:selection-owner display +xa-wm+))) + (declare (type (or null xlib:window) owner)) + (unless (and owner (xlib:window-equal manager owner)) + (error "ICCCM Error: failed to aquire selection ownership~%"))) ;; Check if a non ICCCM complient window manager is not running. (handler-case --- /project/eclipse/cvsroot/eclipse/input.lisp 2009/11/17 21:17:29 1.54 +++ /project/eclipse/cvsroot/eclipse/input.lisp 2010/04/02 09:57:53 1.55 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: input.lisp,v 1.54 2009/11/17 21:17:29 ihatchondo Exp $ +;;; $Id: input.lisp,v 1.55 2010/04/02 09:57:53 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -47,7 +47,8 @@ (with-slots (window (candidat event-window)) event (multiple-value-bind (children parent) (xlib:query-tree window) (declare (ignore children)) - (unless (xlib:window-equal candidat parent) + (declare (type (or null xlib:window) parent)) + (unless (and parent (xlib:window-equal candidat parent)) (xlib:send-event parent :map-request '(:substructure-redirect) :window window :event-window parent))))) --- /project/eclipse/cvsroot/eclipse/misc.lisp 2009/11/17 22:40:49 1.47 +++ /project/eclipse/cvsroot/eclipse/misc.lisp 2010/04/02 09:57:53 1.48 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: misc.lisp,v 1.47 2009/11/17 22:40:49 ihatchondo Exp $ +;;; $Id: misc.lisp,v 1.48 2010/04/02 09:57:53 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -110,6 +110,18 @@ (or (xlib:transient-for app-window) (member :_net_wm_window_type_dialog (netwm:net-wm-state app-window)))) +(defun wm-normal-hints (window) + "Returns the window WM_NORMAL_HINTS property with the obsolete values + reset to the window geometry." + (let ((hint (ignore-errors (xlib:wm-normal-hints window)))) + (unless (null hint) + (multiple-value-bind (x y w h) (window-geometry window) + (setf (xlib:wm-size-hints-x hint) x + (xlib:wm-size-hints-y hint) y + (xlib:wm-size-hints-width hint) w + (xlib:wm-size-hints-height hint) h))) + hint)) + (defun wm-state (window) "Returns the wm_state property of a window as xlib:get-property would." (xlib:get-property window :WM_STATE)) @@ -247,6 +259,9 @@ (flet ((lookup-app-w (widget) (when (decoration-p widget) (get-child widget :application :window t))) + (layer-member (window windows) + (when (xlib:window-p window) + (member window windows :test #'xlib:window-equal))) (first-win (windows &optional above-p) (car (if above-p (last windows) windows))) (restack (app sib-app priority) @@ -254,7 +269,7 @@ (let* ((window (widget-window (or (application-master app) app))) (sm (when sib-app (application-master sib-app))) (sibling (when sib-app (widget-window (or sm sib-app))))) - (unless (xlib:window-equal window sibling) + (unless (and sibling (xlib:window-equal window sibling)) (setf (xlib:window-priority window sibling) priority)))))) (let* ((win (or (lookup-app-w (lookup-widget window)) window)) (sib (or (lookup-app-w (lookup-widget sibling)) sibling)) @@ -272,20 +287,20 @@ (setf wnwm-state (nconc wnwm-state (netwm:net-wm-state lw))))) ;; Find the correct sibling and reset the priority if needed. (cond ((member :_net_wm_state_below wnwm-state) - (unless (member sib below-layer :test #'xlib:window-equal) + (unless (layer-member sib below-layer) (setf sib (first-win (or below-layer std-layer above-layer) - (and below-layer above-p))) + (and below-layer above-p))) (unless below-layer (setf stack-mode :below)))) ((member :_net_wm_state_above wnwm-state) - (unless (member sib above-layer :test #'xlib:window-equal) + (unless (layer-member sib above-layer) (unless (member :_net_wm_state_fullscreen snwm-state) (setf sib (first-win above-layer above-p)) (unless above-layer (setf stack-mode :above))))) ((member :_net_wm_state_fullscreen wnwm-state) - (when (member sib below-layer :test #'xlib:window-equal) + (when (layer-member sib below-layer) (setf sib (first-win (or std-layer above-layer))) (setf stack-mode :below))) - ((not (member sib std-layer :test #'xlib:window-equal)) + ((not (layer-member sib std-layer)) (setf sib (first-win (or std-layer below-layer above-layer) (if std-layer above-p below-layer))) (unless std-layer @@ -348,7 +363,7 @@ (parent (when master (widget-window master))) (top-margin 0) (left-margin 0) (g (or gravity (and master (decoration-application-gravity master)) - (let ((h (ignore-errors (xlib:wm-normal-hints win)))) + (let ((h (ignore-errors (wm-normal-hints win)))) (if h (xlib:wm-size-hints-win-gravity h) :north-west))))) (when master (setf top-margin (style-top-margin (decoration-frame-style master))) --- /project/eclipse/cvsroot/eclipse/widgets.lisp 2009/11/17 21:17:29 1.59 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2010/04/02 09:57:53 1.60 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.59 2009/11/17 21:17:29 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.60 2010/04/02 09:57:53 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -296,7 +296,7 @@ (defun fullscreenable-p (application) (with-slots (window) application - (let ((hint (ignore-errors (xlib:wm-normal-hints window)))) + (let ((hint (ignore-errors (wm-normal-hints window)))) (symbol-macrolet ((max-h (and hint (xlib:wm-size-hints-max-height hint))) (max-w (and hint (xlib:wm-size-hints-max-width hint)))) (and (if max-w (= max-w (screen-width)) t) @@ -515,7 +515,7 @@ actual geometry of the specified window. If the optional geometry is given then it will be filled and returned." (multiple-value-bind (x y w h) (window-geometry window) - (let ((hint (ignore-errors (xlib:wm-normal-hints window)))) + (let ((hint (ignore-errors (wm-normal-hints window)))) (setf (geometry geometry) (values (or (when hint (xlib:wm-size-hints-x hint)) x) (or (when hint (xlib:wm-size-hints-y hint)) y) --- /project/eclipse/cvsroot/eclipse/wm.lisp 2009/11/17 21:36:08 1.60 +++ /project/eclipse/cvsroot/eclipse/wm.lisp 2010/04/02 09:57:53 1.61 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: wm.lisp,v 1.60 2009/11/17 21:36:08 ihatchondo Exp $ +;;; $Id: wm.lisp,v 1.61 2010/04/02 09:57:53 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -169,7 +169,7 @@ the window gravity of the designed window. The wm-normal-hints property is recomputed in order to reflect the margin that a top level decoration widget (aka master) might introduce." - (let ((hints (or (ignore-errors (xlib:wm-normal-hints window)) + (let ((hints (or (ignore-errors (wm-normal-hints window)) (xlib:make-wm-size-hints))) (max-ww (screen-width)) (max-hh (screen-height))) @@ -364,7 +364,7 @@ (defun initial-coordinates (window frame-style) "Returns as multiple values the decoration initial coordinates." - (let ((hint (ignore-errors (xlib:wm-normal-hints window)))) + (let ((hint (ignore-errors (wm-normal-hints window)))) (with-slots (top-margin left-margin vmargin hmargin) frame-style (flet ((default-coordinates () (let* ((n (or (window-desktop-num window) 0)) From ihatchondo at common-lisp.net Fri Apr 2 09:57:53 2010 From: ihatchondo at common-lisp.net (ihatchondo) Date: Fri, 02 Apr 2010 05:57:53 -0400 Subject: [Eclipse-cvs] CVS eclipse/lib/clx-ext Message-ID: Update of /project/eclipse/cvsroot/eclipse/lib/clx-ext In directory cl-net:/tmp/cvs-serv8701/lib/clx-ext Modified Files: clx-patch.lisp Log Message: Fix: added some declaration type, and null verification so the clx patch should not be necessary anymore. Fix: wm-normal-hints returns some inproper values in fields that should be ignored. Now, we replace those obsolote fields values by the window geometry. --- /project/eclipse/cvsroot/eclipse/lib/clx-ext/clx-patch.lisp 2009/11/17 17:29:13 1.7 +++ /project/eclipse/cvsroot/eclipse/lib/clx-ext/clx-patch.lisp 2010/04/02 09:57:53 1.8 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp -*- -;;; $Id: clx-patch.lisp,v 1.7 2009/11/17 17:29:13 ihatchondo Exp $ +;;; $Id: clx-patch.lisp,v 1.8 2010/04/02 09:57:53 ihatchondo Exp $ ;;; ;;; This file contains the patch fixing a bug in CLX as distributed ;;; with vanilla CMUCL versions up to 18d. @@ -56,27 +56,27 @@ ;; 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)) +;; (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 From ihatchondo at common-lisp.net Fri Apr 23 14:36:49 2010 From: ihatchondo at common-lisp.net (ihatchondo) Date: Fri, 23 Apr 2010 10:36:49 -0400 Subject: [Eclipse-cvs] CVS eclipse Message-ID: Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv24108 Modified Files: eclipse.lisp global.lisp Log Message: Fix: bug raised by David Thompson: error during start up because a directory named .eclipse is in the way. --- /project/eclipse/cvsroot/eclipse/eclipse.lisp 2010/04/02 09:57:53 1.30 +++ /project/eclipse/cvsroot/eclipse/eclipse.lisp 2010/04/23 14:36:49 1.31 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: eclipse.lisp,v 1.30 2010/04/02 09:57:53 ihatchondo Exp $ +;;; $Id: eclipse.lisp,v 1.31 2010/04/23 14:36:49 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -220,7 +220,7 @@ :fill-style :solid :line-style :solid :line-width 1 :exposures :OFF)) ;; load personal configuration file, or the default one. - (labels ((load-if (f) (and (probe-file f) (load-config-file f)))) + (labels ((load-if (f) (and (file-exists-p f) (load-config-file f)))) (or (load-if (home-subdirectory cl-user::*eclipse-initfile*)) (load-if (eclipse-path "eclipserc")) (error "Unable to read a configuration file.~%"))) --- /project/eclipse/cvsroot/eclipse/global.lisp 2009/11/17 22:40:49 1.36 +++ /project/eclipse/cvsroot/eclipse/global.lisp 2010/04/23 14:36:49 1.37 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: global.lisp,v 1.36 2009/11/17 22:40:49 ihatchondo Exp $ +;;; $Id: global.lisp,v 1.37 2010/04/23 14:36:49 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2001, 2002 Iban HATCHONDO @@ -216,7 +216,6 @@ #-(or allegro clisp cmu gcl lispworks lucid mcl sbcl scl) (error 'not-implemented :proc (list 'getenv var))) - (defun (setf getenv) (val var) "Sets the value of the environment variable named var to val." #+allegro (setf (sys::getenv (string var)) (string val)) @@ -254,6 +253,12 @@ #+cmu (extensions:unix-namestring (user-homedir-pathname)) #-cmu (namestring (user-homedir-pathname))) +(defun file-exists-p (filename) + "Returns true if the given filename is an existing file and not a directory." + (and #+clisp (not (probe-directory (make-pathname :directory filename))) + #-clisp (not (probe-file (make-pathname :directory filename))) + (probe-file filename))) + ;;;; Error handler. ;; The X errors handler. ;; For debug purpose: it use *stderr* as output stream. From ihatchondo at common-lisp.net Fri Apr 23 14:41:13 2010 From: ihatchondo at common-lisp.net (ihatchondo) Date: Fri, 23 Apr 2010 10:41:13 -0400 Subject: [Eclipse-cvs] CVS eclipse Message-ID: Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv27384 Modified Files: widgets.lisp Log Message: Fix: improper handling of iconified application during migration. --- /project/eclipse/cvsroot/eclipse/widgets.lisp 2010/04/02 09:57:53 1.60 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2010/04/23 14:41:12 1.61 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.60 2010/04/02 09:57:53 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.61 2010/04/23 14:41:12 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -444,10 +444,12 @@ (defun migrate-application (application new-screen-number) "Put an application, all its related dialogs and the top-level it is transient-for (if any) to the a new virtual screen." - (with-slots (master window transient-for) application + (with-slots (master window transient-for iconic-p) application (let* ((focused-p (focused-p application)) (unmap-p (/= new-screen-number +any-desktop+ (current-desk))) - (operation (if unmap-p #'xlib:unmap-window #'xlib:map-window))) + (operation (if (or iconic-p unmap-p) + #'xlib:unmap-window + #'xlib:map-window))) (flet ((migrate (application) (with-slots (master window) application (when (shaded-p application) (shade application)) From ihatchondo at common-lisp.net Fri Apr 23 14:42:43 2010 From: ihatchondo at common-lisp.net (ihatchondo) Date: Fri, 23 Apr 2010 10:42:43 -0400 Subject: [Eclipse-cvs] CVS eclipse Message-ID: Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv27758 Modified Files: eclipse.lisp misc.lisp wm.lisp Log Message: Fix: cosmetic & cleanup changes in the way of handling EOF on the xlib:display object. --- /project/eclipse/cvsroot/eclipse/eclipse.lisp 2010/04/23 14:36:49 1.31 +++ /project/eclipse/cvsroot/eclipse/eclipse.lisp 2010/04/23 14:42:43 1.32 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: eclipse.lisp,v 1.31 2010/04/23 14:36:49 ihatchondo Exp $ +;;; $Id: eclipse.lisp,v 1.32 2010/04/23 14:42:43 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -276,10 +276,8 @@ (mp::start-lisp-connection-listener :port 6789 :password "clara")) (unwind-protect - (catch 'end - (handler-bind ((end-of-file #'handle-end-of-file-condition)) - (eclipse-internal-loop))) - (progn - (ignore-errors (xlib:close-display *display*)) - (format t "Eclipse exited. Bye.~%") - (quit)))) + (handler-case (eclipse-internal-loop) + (end-of-file (c) (handle-end-of-file-condition c))) + (ignore-errors (xlib:close-display *display*)) + (format t "Eclipse exited. Bye.~%") + (quit))) --- /project/eclipse/cvsroot/eclipse/misc.lisp 2010/04/02 09:57:53 1.48 +++ /project/eclipse/cvsroot/eclipse/misc.lisp 2010/04/23 14:42:43 1.49 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: misc.lisp,v 1.48 2010/04/02 09:57:53 ihatchondo Exp $ +;;; $Id: misc.lisp,v 1.49 2010/04/23 14:42:43 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -71,7 +71,7 @@ ,(unless return `(throw ',(or throw type) ,@(or body '(nil)))))) (make-error-handler (error :return t)) -(make-error-handler (end-of-file :throw end)) +(make-error-handler (end-of-file :return t)) ;;;; Window hashtable ;; Wrapper functions over hashtable using xlib:window as hash keys. --- /project/eclipse/cvsroot/eclipse/wm.lisp 2010/04/02 09:57:53 1.61 +++ /project/eclipse/cvsroot/eclipse/wm.lisp 2010/04/23 14:42:43 1.62 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: wm.lisp,v 1.61 2010/04/02 09:57:53 ihatchondo Exp $ +;;; $Id: wm.lisp,v 1.62 2010/04/23 14:42:43 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -770,34 +770,33 @@ (xlib:query-tree *root-window*)))) ;; Main loop (loop - (catch 'general-error - (handler-case - (let ((event (get-next-event *display* :discard-p t :timeout 2))) - (when event - (with-slots (event-window) event - (event-process event (lookup-widget event-window))) - (xlib:display-finish-output *display*)) - (when pt:preprogrammed-tasks (pt:execute-preprogrammed-tasks)) - (with-slots (sm-conn) *root* - (when sm-conn (handle-session-manager-request sm-conn *root*))) - (case exit - (1 (loop for val being each hash-value in *widget-table* - when (application-p val) - if close-display-p do (close-widget val) - else do (undecore-application val)) + (handler-case + (let ((event (get-next-event *display* :discard-p t :timeout 2))) + (when event + (with-slots (event-window) event + (event-process event (lookup-widget event-window))) + (xlib:display-finish-output *display*)) + (when pt:preprogrammed-tasks (pt:execute-preprogrammed-tasks)) + (with-slots (sm-conn) *root* + (when sm-conn (handle-session-manager-request sm-conn *root*))) + (case exit + (1 (loop for val being each hash-value in *widget-table* + when (application-p val) + if close-display-p do (close-widget val) + else do (undecore-application val)) (setf exit 2)) - (2 (when (root-sm-conn *root*) - (close-sm-connection *root* :exit-p nil)) - (xlib:display-finish-output *display*) - (setf (xlib:window-event-mask *root-window*) 0) - (let ((win (netwm:net-supporting-wm-check *root-window*))) - (xlib:destroy-window win)) - (xlib:display-finish-output *display*) - (return)))) - (exit-eclipse (c) - (setf close-display-p (close-application-p c)) - (setf exit 1)) - (end-of-file (c) (handle-end-of-file-condition c)) - (already-handled-xerror () nil) - (error (c) (handle-error-condition c))))) + (2 (when (root-sm-conn *root*) + (close-sm-connection *root* :exit-p nil)) + (xlib:display-finish-output *display*) + (setf (xlib:window-event-mask *root-window*) 0) + (let ((win (netwm:net-supporting-wm-check *root-window*))) + (xlib:destroy-window win)) + (xlib:display-finish-output *display*) + (return)))) + (exit-eclipse (c) + (setf close-display-p (close-application-p c)) + (setf exit 1)) + (end-of-file (c) (error c)) + (already-handled-xerror () nil) + (error (c) (handle-error-condition c)))) (format t "~%Main loop exited~%"))) From ihatchondo at common-lisp.net Fri Apr 23 16:26:09 2010 From: ihatchondo at common-lisp.net (ihatchondo) Date: Fri, 23 Apr 2010 12:26:09 -0400 Subject: [Eclipse-cvs] CVS eclipse/lib Message-ID: Update of /project/eclipse/cvsroot/eclipse/lib In directory cl-net:/tmp/cvs-serv15239 Modified Files: netwm-manager.lisp Log Message: Fix: missing exported functions and ATOMS. --- /project/eclipse/cvsroot/eclipse/lib/netwm-manager.lisp 2007/11/04 22:27:19 1.23 +++ /project/eclipse/cvsroot/eclipse/lib/netwm-manager.lisp 2010/04/23 16:26:09 1.24 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: EXTENDED-WINDOW-MANAGER-HINTS -*- -;;; $Id: netwm-manager.lisp,v 1.23 2007/11/04 22:27:19 ihatchondo Exp $ +;;; $Id: netwm-manager.lisp,v 1.24 2010/04/23 16:26:09 ihatchondo Exp $ ;;; ;;; This is the CLX support for the managing with gnome. ;;; @@ -32,23 +32,46 @@ (:import-from :xlib #:get-property #:change-property) (:import-from :manager-commons #:card-32 #:card-16 #:card-8 #:int-16) (:export - #:net-supported #:net-client-list - #:net-client-list-stacking #:net-number-of-desktops - #:net-current-desktop #:net-desktop-geometry - #:net-desktop-viewport #:net-desktop-names - #:net-active-window #:net-workarea - #:net-supporting-wm-check #:net-virtual-roots + #:intern-atoms + #:net-active-window + #:net-client-list + #:net-client-list-stacking + #:net-current-desktop + #:net-desktop-geometry + #:net-desktop-layout + #:net-desktop-names + #:net-desktop-viewport #:net-frame-extents - #:net-wm-name #:net-wm-visible-name - #:net-wm-icon-name #:net-wm-visible-icon-name - #:net-wm-desktop #:net-wm-window-type - #:net-wm-state #:net-wm-strut - #:net-wm-icon-geometry #:net-wm-icon - #:net-wm-pid #:net-wm-handled-icons - #:net-wm-allowed-actions #:net-wm-strut-partial - #:net-wm-user-time #:net-wm-user-time-window - - #:intern-atoms) + #:net-number-of-desktops + #:net-showing-desktop + #:net-supported + #:net-supporting-wm-check + #:net-virtual-roots + #:net-wm-allowed-actions + #:net-wm-desktop + #:net-wm-handled-icons + #:net-wm-icon + #:net-wm-icon-geometry + #:net-wm-icon-name + #:net-wm-name + #:net-wm-pid + #:net-wm-state + #:net-wm-strut + #:net-wm-strut-partial + #:net-wm-user-time + #:net-wm-user-time-window + #:net-wm-visible-icon-name + #:net-wm-visible-name + #:net-wm-window-type + #:net-workarea + + #:make-desktop-layout + + #:desktop-layout-orientation + #:desktop-layout-starting-corner + #:desktop-layout-x + #:desktop-layout-y + ) (:documentation "This package implements the Extended Window Manager Hints (from Freedesktop.org). - version 1.4 draft2 - @@ -63,58 +86,86 @@ (compilation-speed 0))) (defconstant +exwm-atoms+ - (list "_NET_SUPPORTED" "_NET_CLIENT_LIST" - "_NET_CLIENT_LIST_STACKING" "_NET_NUMBER_OF_DESKTOPS" - "_NET_CURRENT_DESKTOP" "_NET_DESKTOP_GEOMETRY" - "_NET_DESKTOP_VIEWPORT" "_NET_DESKTOP_NAMES" - "_NET_ACTIVE_WINDOW" "_NET_WORKAREA" - "_NET_SUPPORTING_WM_CHECK" "_NET_VIRTUAL_ROOTS" - "_NET_DESKTOP_LAYOUT" - - "_NET_RESTACK_WINDOW" "_NET_REQUEST_FRAME_EXTENTS" - "_NET_MOVERESIZE_WINDOW" "_NET_CLOSE_WINDOW" + (list "_NET_ACTIVE_WINDOW" + "_NET_CLIENT_LIST" + "_NET_CLIENT_LIST_STACKING" + "_NET_CLOSE_WINDOW" + "_NET_CURRENT_DESKTOP" + "_NET_DESKTOP_GEOMETRY" + "_NET_DESKTOP_LAYOUT" + "_NET_DESKTOP_NAMES" + "_NET_DESKTOP_VIEWPORT" + "_NET_FRAME_EXTENTS" + "_NET_MOVERESIZE_WINDOW" + "_NET_NUMBER_OF_DESKTOPS" + "_NET_REQUEST_FRAME_EXTENTS" + "_NET_RESTACK_WINDOW" + "_NET_SHOWING_DESKTOP" + "_NET_SUPPORTED" + "_NET_SUPPORTING_WM_CHECK" + "_NET_VIRTUAL_ROOTS" + "_NET_WM_ALLOWED_ACTIONS" + "_NET_WM_DESKTOP" + "_NET_WM_FULL_PLACEMENT" + "_NET_WM_HANDLED_ICONS" + "_NET_WM_ICON" + "_NET_WM_ICON_GEOMETRY" + "_NET_WM_ICON_NAME" "_NET_WM_MOVERESIZE" - - "_NET_WM_SYNC_REQUEST" "_NET_WM_PING" - - "_NET_WM_NAME" "_NET_WM_VISIBLE_NAME" - "_NET_WM_ICON_NAME" "_NET_WM_VISIBLE_ICON_NAME" - "_NET_WM_DESKTOP" "_NET_WM_WINDOW_TYPE" - "_NET_WM_STATE" "_NET_WM_STRUT" - "_NET_WM_ICON_GEOMETRY" "_NET_WM_ICON" - "_NET_WM_PID" "_NET_WM_HANDLED_ICONS" - "_NET_WM_USER_TIME" "_NET_FRAME_EXTENTS" + "_NET_WM_NAME" + "_NET_WM_PID" + "_NET_WM_PING" + "_NET_WM_STATE" + "_NET_WM_STRUT" + "_NET_WM_STRUT_PARTIAL" + "_NET_WM_SYNC_REQUEST" + "_NET_WM_USER_TIME" "_NET_WM_USER_TIME_WINDOW" - "_NET_WM_FULL_PLACEMENT" - ;; "_NET_WM_MOVE_ACTIONS" - - "_NET_WM_WINDOW_TYPE_DESKTOP" "_NET_WM_STATE_MODAL" - "_NET_WM_WINDOW_TYPE_DOCK" "_NET_WM_STATE_STICKY" - "_NET_WM_WINDOW_TYPE_TOOLBAR" "_NET_WM_STATE_MAXIMIZED_VERT" - "_NET_WM_WINDOW_TYPE_MENU" "_NET_WM_STATE_MAXIMIZED_HORZ" - "_NET_WM_WINDOW_TYPE_UTILITY" "_NET_WM_STATE_SHADED" - "_NET_WM_WINDOW_TYPE_SPLASH" "_NET_WM_STATE_SKIP_TASKBAR" - "_NET_WM_WINDOW_TYPE_DIALOG" "_NET_WM_STATE_SKIP_PAGER" - "_NET_WM_WINDOW_TYPE_NORMAL" "_NET_WM_STATE_HIDDEN" - "_NET_WM_WINDOW_TYPE_DROPDOWN_MENU" "_NET_WM_STATE_FULLSCREEN" - "_NET_WM_WINDOW_TYPE_POPUP_MENU" "_NET_WM_STATE_ABOVE" - "_NET_WM_WINDOW_TYPE_TOOLTIP" "_NET_WM_STATE_BELOW" - "_NET_WM_WINDOW_TYPE_NOTIFICATION" "_NET_WM_STATE_DEMANDS_ATTENTION" - "_NET_WM_WINDOW_TYPE_COMBO" - "_NET_WM_WINDOW_TYPE_DND" - - "_NET_WM_ALLOWED_ACTIONS" - "_NET_WM_ACTION_MOVE" - "_NET_WM_ACTION_RESIZE" - "_NET_WM_ACTION_MINIMIZE" - "_NET_WM_ACTION_SHADE" - "_NET_WM_ACTION_STICK" - "_NET_WM_ACTION_MAXIMIZE_HORZ" - "_NET_WM_ACTION_MAXIMIZE_VERT" - "_NET_WM_ACTION_FULLSCREEN" - "_NET_WM_ACTION_CHANGE_DESKTOP" - "_NET_WM_ACTION_CLOSE" - + "_NET_WM_VISIBLE_ICON_NAME" + "_NET_WM_VISIBLE_NAME" + "_NET_WM_WINDOW_TYPE" + "_NET_WORKAREA" + + "_NET_WM_STATE_ABOVE" + "_NET_WM_STATE_BELOW" + "_NET_WM_STATE_DEMANDS_ATTENTION" + "_NET_WM_STATE_FULLSCREEN" + "_NET_WM_STATE_HIDDEN" + "_NET_WM_STATE_MAXIMIZED_HORZ" + "_NET_WM_STATE_MAXIMIZED_VERT" + "_NET_WM_STATE_MODAL" + "_NET_WM_STATE_SHADED" + "_NET_WM_STATE_SKIP_PAGER" + "_NET_WM_STATE_SKIP_TASKBAR" + "_NET_WM_STATE_STICKY" + + "_NET_WM_WINDOW_TYPE_COMBO" + "_NET_WM_WINDOW_TYPE_DESKTOP" + "_NET_WM_WINDOW_TYPE_DIALOG" + "_NET_WM_WINDOW_TYPE_DND" + "_NET_WM_WINDOW_TYPE_DOCK" + "_NET_WM_WINDOW_TYPE_DROPDOWN_MENU" + "_NET_WM_WINDOW_TYPE_MENU" + "_NET_WM_WINDOW_TYPE_NORMAL" + "_NET_WM_WINDOW_TYPE_NOTIFICATION" + "_NET_WM_WINDOW_TYPE_POPUP_MENU" + "_NET_WM_WINDOW_TYPE_SPLASH" + "_NET_WM_WINDOW_TYPE_TOOLBAR" + "_NET_WM_WINDOW_TYPE_TOOLTIP" + "_NET_WM_WINDOW_TYPE_UTILITY" + + "_NET_WM_ACTION_ABOVE" + "_NET_WM_ACTION_BELOW" + "_NET_WM_ACTION_CHANGE_DESKTOP" + "_NET_WM_ACTION_CLOSE" + "_NET_WM_ACTION_FULLSCREEN" + "_NET_WM_ACTION_MAXIMIZE_HORZ" + "_NET_WM_ACTION_MAXIMIZE_VERT" + "_NET_WM_ACTION_MINIMIZE" + "_NET_WM_ACTION_MOVE" + "_NET_WM_ACTION_RESIZE" + "_NET_WM_ACTION_SHADE" + "_NET_WM_ACTION_STICK" )) ;; General initialisation @@ -272,6 +323,7 @@ ;; _NET_SHOWING_DESKTOP (defun net-showing-desktop (window) + "Returns T if the window manager is in 'showing desktop' mode." (= 1 (the card-32 (first (get-property window :_NET_SHOWING_DESKTOP))))) (defsetf net-showing-desktop (window) (mode-p) From ihatchondo at common-lisp.net Tue Apr 27 08:12:20 2010 From: ihatchondo at common-lisp.net (ihatchondo) Date: Tue, 27 Apr 2010 04:12:20 -0400 Subject: [Eclipse-cvs] CVS eclipse Message-ID: Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv28215 Modified Files: global.lisp Log Message: Fix: pathname different behaviour. --- /project/eclipse/cvsroot/eclipse/global.lisp 2010/04/23 14:36:49 1.37 +++ /project/eclipse/cvsroot/eclipse/global.lisp 2010/04/27 08:12:20 1.38 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: global.lisp,v 1.37 2010/04/23 14:36:49 ihatchondo Exp $ +;;; $Id: global.lisp,v 1.38 2010/04/27 08:12:20 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2001, 2002 Iban HATCHONDO @@ -256,7 +256,22 @@ (defun file-exists-p (filename) "Returns true if the given filename is an existing file and not a directory." (and #+clisp (not (probe-directory (make-pathname :directory filename))) - #-clisp (not (probe-file (make-pathname :directory filename))) + #-clisp (let ((pathname (probe-file (make-pathname :directory filename)))) + ;; When NIL is returned by probe-file, it indicates that NO + ;; directory exists under this filename. + ;; But when a valid pathname is returned, it does not + ;; necessarily indicate that it is a directory. + ;; In this case, one needs to check if the returned pathname + ;; has a type or a name, what a directory pathname doesn't + ;; have. + ;; This last case concerns systems like SBCL, while the former + ;; case corresponds at least to CMUCL. + (if pathname + (let ((name (pathname-name pathname)) + (type (pathname-type pathname))) + (or (and type (not (eql type :unspecific))) + (and name (not (eql type :unspecific))))) + t)) (probe-file filename))) ;;;; Error handler. From ihatchondo at common-lisp.net Tue Apr 27 08:43:10 2010 From: ihatchondo at common-lisp.net (ihatchondo) Date: Tue, 27 Apr 2010 04:43:10 -0400 Subject: [Eclipse-cvs] CVS eclipse Message-ID: Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv3812 Modified Files: global.lisp Log Message: Fix: missing condition ... --- /project/eclipse/cvsroot/eclipse/global.lisp 2010/04/27 08:12:20 1.38 +++ /project/eclipse/cvsroot/eclipse/global.lisp 2010/04/27 08:43:10 1.39 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: global.lisp,v 1.38 2010/04/27 08:12:20 ihatchondo Exp $ +;;; $Id: global.lisp,v 1.39 2010/04/27 08:43:10 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2001, 2002 Iban HATCHONDO @@ -168,6 +168,15 @@ ;;;; System dependent functions. +(define-condition not-implemented (error) + ((proc :initarg :proc)) + (:report (lambda (condition stream) + (format stream + "Function ~a is not yet implemented on ~a release ~a~%" + (slot-value condition 'proc) + (lisp-implementation-type) + (lisp-implementation-version))))) + (defun quit (&optional code) #+allegro (excl:exit code) #+clisp (#+lisp=cl ext:quit #-lisp=cl lisp:quit code) @@ -191,6 +200,8 @@ #+:lispworks (foreign:call-system-showing-output (format nil "~A~@[ ~{~A~^ ~}~]" program arguments)) #+clisp (ext:run-program program :arguments arguments :wait nil) + #-(or lucid allegro KCL cmu sbcl lispworks clisp) + (error 'not-implemented :proc (list 'run-program arguments)) ) (defun get-username ()