From ihatchondo at common-lisp.net Fri Feb 20 18:03:55 2009 From: ihatchondo at common-lisp.net (ihatchondo) Date: Fri, 20 Feb 2009 18:03:55 +0000 Subject: [Eclipse-cvs] CVS eclipse Message-ID: Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv3688 Modified Files: input.lisp Log Message: Fix: invalid use of window type attribute that leads to impropoer workarea computations. --- /project/eclipse/cvsroot/eclipse/input.lisp 2008/08/29 14:57:47 1.52 +++ /project/eclipse/cvsroot/eclipse/input.lisp 2009/02/20 18:03:55 1.53 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: input.lisp,v 1.52 2008/08/29 14:57:47 ihatchondo Exp $ +;;; $Id: input.lisp,v 1.53 2009/02/20 18:03:55 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -352,7 +352,7 @@ (setf item-to-draw (wm-name (widget-window app))) (xlib:queue-event *display* :exposure :window window :count 0)))) ((:_net_wm_strut_partial :_net_wm_strut) - (when (eq type :_net_wm_window_type_dock) + (when (member :_net_wm_window_type_dock type) (update-workarea-property *root*))) (:wm_state (update-lists app (car (wm-state window)) *root*)) (:wm_transient_for (computes-transient-for app))))) From ihatchondo at common-lisp.net Fri Feb 20 18:05:16 2009 From: ihatchondo at common-lisp.net (ihatchondo) Date: Fri, 20 Feb 2009 18:05:16 +0000 Subject: [Eclipse-cvs] CVS eclipse Message-ID: Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv3762 Modified Files: widgets.lisp Log Message: Fix: transient-for proposerty handling. When a window was changing of leader, it wasn't removed from its previous leader. --- /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/25 16:02:49 1.55 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2009/02/20 18:05:16 1.56 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.55 2008/04/25 16:02:49 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.56 2009/02/20 18:05:16 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -200,8 +200,9 @@ (initial-geometry :initform (make-geometry) :initarg :initial-geometry) (full-geometry :initform (make-geometry) :initarg :full-geometry) (type :initarg :type :accessor application-type) - (transient-for :initarg :transient-for :accessor application-transient-for) - (dialogs :initform nil :writer (setf application-dialogs)))) + (dialogs :initform nil :writer (setf application-dialogs)) + (transient-for :initform nil :initarg :transient-for + :accessor application-transient-for))) (defmethod application-dialogs ((application application)) "Returns all dialog applications of an application (including dialog of a @@ -474,10 +475,12 @@ the dialogs list of its leader." (with-slots (transient-for (win window)) application (let ((transient (lookup-widget (ignore-errors (xlib:transient-for win))))) - (setf transient-for - (when (and transient (not (eq *root* transient))) - (push application (slot-value transient 'dialogs)) - transient))))) + (when (and transient (not (eq *root* transient))) + (pushnew application (slot-value transient 'dialogs))) + (when (and transient-for (not (equal transient-for transient))) + (with-slots (dialogs) transient-for + (setf dialogs (delete application dialogs)))) + (setf transient-for transient)))) (defun find-input-model (window) "Returns the input model keyword of this window according to ICCCM (4.1.7)." From ihatchondo at common-lisp.net Fri Feb 20 18:07:01 2009 From: ihatchondo at common-lisp.net (ihatchondo) Date: Fri, 20 Feb 2009 18:07:01 +0000 Subject: [Eclipse-cvs] CVS eclipse Message-ID: Update of /project/eclipse/cvsroot/eclipse In directory cl-net:/tmp/cvs-serv3948 Modified Files: configure widgets.lisp Log Message: Fix: indentation --- /project/eclipse/cvsroot/eclipse/configure 2006/01/14 15:40:54 1.12 +++ /project/eclipse/cvsroot/eclipse/configure 2009/02/20 18:07:01 1.13 @@ -1,25 +1,54 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.59. +# Generated by GNU Autoconf 2.61. # -# Copyright (C) 2003 Free Software Foundation, Inc. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## -# Be Bourne compatible +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' -elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then - set -o posix + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + + + +# PATH needs CR +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh fi -DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then @@ -29,8 +58,43 @@ fi +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +as_nl=' +' +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + { (exit 1); exit 1; } +fi + # Work around bugs in pre-3.0 UWIN ksh. -$as_unset ENV MAIL MAILPATH +for as_var in ENV MAIL MAILPATH +do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var +done PS1='$ ' PS2='> ' PS4='+ ' @@ -44,18 +108,19 @@ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else - $as_unset $as_var + ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. -if expr a : '\(a\)' >/dev/null 2>&1; then +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi -if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false @@ -63,157 +128,388 @@ # Name of the executable. -as_me=`$as_basename "$0" || +as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)$' \| \ - . : '\(.\)' 2>/dev/null || + X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } - /^X\/\(\/\/\)$/{ s//\1/; q; } - /^X\/\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` +# CDPATH. +$as_unset CDPATH -# PATH needs CR, and LINENO needs CR and PATH. -# Avoid depending upon Character Ranges. -as_cr_letters='abcdefghijklmnopqrstuvwxyz' -as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -as_cr_Letters=$as_cr_letters$as_cr_LETTERS -as_cr_digits='0123456789' -as_cr_alnum=$as_cr_Letters$as_cr_digits -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - echo "#! /bin/sh" >conf$$.sh - echo "exit 0" >>conf$$.sh - chmod +x conf$$.sh - if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then - PATH_SEPARATOR=';' - else - PATH_SEPARATOR=: - fi - rm -f conf$$.sh +if test "x$CONFIG_SHELL" = x; then + if (eval ":") 2>/dev/null; then + as_have_required=yes +else + as_have_required=no +fi + + if test $as_have_required = yes && (eval ": +(as_func_return () { + (exit \$1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. fi +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi - as_lineno_1=$LINENO - as_lineno_2=$LINENO - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" || { - # Find who we are. Look in the path if we contain no path at all - # relative or not. - case $0 in - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break -done +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi - ;; - esac - # We did not find ourselves, most probably we were run as `sh COMMAND' - # in which case we are not to be found in the path. - if test "x$as_myself" = x; then - as_myself=$0 - fi - if test ! -f "$as_myself"; then - { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 - { (exit 1); exit 1; }; } - fi - case $CONFIG_SHELL in - '') +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = \"\$1\" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test \$exitcode = 0) || { (exit 1); exit 1; } + +( + as_lineno_1=\$LINENO + as_lineno_2=\$LINENO + test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && + test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } +") 2> /dev/null; then + : +else + as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for as_base in sh bash ksh sh5; do - case $as_dir in + case $as_dir in /*) - if ("$as_dir/$as_base" -c ' + for as_base in sh bash ksh sh5; do + as_candidate_shells="$as_candidate_shells $as_dir/$as_base" + done;; + esac +done +IFS=$as_save_IFS + + + for as_shell in $as_candidate_shells $SHELL; do + # Try only shells that exist, to save several forks. + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { ("$as_shell") 2> /dev/null <<\_ASEOF +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + +: +_ASEOF +}; then + CONFIG_SHELL=$as_shell + as_have_required=yes + if { "$as_shell" 2> /dev/null <<\_ASEOF +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + +: +(as_func_return () { + (exit $1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = "$1" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test $exitcode = 0) || { (exit 1); exit 1; } + +( as_lineno_1=$LINENO as_lineno_2=$LINENO - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then - $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } - $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } - CONFIG_SHELL=$as_dir/$as_base - export CONFIG_SHELL - exec "$CONFIG_SHELL" "$0" ${1+"$@"} - fi;; [3026 lines skipped] --- /project/eclipse/cvsroot/eclipse/widgets.lisp 2009/02/20 18:05:16 1.56 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2009/02/20 18:07:01 1.57 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.56 2009/02/20 18:05:16 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.57 2009/02/20 18:07:01 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -477,9 +477,9 @@ (let ((transient (lookup-widget (ignore-errors (xlib:transient-for win))))) (when (and transient (not (eq *root* transient))) (pushnew application (slot-value transient 'dialogs))) - (when (and transient-for (not (equal transient-for transient))) - (with-slots (dialogs) transient-for - (setf dialogs (delete application dialogs)))) + (when (and transient-for (not (equal transient-for transient))) + (with-slots (dialogs) transient-for + (setf dialogs (delete application dialogs)))) (setf transient-for transient)))) (defun find-input-model (window) From ihatchondo at common-lisp.net Sun Feb 22 23:56:47 2009 From: ihatchondo at common-lisp.net (ihatchondo) Date: Sun, 22 Feb 2009 23:56:47 +0000 Subject: [Eclipse-cvs] CVS eclipse/lib/sm Message-ID: Update of /project/eclipse/cvsroot/eclipse/lib/sm In directory cl-net:/tmp/cvs-serv10345/lib/sm Modified Files: package.lisp sm.lisp Log Message: Add: constant names for predefined property names and types (section 11 of xsmp). --- /project/eclipse/cvsroot/eclipse/lib/sm/package.lisp 2005/12/06 13:52:49 1.9 +++ /project/eclipse/cvsroot/eclipse/lib/sm/package.lisp 2009/02/22 23:56:46 1.10 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: COMMON-LISP; -*- -;;; $Id: package.lisp,v 1.9 2005/12/06 13:52:49 ihatchondo Exp $ +;;; $Id: package.lisp,v 1.10 2009/02/22 23:56:46 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: SM Library ;;; Created: 2004 01 15 15:28 @@ -134,6 +134,27 @@ #:+sm-proto-major+ #:+sm-proto-minor+ + #:+clone-command+ + #:+current-directory+ + #:+discard-command+ + #:+environment+ + #:+process-id+ + #:+program+ + #:+restart-command+ + #:+resign-command+ + #:+restart-style-hint+ + #:+shutdown-command+ + #:+user-id+ + + #:+restart-if-running+ + #:+restart-anyway+ + #:+restart-immediately+ + #:+restart-never+ + + #:+list-of-array8+ + #:+array8+ + #:+card8+ + ;; macros. #:buffer-read-array8 #:buffer-read-array8s --- /project/eclipse/cvsroot/eclipse/lib/sm/sm.lisp 2005/12/06 13:52:49 1.12 +++ /project/eclipse/cvsroot/eclipse/lib/sm/sm.lisp 2009/02/22 23:56:46 1.13 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: SM-LIB; -*- -;;; $Id: sm.lisp,v 1.12 2005/12/06 13:52:49 ihatchondo Exp $ +;;; $Id: sm.lisp,v 1.13 2009/02/22 23:56:46 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: SM Library ;;; Created: 2004 01 15 15:28 @@ -34,6 +34,74 @@ (defconstant +release-name+ "CL-SM-1.0") (defconstant +vendor-name+ "LoopFor & Mapcar corp") +#| XSMP 11. Predefined Properties + +All property values are stored in a LISTofARRAY8. If the +type of the property is CARD8, the value is stored as a +LISTofARRAY8 with one ARRAY8 that is one byte long. That +single byte contains the CARD8. If the type of the property +is ARRAY8, the value is stored in the first element of a +single element LISTofARRAY8. + +The required properties must be set each time a client con- +nects with the SM. The properties must be set after the +client sends RegisterClient and before the client sends +SaveYourselfDone. Otherwise, the behavior of the session +manager is not defined. + +Clients may set, get, and delete nonstandard properties. +The lifetime of stored properties does not extend into sub- +sequent sessions. + +---------------------------------------------------------- +Name Type Posix Type Required? +---------------------------------------------------------- +CloneCommand OS-specific LISTofARRAY8 Yes +CurrentDirectory OS-specific ARRAY8 No +DiscardCommand OS-specific LISTofARRAY8 No* +Environment OS-specific LISTofARRAY8 No +ProcessID OS-specific ARRAY8 No +Program OS-specific ARRAY8 Yes +RestartCommand OS-specific LISTofARRAY8 Yes +ResignCommand OS-specific LISTofARRAY8 No +RestartStyleHint CARD8 CARD8 No +ShutdownCommand OS-specific LISTofARRAY8 No +UserID ARRAY8 ARRAY8 Yes +---------------------------------------------------------- +|# + +(defconstant +clone-command+ "CloneCommand") +(defconstant +current-directory+ "CurrentDirectory") +(defconstant +discard-command+ "DiscardCommand") +(defconstant +environment+ "Environment") +(defconstant +process-id+ "ProcessID") +(defconstant +program+ "Program") +(defconstant +restart-command+ "RestartCommand") +(defconstant +resign-command+ "ResignCommand") +(defconstant +restart-style-hint+ "RestartStyleHint") +(defconstant +shutdown-command+ "ShutdownCommand") +(defconstant +user-id+ "UserID") + +#| +--------------------------- +Name Value +--------------------------- +RestartIfRunning 0 +RestartAnyway 1 +RestartImmediately 2 +RestartNever 3 +--------------------------- +|# + +(defconstant +restart-if-running+ 0) +(defconstant +restart-anyway+ 1) +(defconstant +restart-immediately+ 2) +(defconstant +restart-never+ 3) + +(defconstant +list-of-array8+ "LISTofARRAY8") +(defconstant +array8+ "ARRAY8") +(defconstant +card8+ "CARD8") + ;;;; Types. (deftype interact-style () `(member :none :errors :any)) From ihatchondo at common-lisp.net Mon Feb 23 00:00:36 2009 From: ihatchondo at common-lisp.net (ihatchondo) Date: Mon, 23 Feb 2009 00:00:36 +0000 Subject: [Eclipse-cvs] CVS eclipse Message-ID: 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))))