Commit ced908e6 authored by Iban Hatchondo's avatar Iban Hatchondo
Browse files

added the connection to the session-manager using the xsmp protocol.

widgets.lisp
 root-widget now has a new slot named sm-conn.
 close-sm-connection [ function ] root-widget
  close the connection with the session manager.

eclipse.lisp
 Initialize the connection to the session manager.
 The main function eclipse signature changes. It now takes two keyword arguments of type (or null string): display sm-client-id.

 new functions:

 get-username [ function ]
  returns the usename string.

 sm-init [ function ] sm-conn dpy-string
  Sets the xsmp properties that are required by the protocols.

 connect-to-session-manager [ function ] dpy-name &optional previous-id
  Try to connect us to the session manager. If connected set xsmp
  properties and returns the sm-connection instance.

 handle-session-manager-request [ function ] sm-conn root-widget
  Handles xsmp requests. If a DIE request is received then invoke
  close-sm-connection and propagate the exit-eclipse condition.

system.lisp
 added ice and sm system loading and dependance.

load-eclipse.lisp.in
 the start function signature changes to be the same as eclipse (in eclipse.lisp)

*.in & configure
 slight changes to handle the new starting signature and parameters.

docs/eclipse.1
 updated.
parent 40f959dd
This diff is collapsed.
# $Id: configure.in,v 1.4 2003/04/07 13:35:32 hatchond Exp $
# $Id: configure.in,v 1.5 2003/09/04 11:53:52 hatchond Exp $
AC_INIT()
eclipsedir=${libdir}/eclipse
......@@ -99,10 +99,10 @@ gnome_entry_dir=${clwm_cv_gnome_entry_dir}
if test ! ${usecore} = no
then
ARGS="${with_image} ${COREDIR}/${CORENAME}\
${eval_form} \"(eclipse:eclipse \${display_spec})\""
${eval_form} \"(eclipse:eclipse \${options})\""
else
ARGS="${INITCORE} ${load_switch} ${SRC}/load-eclipse.lisp ${eval_form}\
\"(start \${display_spec})\""
\"(start \${options})\""
fi
# set interp.
......
.TH Eclipse 1 "(c) 2001 Iban HATCHONDO"
.\"$Id: eclipse.1,v 1.10 2003/12/02 19:07:07 ihatchondo Exp $
.\"$Id: eclipse.1,v 1.11 2004/01/07 11:21:42 ihatchondo Exp $
.SH NAME
eclipse - a window manager in Common Lisp
.SH SYNOPSIS
.B eclipse [ display specification ]
.B eclipse [ --display=display_specification --sm-client-id=id ]
.SH DESCRIPTION
......
@interp@ @SHELL@
# $Id: eclipse.in,v 1.4 2003/04/07 13:35:32 hatchond Exp $
# $Id: eclipse.in,v 1.5 2004/01/09 13:36:49 ihatchondo Exp $
#
# @configure_input@
# This file starts the eclipse window manager
display_spec=`if [ -n "$1" ]; then echo \"$1\"; fi`
usage () {
printf "\nusage: eclipse [ --display=dpy ] [ --sm-client-id=id ]\n\n";
exit 1;
}
display_spec=""
sm_client_id=""
options=""
## Parse and collect options.
if [ $# -ne 0 -a $# -gt 2 ] ; then usage ; fi
while [ $# -gt 0 ] ; do
case "$1" in
--display=*)
tmp=`echo $1 | cut -d'=' -f2`
display_spec=":display \"$tmp\"" ;
shift ;
;;
--sm-client-id=*)
tmp=`echo $1 | cut -d'=' -f2`
sm_client_id=":sm-client-id \"$tmp\"";
shift ;
;;
-* | *)
printf "\n $1 unknow option \n";
usage ;;
esac
done
options="$display_spec $sm_client_id"
##
if [ -d @SRC@ ] ; then
cd @SRC@
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: eclipse.lisp,v 1.13 2003/12/03 14:34:34 ihatchondo Exp $
;;; $Id: eclipse.lisp,v 1.14 2004/01/06 17:02:06 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -27,6 +27,63 @@
;;; Initializations and Main.
;; ICE & SM.
(defun get-username ()
"Returns the real user name (a string) associated with the current process."
#+sbcl (sb-unix:uid-username (sb-unix:unix-getuid))
#+cmu (unix:user-info-name (unix:unix-getpwuid (unix:unix-getuid)))
#+allegro-v6.2 (excl.osi:pwent-name (excl.osi:getpwent (excl.osi:getuid)))
#-(or sbcl cmu allegro-v6.2) "nobody")
(defun sm-init (sm-conn dpy)
"Sets the xsmp properties that are required by the protocols."
(declare (type (or null string) dpy))
(flet ((encode (&rest rest)
(loop for s in rest collect (map 'sm-lib:array8 #'char-code s))))
(let ((sm-client-id (sm-lib:sm-client-id sm-conn)))
(ice-lib:post-request :set-properties sm-conn
:properties
(list (sm-lib:make-property
:name "CloneCommand"
:type "LISTofARRAY8"
:values
(if dpy (encode "eclipse" "--display" dpy) (encode "eclipse")))
(sm-lib:make-property
:name "Program"
:type "ARRAY8"
:values (encode "eclipse"))
(sm-lib:make-property
:name "RestartCommand"
:type "LISTofARRAY8"
:values (encode "eclipse" "--sm-client-id" sm-client-id))
(sm-lib:make-property
:name "UserID"
:type "ARRAY8"
:values (encode (get-username))))))))
(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."
(handler-case
(let ((sm-conn (sm-lib:open-sm-connection :previous-id previous-id)))
(sm-init sm-conn dpy-name)
sm-conn)
(error (condition) (format *error-output* "~&~A~&" condition))))
(defun handle-session-manager-request (sm-conn root-widget)
"Handles xsmp requests. If a DIE request is received then invoke
close-sm-connection and propagate the exit-eclipse condition."
(handler-case
(ice-lib::request-case (sm-conn :timeout 0)
(sm-lib:save-yourself ()
(ice-lib:post-request :save-yourself-done sm-conn :success-p t)
t)
(sm-lib:die () (close-sm-connection root-widget) t)
(t t))
(exit-eclipse () (error 'exit-eclipse))
(error (condition) (format *error-output* "~&~A~&" condition))))
;; ICCCM section 2.8
(defun initialize-manager (display root-window)
(setf +xa-wm+ (format nil "WM_S~A" (xlib:display-display display)))
......@@ -110,7 +167,7 @@
(list (screen-width) (screen-height))
)))
(defun initialize (display-specification)
(defun initialize (display-specification sm-client-id)
(multiple-value-bind (display screen)
(open-clx-display display-specification)
(let* ((colormap (xlib:screen-default-colormap screen))
......@@ -123,7 +180,9 @@
(xlib:display-after-function display) #'xlib:display-force-output)
(setf *root* (make-instance 'root :window root-window :manager manager)
*root-window* root-window
(root-default-cursor *root*) (get-x-cursor *display* :xc_left_ptr))
(root-default-cursor *root*) (get-x-cursor *display* :xc_left_ptr)
(root-sm-conn *root*)
(connect-to-session-manager display-specification sm-client-id))
;; init all gnome properties on root.
(init-gnome-compliance display root-window manager)
(ppm:initialize colormap)
......@@ -152,8 +211,9 @@
(unless (root-decoration-theme *root*)
(setf (decoration-theme) "microGUI")))))
(defun eclipse (&optional display-specification)
(initialize display-specification)
(defun eclipse (&key display sm-client-id)
(declare (type (or null string) display sm-client-id))
(initialize display sm-client-id)
;(init-log-file)
;; Create a socket connection to communicate with the window manager.
......
;;; -*- Mode: Lisp; Package: User -*-
;;; $Id: load-eclipse.lisp.in,v 1.4 2003/03/15 23:22:38 hatchond Exp $
;;; $Id: load-eclipse.lisp.in,v 1.5 2003/04/07 13:35:32 hatchond Exp $
;;;
;;; @configure_input@
;;; watch out before modify it.
......@@ -14,9 +14,8 @@
(load "@SRC@/system.lisp")
(operate-on-system :eclipse :load))
(defun start (&optional display-specification)
(handler-bind ((error #'(lambda (condition)
(format *error-output* "~A~%" condition)
(eclipse::%quit%))))
(eclipse:eclipse display-specification)
))
(defun start (&key display sm-client-id)
(handler-case (eclipse:eclipse :display display :sm-client-id sm-client-id)
(error (condition)
(format *error-output* "~A~%" condition)
(eclipse::%quit%))))
;;; -*- Mode: Lisp; Package: User -*-
;;; $Id: system.lisp,v 1.7 2003/11/10 10:02:53 ihatchondo Exp $
;;; $Id: system.lisp,v 1.8 2003/11/24 16:57:46 ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -32,6 +32,10 @@
#+:excl(require :loop)
#+mk-defsystem (use-package "MK")
;; for session management & connection
(load "lib/ice/system.lisp")
(load "lib/sm/system.lisp")
(defmacro eclipse-defsystem ((module &key depends-on) &rest components)
`(defsystem ,module #-mk-defsystem ()
#+mk-defsystem :source-pathname *eclipse-src-directory*
......@@ -61,7 +65,7 @@
"lib/gnome-manager"
)
(eclipse-defsystem (:eclipse :depends-on (:clx-ext :eclipse-lib))
(eclipse-defsystem (:eclipse :depends-on (:clx-ext :eclipse-lib :sm-lib))
"config.lisp"
"programmed-tasks"
"package"
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.24 2003/12/04 16:12:42 ihatchondo Exp $
;;; $Id: widgets.lisp,v 1.25 2004/01/12 10:57:58 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -139,7 +139,8 @@
(menu3 :initform nil)
(window-menu :initform nil)
(client-list :initform (make-hash-table))
(desktop :initform nil :accessor root-desktop)))
(desktop :initform nil :accessor root-desktop)
(sm-conn :initform nil :accessor root-sm-conn)))
(defmethod root-manager ((root root))
(slot-value root 'properties-manager-window))
......@@ -168,6 +169,15 @@
current-active-decoration nil)
(xlib:ungrab-pointer *display*))))
(defun close-sm-connection (root)
(with-slots (sm-conn) root
(ice-lib:post-request :connection-closed sm-conn)
(ice-lib:ice-flush sm-conn)
(close (ice-lib:connection-stream sm-conn))
(setf sm-conn nil)
(setf *close-display-p* nil)
(error 'exit-eclipse)))
;;;; Application
(defconstant +application-mask+
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: wm.lisp,v 1.27 2003/12/02 21:59:29 ihatchondo Exp $
;;; $Id: wm.lisp,v 1.28 2004/01/06 17:02:06 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -757,6 +757,8 @@
(with-slots (event-window) event
(event-process event (lookup-widget event-window))))
(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 (when *close-display-p*
(loop for val being each hash-value in *widget-table*
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment