Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv14823

Modified Files: misc.lisp global.lisp eclipse.lisp Log Message: Fix: session management connection: the window manager has to send the value of DESKTOP_AUTOSTART_ID env variable when no client-id has been provided on its command line. Fix: minor hacking around implementation dependent functions.

--- /project/eclipse/cvsroot/eclipse/misc.lisp 2008/04/28 12:29:39 1.43 +++ /project/eclipse/cvsroot/eclipse/misc.lisp 2009/02/23 00:00:35 1.44 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: misc.lisp,v 1.43 2008/04/28 12:29:39 ihatchondo Exp $ +;;; $Id: misc.lisp,v 1.44 2009/02/23 00:00:35 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -64,6 +64,7 @@ (declare (ignorable condition)) ,@(when verbose `((format *stderr* "error - ~A - : ~A~%" ',type condition) + ;; #+cmu (debug::backtrace) (finish-output *stderr*))) ,(unless return `(throw ',(or throw type) ,@(or body '(nil))))))

@@ -428,7 +429,7 @@ run the program named `program' with arguments `arguments'. If the invocation failed a pop-up window will appear reporting the error." (lambda () - (handler-case (%run-program% program arguments) + (handler-case (run-program program arguments) (error () (timed-message-box *root-window* "Wrong application name")))))

(defun eclipse-desktop-pointer-positions (window &optional desk-num) --- /project/eclipse/cvsroot/eclipse/global.lisp 2008/08/29 14:57:47 1.32 +++ /project/eclipse/cvsroot/eclipse/global.lisp 2009/02/23 00:00:35 1.33 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: global.lisp,v 1.32 2008/08/29 14:57:47 ihatchondo Exp $ +;;; $Id: global.lisp,v 1.33 2009/02/23 00:00:35 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2001, 2002 Iban HATCHONDO @@ -169,7 +169,7 @@

;;;; System dependent functions.

-(defun %quit% (&optional code) +(defun quit (&optional code) #+allegro (excl:exit code) #+clisp (#+lisp=cl ext:quit #-lisp=cl lisp:quit code) #+cmu (unix:unix-exit (or code 0)) @@ -182,7 +182,7 @@ (error 'not-implemented :proc (list 'quit code)) )

-(defun %run-program% (program arguments) +(defun run-program (program arguments) #+:lucid (run-program program :arguments arguments) #+:allegro (excl:run-shell-command (format nil "~A~@[ ~{~A~^ ~}~]" program arguments)) @@ -202,6 +202,59 @@ #+allegro-v6.2 (excl.osi:pwent-name (excl.osi:getpwent (excl.osi:getuid))) #-(or sbcl cmu allegro-v6.2) "nobody")

+(defun getenv (var) + "Returns shell environment variable named var." + #+allegro (sys::getenv (string var)) + #+clisp (ext:getenv (string var)) + #+(or cmu scl) + (cdr (assoc (string var) ext:*environment-list* :test #'equalp + :key #'string)) + #+gcl (si:getenv (string var)) + #+lispworks (lw:environment-variable (string var)) + #+lucid (lcl:environment-variable (string var)) + #+mcl (ccl::getenv var) + #+sbcl (sb-posix:getenv (string var)) + #-(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)) + #+clisp (setf (ext:getenv (string var)) (string val)) + #+(or cmu scl) + (let ((cell (assoc (string var) ext:*environment-list* :test #'equalp + :key #'string))) + (if cell + (setf (cdr cell) (string val)) + (push (cons (intern (string var) "KEYWORD") (string val)) + ext:*environment-list*))) + #+gcl (si:setenv (string var) (string val)) + #+lispworks (setf (lw:environment-variable (string var)) (string val)) + #+lucid (setf (lcl:environment-variable (string var)) (string val)) + #+sbcl (sb-posix:putenv (format nil "~A=~A" (string var) (string val))) + #-(or allegro clisp cmu gcl lispworks lucid sbcl scl) + (error 'not-implemented :proc (list '(setf getenv) var))) + +(defun getpid () + "Returns the unix process-id of the current lisp process." + #+cmu (unix:unix-getpid) + #+sbcl (sb-posix:getpid) + #+allegro (excl::getpid) + #+mcl (ccl::getpid) + #+clisp (let ((getpid (or (find-symbol "PROCESS-ID" :system) + ;; old name prior to 2005-03-01, clisp <= 2.33.2 + (find-symbol "PROGRAM-ID" :system) + #+win32 ; integrated into the above since 2005-02-24 + (and (find-package :win32) ; optional modules/win32 + (find-symbol "GetCurrentProcessId" :win32))))) + (funcall getpid)) + #-(or cmu sbcl allegro clisp) -1) + +(defun user-homedir () + #+cmu (extensions:unix-namestring (user-homedir-pathname)) + #-cmu (namestring (user-homedir-pathname))) + ;;;; Error handler. ;; The X errors handler. ;; For debug purpose: it use *stderr* as output stream. @@ -227,5 +280,6 @@ (format *stderr* "Dead window removed from table~%")) (when (member resource-id (netwm:net-client-list *root-window*)) (remove-window-from-client-lists resource *root*))))) + ;; #+cmu (debug::backtrace) (finish-output *stderr*) (error 'already-handled-xerror)) --- /project/eclipse/cvsroot/eclipse/eclipse.lisp 2008/04/25 16:02:49 1.27 +++ /project/eclipse/cvsroot/eclipse/eclipse.lisp 2009/02/23 00:00:36 1.28 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: eclipse.lisp,v 1.27 2008/04/25 16:02:49 ihatchondo Exp $ +;;; $Id: eclipse.lisp,v 1.28 2009/02/23 00:00:36 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -30,33 +30,59 @@ "Sets the xsmp properties that are required by the protocols." (declare (type (or null string) dpy)) (let ((id (format nil "--sm-client-id=~a" (sm-lib:sm-client-id sm-conn))) - (display (format nil "--display=~a" dpy))) + (display (when dpy (format nil "--display=~a" dpy)))) (ice-lib:post-request :set-properties sm-conn :properties (list (sm-lib:make-property - :name "CloneCommand" - :type "LISTofARRAY8" - :values (cons (sm-lib:string->array8 "eclipse") - (when dpy (sm-lib:strings->array8s display)))) - (sm-lib:make-property - :name "Program" - :type "ARRAY8" + :name sm-lib:+program+ + :type sm-lib:+ARRAY8+ :values (sm-lib:strings->array8s "eclipse")) (sm-lib:make-property - :name "RestartCommand" - :type "LISTofARRAY8" - :values (sm-lib:strings->array8s "eclipse" id)) + :name sm-lib:+user-id+ + :type sm-lib:+array8+ + :values (sm-lib:strings->array8s (get-username))) + (sm-lib:make-property + :name sm-lib:+restart-style-hint+ + :type sm-lib:+card8+ + ;; RestartImmediately + :values (list (sm-lib:make-array8 1 :initial-element 2))) + (sm-lib:make-property + :name sm-lib:+process-id+ + :type sm-lib:+array8+ + :values (sm-lib:strings->array8s (format nil "~a" (getpid)))) + (sm-lib:make-property + :name sm-lib:+current-directory+ + :type sm-lib:+array8+ + :values (sm-lib:strings->array8s (user-homedir))) + (sm-lib:make-property + :name sm-lib:+clone-command+ + :type sm-lib:+list-of-array8+ + :values (if display + (sm-lib:strings->array8s "eclipse" display) + (sm-lib:strings->array8s "eclipse"))) (sm-lib:make-property - :name "UserID" - :type "ARRAY8" - :values (sm-lib:strings->array8s (get-username))))))) + :name sm-lib:+restart-command+ + :type sm-lib:+list-of-array8+ + :values (if display + (sm-lib:strings->array8s "eclipse" display id) + (sm-lib:strings->array8s "eclipse" id))) + ;; Only for Gnome Session Manager + (sm-lib:make-property + :name "_GSM_Priority" + :type sm-lib:+card8+ + :values (list (sm-lib:make-array8 1 :initial-element 20)))))))

(defun connect-to-session-manager (dpy-name &optional previous-id) "Try to connect us to the session manager. If connected set xsmp properties and returns the sm-connection instance." + (unless previous-id + (setf previous-id (getenv "DESKTOP_AUTOSTART_ID")) + ;; unset $DESKTOP_AUTOSTART_ID in order to avoid + ;; child processes to use the same client id. + (setf (getenv "DESKTOP_AUTOSTART_ID") "")) (handler-case (let ((sm-conn (sm-lib:open-sm-connection :previous-id previous-id))) - (sm-init sm-conn dpy-name) + (sm-init sm-conn dpy-name) sm-conn) (error (condition) (format *error-output* "~&~A~&" condition))))

@@ -71,7 +97,9 @@ (sm-lib:die () (close-sm-connection root-widget :exit-p t) nil) (t t)) (exit-eclipse (condition) (signal condition)) - (error (condition) (format *error-output* "~&~A~&" condition)))) + (error (condition) + #+cmu (debug::backtrace) + (format *error-output* "~&~A~&" condition))))

(defun initialize-manager (display root-window) ;; ICCCM section 2.8 @@ -224,7 +252,7 @@ (handler-case (initialize display sm-client-id) (error (condition) (format *error-output* "~A~%" condition) - (%quit%))) + (quit))) (initialize display sm-client-id)) (when activate-log (init-log-file)) @@ -248,4 +276,4 @@ (progn (ignore-errors (xlib:close-display *display*)) (format t "Eclipse exited. Bye.~%") - (%quit%)))) + (quit))))