[Eclipse-cvs] CVS eclipse
ihatchondo
ihatchondo at common-lisp.net
Mon Feb 23 00:00:36 UTC 2009
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))))
More information about the Eclipse-cvs
mailing list