diff --git a/Makefile b/Makefile
index 56074e451c21a2f8ee07d4a2863379dac279e589..feb8411534694592499e10698b775b48a5371427 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile,v 1.40 92/07/27 19:30:11 cer Exp Locker: cer $
+# $fiHeader: Makefile,v 1.41 92/08/18 17:26:27 cer Exp Locker: cer $
 # 
 #  Makefile for CLIM 2.0
 #
@@ -33,11 +33,14 @@ LOAD_XREF_INFO=nil
 # Lisp optimization for compiling
 SPEED	= 3
 SAFETY	= 1
+# This next should be set to 1 for distribution
+DEBUG   = 2
 
 CFLAGS	= -O -D_NO_PROTO -DSTRINGS_ALIGNED -DNO_REGEX -DNO_ISDIR -DUSE_RE_COMP -DUSER_GETWD -I/x11/motif-1.1/lib
 
 OLDSPACE = 15000000
 NEWSPACE = 5000000
+PREMALLOCS = '-m 401408'
 
 # Name of dumped lisp
 CLIM	= ./slim
@@ -59,7 +62,8 @@ TMP	= /usr/tmp
 SRC_FILES = */*.lisp *.lisp Makefile misc/make-stub-file \
 	    misc/undefinedsymbols misc/undefinedsymbols.olit \
 	    misc/undefinedsymbols.motif misc/undefinedsymbols.xt \
-	    xlib/xlibsupport.c misc/MyDrawingA*.[hc] misc/olsupport.c
+	    xlib/xlibsupport.c misc/MyDrawingA*.[hc] misc/olsupport.c \
+	    misc/clos-preload.cl
 
 DEST=/dev/null
 
@@ -73,29 +77,36 @@ XLIB= /x11/R4/sun4-lib/libX11$(DEBUGLIB).a
 XTLIB=/x11/R4/sun4-lib/libXt$(DEBUGLIB).a
 XLIBS= $(XTLIB) $(XLIB)
 
-OLCOPYLIB=/usr/tech/cer/stuff/clim-2.0/tk/lib2/
+OLCOPYLIB=/usr/tech/cer/stuff/clim-2.0/tk/lib2
 OLXLIBS=$(OLCOPYLIB)/libXt.a $(OLCOPYLIB)/libX11.a
 LIBXOL=$(OLCOPYLIB)/libXol.a
 
 # This has to be kept consistent with xlib.lisp
-
 UNDEFS=misc/undefinedsymbols
 
+# This should be the same as load-xt
 XT_UNDEFS=misc/undefinedsymbols.xt
 
 # This should be the same as load-xm
-
 XM_UNDEFS=misc/undefinedsymbols.motif
 
 # This should be the same as load-ol
-
 OL_UNDEFS=misc/undefinedsymbols.olit
 
 CLIMFASLS= climg.fasl climol.fasl climxm.fasl clim-debug.fasl
-CLIMOBJS= stub-x.o stub-xt.o stub-motif.o stub-olit.o xlibsupport.o MyDrawingA.o \
-	olsupport.o
+CLIMOBJS= clim-motif.o clim-olit.o stub-xt.o stub-x.o xlibsupport.o MyDrawingA.o \
+	  olsupport.o
 
-FCLIMOBJS= `pwd`/stub-motif.o `pwd`/stub-olit.o `pwd`/stub-x.o `pwd`/stub-xt.o `pwd`/xlibsupport.o `pwd`/MyDrawingA.o `pwd`/olsupport.o
+# These are linked into the distribution
+FCLIMOBJS= `pwd`/clim-motif.o `pwd`/clim-olit.o `pwd`/stub-xt.o `pwd`/stub-x.o \
+	   `pwd`/xlibsupport.o `pwd`/MyDrawingA.o `pwd`/olsupport.o
+
+# These are built into xm-dcl and ol-dcl.
+COMPOSEROBJS= /scm/4.1/sparc/src/code/excldep.o /scm/4.1/sparc/src/code/socket.o \
+	      /scm/4.1/sparc/src/code/gc_cursor.o \
+	      /scm/4.1/sparc/src/code/unixsocket.o \
+	      /scm/4.1/sparc/src/code/io.o /scm/4.1/sparc/src/code/exclio.o \
+	      /scm/4.1/sparc/src/code/RunStatus.o
 
 MALLOCOBJS =
 # Uncomment to enable malloc debugging.
@@ -111,11 +122,10 @@ MALLOCOBJS =
 # "Compile time objects" -- these go into clim-debug.fasl
 #
 DEBUG-OBJS = xlib/ffi.fasl xlib/xlib-defs.fasl xlib/xlib-funs.fasl \
-	     xlib/x11-keysyms.fasl xlib/load-xlib.fasl xlib/last.fasl \
-	     tk/xt-defs.fasl tk/xm-defs.fasl 
-
-# This should be there also
-# tk/ol-defs.fasl
+	     xlib/x11-keysyms.fasl xlib/last.fasl \
+	     tk/xt-defs.fasl tk/xm-defs.fasl tk/xt-funs.fasl tk/xm-funs.fasl
+# These should be there also
+# tk/ol-defs.fasl tk/ol-funs.fasl
 
 
 #
@@ -219,12 +229,13 @@ CLIM-STANDALONE-OBJS = clim/gestures.fasl \
                         clim/item-list-manager.fasl \
                         clim/stream-trampolines.fasl
 
-XLIB-CLIM-OBJS = xlib/pkg.fasl
+XLIB-CLIM-OBJS = xlib/pkg.fasl xlib/load-xlib.fasl
 
-# Is this the correct place to put this load-xm??
 
-XT-TK-OBJS =  xlib/load-xlib.fasl \
-		tk/pkg.fasl \
+LOAD-XM-OBJS=	tk/load-xm.fasl
+LOAD-OL-OBJS=	tk/load-ol.fasl
+
+XT-TK-OBJS =  	tk/pkg.fasl \
                 tk/foreign-obj.fasl \
                 tk/macros.fasl \
                 tk/xlib.fasl \
@@ -242,9 +253,6 @@ XT-TK-OBJS =  xlib/load-xlib.fasl \
                 tk/xt-init.fasl
 
 XM-TK-OBJS = tk/xm-classes.fasl \
-	     tk/load-xm.fasl \
-		tk/xt-funs.fasl \
-		tk/xm-funs.fasl \
 		tk/xm-callbacks.fasl \
                 tk/xm-init.fasl \
                 tk/xm-widgets.fasl \
@@ -254,9 +262,6 @@ XM-TK-OBJS = tk/xm-classes.fasl \
                 tk/make-widget.fasl
 
 OL-CLIM-OBJS = tk/ol-classes.fasl \
-	     tk/load-ol.fasl \
-		tk/xt-funs.fasl \
-		tk/ol-funs.fasl \
                 tk/ol-init.fasl \
 		tk/ol-widgets.fasl \
                 tk/ol-callbacks.fasl \
@@ -323,6 +328,7 @@ ALL_SRC =	   utils/excl-verification.lisp \
                     silica/medium.lisp \
                     silica/framem.lisp \
                     silica/graphics.lisp \
+                    silica/pixmaps.lisp \
                     silica/std-sheet.lisp \
                     silica/layout.lisp \
                     silica/db-layout.lisp \
@@ -357,6 +363,7 @@ ALL_SRC =	   utils/excl-verification.lisp \
                         clim/incremental-redisplay.lisp \
                         clim/coordinate-sorted-set.lisp \
                         clim/window-stream.lisp \
+                        clim/pixmap-streams.lisp \
                         clim/ptypes1.lisp \
                         clim/completer.lisp \
                         clim/presentations.lisp \
@@ -379,11 +386,11 @@ ALL_SRC =	   utils/excl-verification.lisp \
                         clim/command-processor.lisp \
                         clim/basic-translators.lisp \
                         clim/frames.lisp \
+                        clim/default-frame.lisp \
                         clim/noting-progress.lisp \
                         clim/menus.lisp \
                         clim/accept-values.lisp \
                         clim/drag-and-drop.lisp \
-                        clim/pixmap-streams.lisp \
                         clim/item-list-manager.lisp \
                         clim/stream-trampolines.lisp \
 	     xlib/pkg.lisp \
@@ -393,6 +400,8 @@ ALL_SRC =	   utils/excl-verification.lisp \
              xlib/xlib-funs.lisp \
              xlib/x11-keysyms.lisp \
              xlib/last.lisp \
+	      tk/load-xm.lisp \
+              tk/load-ol.lisp \
 	      tk/pkg.lisp \
               tk/macros.lisp \
               tk/xt-defs.lisp \
@@ -410,7 +419,6 @@ ALL_SRC =	   utils/excl-verification.lisp \
               tk/callbacks.lisp \
               tk/xt-classes.lisp \
               tk/xt-init.lisp \
-	      tk/load-xm.lisp \
               tk/xm-defs.lisp \
               tk/xm-classes.lisp \
               tk/xm-callbacks.lisp \
@@ -437,7 +445,6 @@ ALL_SRC =	   utils/excl-verification.lisp \
                    tk-silica/xt-cursor.lisp \
                    tk-silica/xt-pixmaps.lisp \
 	      tk/ol-defs.lisp \
-              tk/load-ol.lisp \
               tk/ol-funs.lisp \
               tk/ol-classes.lisp \
               tk/ol-init.lisp \
@@ -450,9 +457,8 @@ ALL_SRC =	   utils/excl-verification.lisp \
 
 
 GENERIC-OBJS= $(CLIM-UTILS-OBJS) $(CLIM-SILICA-OBJS) $(CLIM-STANDALONE-OBJS)
-XT-OBJS= $(XLIB-CLIM-OBJS) $(XT-TK-OBJS)
-MOTIF-OBJS =  $(XM-TK-OBJS) $(MOTIF-CLIM-OBJS) 
-OPENLOOK-OBJS = $(OL-CLIM-OBJS) $(OPENLOOK-CLIM-OBJS)
+MOTIF-OBJS = $(LOAD-XM-OBJS) $(XT-TK-OBJS) $(XM-TK-OBJS) $(MOTIF-CLIM-OBJS) 
+OPENLOOK-OBJS = $(LOAD-OL-OBJS) $(XT-TK-OBJS) $(OL-CLIM-OBJS) $(OPENLOOK-CLIM-OBJS)
 
 default: all-xm
 
@@ -471,7 +477,7 @@ compile-xm:	$(CLIMOBJS) FORCE
 		(setf excl:*record-source-file-info* $(RECORD_SOURCE_FILE_INFO)) \
 		(setf excl:*record-xref-info* $(RECORD_XREF_INFO)) \
 		(setf excl:*load-xref-info* $(LOAD_XREF_INFO)) \
-		(proclaim '(optimize (speed $(SPEED)) (safety $(SAFETY)))) \
+		(proclaim '(optimize (speed $(SPEED)) (safety $(SAFETY)) (debug $(DEBUG)))) \
 		(load \"misc/compile-xm.lisp\")" | $(CL) $(CLOPTS) -batch
 		echo CLIM-XM compiled!!!!
 
@@ -483,7 +489,7 @@ compile-ol:	$(CLIMOBJS) FORCE
 		(setf excl:*load-xref-info* $(LOAD_XREF_INFO)) \
 		(setq *ignore-package-name-case* t) \
 		(set-case-mode :case-insensitive-lower) \
-		(proclaim '(optimize (speed $(SPEED)) (safety $(SAFETY)))) \
+		(proclaim '(optimize (speed $(SPEED)) (safety $(SAFETY)) (debug $(DEBUG)))) \
 		(load \"misc/compile-ol.lisp\")" | $(CL) $(CLOPTS) -batch
 		echo CLIM-OL compiled!!!!
 
@@ -494,20 +500,20 @@ cat-g:	climg.fasl clim-debug.fasl
 cat-xm:	cat-g climxm.fasl
 cat-ol:	cat-g climol.fasl
 
-climg.fasl	: $(GENERIC-OBJS) $(XT-OBJS)
-	$(CAT)  $(GENERIC-OBJS) $(XT-OBJS) > $(TMP)/clim.fasl_`whoami`
+climg.fasl	: $(GENERIC-OBJS) $(XLIB-CLIM-OBJS)
+	$(CAT) $(GENERIC-OBJS) $(XLIB-CLIM-OBJS) > $(TMP)/clim.fasl_`whoami`
 	$(MV) $(TMP)/clim.fasl_`whoami` climg.fasl
 	ls -lt climg.fasl >> Clim-sizes.n
 	ls -lt climg.fasl
 
-climxm.fasl	: $(MOTIF-OBJS)
-	$(CAT)  $(MOTIF-OBJS) > $(TMP)/clim.fasl_`whoami`
+climxm.fasl	: $(MOTIF-OBJS) $(XLIB-CLIM-OBJS)
+	$(CAT) $(MOTIF-OBJS) > $(TMP)/clim.fasl_`whoami`
 	$(MV) $(TMP)/clim.fasl_`whoami` climxm.fasl
 	ls -lt climxm.fasl >> Clim-sizes.n
 	ls -lt climxm.fasl
 
 climol.fasl	: $(OPENLOOK-OBJS)
-	$(CAT)  $(OPENLOOK-OBJS) > $(TMP)/clim.fasl_`whoami`
+	$(CAT) $(OPENLOOK-OBJS) > $(TMP)/clim.fasl_`whoami`
 	$(MV) $(TMP)/clim.fasl_`whoami` climol.fasl
 	ls -lt climol.fasl >> Clim-sizes.n
 	ls -lt climol.fasl
@@ -536,22 +542,20 @@ clim-xm:	FORCE
 		(load \"misc/dev-load-xm.lisp\") \
 		(load \"misc/dump.lisp\")" | $(DUMP-CL) $(CLOPTS) -batch
 	$(MV) $(TMP)/clim.temp_`whoami` $(CLIM)
-	ls -lt $(CLIM) >> Clim-sizes.n
+	ls -lLt $(CLIM) >> Clim-sizes.n
 	size $(CLIM) >> Clim-sizes.n
-	ls -lt $(CLIM)
+	ls -lLt $(CLIM)
 	echo CLIM-XM built!!!!	
 
 clim-ol:	FORCE
-	-$(RM) $(CLIM)
+#	-$(RM) $(CLIM)
 	$(ECHO) " \
-		(setq *ignore-package-name-case* t) \
-		(set-case-mode :case-insensitive-lower) \
 		(load \"misc/dev-load-ol.lisp\") \
 		(load \"misc/dump.lisp\")" | $(DUMP-CL) $(CLOPTS) -batch
 	$(MV) $(TMP)/clim.temp_`whoami` $(CLIM)
-	ls -lt $(CLIM) >> Clim-sizes.n
+	ls -lLt $(CLIM) >> Clim-sizes.n
 	size $(CLIM) >> Clim-sizes.n
-	ls -lt $(CLIM)
+	ls -lLt $(CLIM)
 	echo CLIM-OL built!!!!		
 
 clim-small:	FORCE
@@ -586,10 +590,13 @@ cheapclean:
 tags:
 	$(TAGS) $(ALL_SRC)
 
+wc:
+	wc $(ALL_SRC)
+
 swm-tape:
 	tar cf $(DEVICE) `find $(PUBDIRS) '(' -name "*.cl" -o -name "*.lisp" ')' -print`
 
-dist:
+dist:	FORCE
 	tar -cf -  $(SRC_FILES) | compress >  Dist/src.tar.Z
 
 rcscheck:
@@ -607,14 +614,15 @@ makeclimolfasls	: compile-ol cat-ol
 install_clim	:
 	cp $(CLIMOBJS) $(CLIMFASLS) $(DEST)
 
-# Link in the libraries with standard names
+# Link in the libraries & distribution object files with standard names
 
-link-motif-libraries	:
-	ln -s  $(MOTIFLIB) $(DEST)/libXm.a
+link-objects	:
 	ln -s $(XTLIB) $(DEST)/libXt.a
 	ln -s $(XLIB) $(DEST)/libX11.a
 	ln -s $(FCLIMOBJS) $(DEST)
-	ln -s $(LIBXOL) $(DEST)
+
+# Backwards compatibility...
+link-motif-libraries:	link-objects
 
 echo_src_files:
 	@ls $(SRC_FILES) | cat
@@ -624,18 +632,23 @@ makeclimobjs	: $(CLIMOBJS)
 ################## Lower level Makefile stuff
 
 
-ol-dcl	:  stub-x.o stub-xt.o stub-olit.o xlibsupport.o olsupport.o $(MALLOCOBJS)
+ol-dcl	:  stub-x.o stub-xt.o clim-olit.o xlibsupport.o olsupport.o $(MALLOCOBJS)
 	cd $(CL_SRC) ; /bin/rm -f ucl ;\
-	make initial_oldspace=$(OLDSPACE) oldspace=$(OLDSPACE) newspace=$(NEWSPACE) premallocs='-m 401408' ucl_xtras='$(PWD)/stub-x.o $(PWD)/stub-xt.o $(PWD)/stub-olit.o $(PWD)/xlibsupport.o $(PWD)/olsupport.o $(MALLOCOBJS) $(LIBXOL) $(OLXLIBS)' dcl
+	make initial_oldspace=$(OLDSPACE) oldspace=$(OLDSPACE) newspace=$(NEWSPACE) premallocs=$(PREMALLOCS) ucl_xtras='$(PWD)/stub-x.o $(PWD)/stub-xt.o $(PWD)/clim-olit.o $(PWD)/xlibsupport.o $(PWD)/olsupport.o $(COMPOSEROBJS) $(MALLOCOBJS) $(OLXLIBS)' dcl
 
-xm-dcl	: stub-x.o stub-xt.o stub-motif.o xlibsupport.o MyDrawingA.o $(MALLOCOBJS)
+xm-dcl	: stub-x.o stub-xt.o clim-motif.o xlibsupport.o MyDrawingA.o $(MALLOCOBJS)
 	cd $(CL_SRC) ; /bin/rm -f ucl ;\
-	make initial_oldspace=$(OLDSPACE) oldspace=$(OLDSPACE) newspace=$(NEWSPACE) premallocs='-m 401408' ucl_xtras='$(PWD)/stub-x.o $(PWD)/stub-xt.o $(PWD)/stub-motif.o $(PWD)/xlibsupport.o $(PWD)/MyDrawingA.o $(MALLOCOBJS) $(MOTIFLIB) $(XTLIB) $(XLIB)' dcl	
+	make initial_oldspace=$(OLDSPACE) oldspace=$(OLDSPACE) newspace=$(NEWSPACE) premallocs=$(PREMALLOCS) ucl_xtras='$(PWD)/stub-x.o $(PWD)/stub-xt.o $(PWD)/clim-motif.o $(PWD)/xlibsupport.o $(PWD)/MyDrawingA.o $(COMPOSEROBJS) $(MALLOCOBJS) $(XTLIB) $(XLIB)' dcl	
 
 dcl	: 
 	cd $(CL_SRC) ; /bin/rm -f ucl ;\
 	make dcl	
 
+clim-motif.o	: stub-motif.o
+	ld -r -o clim-motif.o stub-motif.o $(MOTIFLIB)
+
+clim-olit.o	: stub-olit.o
+	ld -r -o clim-olit.o stub-olit.o $(LIBXOL)
 
 stub-motif.c	:  $(XT_UNDEFS) $(XM_UNDEFS) misc/make-stub-file
 	misc/make-stub-file "void ___lisp_load_motif_stub ()"  $(XT_UNDEFS) $(XM_UNDEFS) > stub-motif.c 
@@ -658,7 +671,7 @@ MyDrawingA.o: misc/MyDrawingA.c
 olsupport.o: misc/olsupport.c
 	$(CC) -c $(CFLAGS) -o olsupport.o misc/olsupport.c
 
-FRC	: 
+FORCE	: 
 
 xm-composer : xm-dcl
 	cd /usr/composer2 ; make CL=$(CL) rebuild-c2
diff --git a/clim/frames.lisp b/clim/frames.lisp
index 3b3a4cfc83cb64df82d38df26b4f5902024397c1..41b52d17a1440162bde4e0848861ee80907c2499 100644
--- a/clim/frames.lisp
+++ b/clim/frames.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: frames.lisp,v 1.35 92/07/27 19:29:46 cer Exp $
+;; $fiHeader: frames.lisp,v 1.36 92/08/18 17:24:53 cer Exp Locker: cer $
 
 (in-package :clim-internals)
 
@@ -564,18 +564,18 @@
 	     :geometry :left :top :right :bottom :width :height))
     (macrolet ((check-conflict (edge1 edge2 size)
 		 `(cond 
-		    ((and ,edge1 ,size)
-		     (if ,edge2
-			 (error "Cannot specify ~S, ~S, and ~S together" ,edge1 ,size ,edge2)
-			 (setq ,edge2 (+ ,edge1 ,size))))
-		    ((and ,edge2 ,size)
-		     (if ,edge1
-			 (error "Cannot specify ~S, ~S, and ~S together" ,edge2 ,size ,edge1)
-			 (setq ,edge1 (+ ,edge2 ,size))))
-		    ((and ,edge2 ,edge1)
-		     (if ,size
-			 (error "Cannot specify ~S, ~S, and ~S together" ,edge2 ,edge1 ,size)
-			 (setq ,size (- ,edge2 ,edge1)))))))
+		   ((and ,edge1 ,size)
+		    (if ,edge2
+			(error "Cannot specify ~S, ~S, and ~S together" ,edge1 ,size ,edge2)
+		      (setq ,edge2 (+ ,edge1 ,size))))
+		   ((and ,edge2 ,size)
+		    (if ,edge1
+			(error "Cannot specify ~S, ~S, and ~S together" ,edge2 ,size ,edge1)
+		      (setq ,edge1 (+ ,edge2 ,size))))
+		   ((and ,edge2 ,edge1)
+		    (if ,size
+			(error "Cannot specify ~S, ~S, and ~S together" ,edge2 ,edge1 ,size)
+		      (setq ,size (- ,edge2 ,edge1)))))))
       (check-conflict left right width)
       (check-conflict top bottom height))
     (setf (getf options :geometry)
@@ -583,15 +583,19 @@
 		  (and top `(:top ,top))
 		  (and width `(:width ,width))
 		  (and height `(:height ,height)))))
+
   (let ((geometry (getf options :geometry)))
-    (when (and (eq user-specified-position-p :unspecified)
-	       (getf geometry :left)
-	       (getf geometry :top))
-      (setf user-specified-position-p t))
-    (when (and (eq user-specified-size-p :unspecified)
-	       (getf geometry :width)
-	       (getf geometry :height))
-      (setf user-specified-size-p t)))
+    (when (eq user-specified-position-p :unspecified)
+      (if (or (and (getf  :left)
+		   (getf geometry :top))
+	      (and left top))
+	  (setf user-specified-position-p t)))
+    (when (eq user-specified-size-p :unspecified)
+      (if (or (and (getf geometry :width)
+		   (getf geometry :height))
+	      (and width height))
+	  (setf user-specified-size-p t))))
+
   (with-keywords-removed (options options 
 			  '(:frame-class :pretty-name :enable :save-under
 			    :left :top :right :bottom :width :height
diff --git a/clx/clx-mirror.lisp b/clx/clx-mirror.lisp
index b6ea9a9c0a34211cd02abbab70755b5780a1e90a..64233d21904455bce551acd7873a0d5a54a5313a 100644
--- a/clx/clx-mirror.lisp
+++ b/clx/clx-mirror.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clx-mirror.lisp,v 1.9 92/07/27 11:01:59 cer Exp $
+;; $fiHeader: clx-mirror.lisp,v 1.10 92/08/18 17:24:24 cer Exp Locker: cer $
 
 (in-package :clx-clim)
 
@@ -206,7 +206,7 @@
 				  :discard-p t
 				  :timeout nil)
 	  ;; Device Events
-	  ((:motion-notify :enter-notify :leave-notify)
+	  (:motion-notify
 	   (event-window) 
 	   (multiple-value-bind (x y same-screen-p child state root-x root-y)
 	       (xlib:query-pointer event-window)
@@ -220,14 +220,34 @@
 		 (distribute-event
 		   port				;(EQ PORT (PORT-SHEET)) ==> T
 		   (allocate-event 'pointer-motion-event
-		     :x root-x
-		     :y root-y
 		     :native-x x
 		     :native-y y
 		     :modifier-state modifier-state
 		     :pointer pointer
 		     :sheet sheet))))
 	     t))
+	  ((:enter-notify :leave-notify)
+	   (event-window event-key state kind)
+	   (let ((sheet (mirror->sheet port event-window))
+		 (modifier-state (state-mask->modifier-state state display))
+		 (pointer (port-pointer port)))
+	     ;;--- This should probably set the native position of the pointer
+	     (setf (port-modifier-state port) modifier-state)
+	     (when sheet
+	       (distribute-event
+		port			;(EQ PORT (PORT-SHEET)) ==> T
+		(allocate-event (case event-key
+				  (:enter-notify 'pointer-enter-event)
+				  (:leave-notify 'pointer-exit-event))
+				:x root-x
+				:y root-y
+				:native-x x
+				:native-y y
+				:kind kind
+				:modifier-state modifier-state
+				:pointer pointer
+				:sheet sheet))))
+	   t)
 	  ((:button-press :button-release) 
 	   (event-key event-window code)
 	   (multiple-value-bind (x y same-screen-p child state root-x root-y)
diff --git a/instclimol.lisp b/instclimol.lisp
index 74ca043decda069d4d70593273793da1e7511e54..8c3db76112ef7763c1408aa610960c18a5d4218e 100644
--- a/instclimol.lisp
+++ b/instclimol.lisp
@@ -20,7 +20,7 @@
 ;; applicable.
 ;;
 
-;; $fiHeader: instclimol.lisp,v 1.2 92/05/22 19:29:17 cer Exp $
+;; $fiHeader: instclimol.lisp,v 1.3 92/06/02 13:31:19 cer Exp $
 
 ;;
 ;; Load CLIM
@@ -29,9 +29,8 @@
 (in-package :system)
 
 
-(defvar sys::*libx11-pathname* "/x11/R4/sun4-lib/libX_d.a")
-(defvar sys::*libxt-pathname* "/x11/R4/sun4-lib/libXt_d.a")
-(defvar sys::*libxol-pathname* "/vapor/usr/tech/cer/stuff/clim-2.0/tk/lib2/libXol.a")
+(defvar sys::*libx11-pathname* "/x11/R4/sun4-lib/libX11.a")
+(defvar sys::*libxt-pathname* "/x11/R4/sun4-lib/libXt.a")
 
 (load-application (progn 
 		    (require :climol)
diff --git a/instclimxm.lisp b/instclimxm.lisp
index 419258ad571e8d2835afd86e89ad9d92195dc9b8..a651c8a10e7a96440adb72044487b2b9228dfc25 100644
--- a/instclimxm.lisp
+++ b/instclimxm.lisp
@@ -20,7 +20,7 @@
 ;; applicable.
 ;;
 
-;; $fiHeader: instclimxm.lisp,v 1.2 92/05/22 19:29:18 cer Exp $
+;; $fiHeader: instclimxm.lisp,v 1.3 92/06/02 13:31:20 cer Exp $
 
 ;;
 ;; Load CLIM
@@ -28,9 +28,8 @@
 
 (in-package :system)
 
-(defvar sys::*libx11-pathname* "/x11/R4/sun4-lib/libX_d.a")
-(defvar sys::*libxt-pathname* "/x11/R4/sun4-lib/libXt_d.a")
-(defvar sys::*libxm-pathname* "/x11/motif-1.1/lib/Xm/libXm.a")
+(defvar sys::*libx11-pathname* "/x11/R4/sun4-lib/libX11.a")
+(defvar sys::*libxt-pathname* "/x11/R4/sun4-lib/libXt.a")
 
 (load-application (progn 
 		    (require :climxm)
diff --git a/silica/classes.lisp b/silica/classes.lisp
index e1462c268ecd0d1a40ecda125272be4500c18ca8..95de869659784815fef37a23d34f39e7ec81a0d7 100644
--- a/silica/classes.lisp
+++ b/silica/classes.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: classes.lisp,v 1.13 92/07/27 11:01:28 cer Exp $
+;; $fiHeader: classes.lisp,v 1.14 92/08/18 17:23:23 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -141,6 +141,11 @@
    (pointer :reader pointer-event-pointer 
 	    :initarg :pointer :initform nil)))
 
+#+CLIM-1-compatibility
+(define-compatibility-function (pointer-event-shift-mask event-modifier-state)
+			       (pointer-event)
+  (event-modifier-state pointer-event))
+
 (define-event-class pointer-button-event (pointer-event)
   ((button :reader pointer-event-button
 	   :initarg :button :initform nil)))
@@ -152,10 +157,14 @@
 (define-event-class pointer-click-hold-event (pointer-click-event) ())
 (define-event-class pointer-double-click-event (pointer-click-event) ())
 
-(define-event-class pointer-motion-or-boundary-event (pointer-event) ())
-(define-event-class pointer-motion-event (pointer-motion-or-boundary-event) ())
-(define-event-class pointer-exit-event (pointer-motion-or-boundary-event) ())
-(define-event-class pointer-enter-event (pointer-motion-or-boundary-event) ())
+(define-event-class pointer-motion-event (pointer-event) ())
+
+(define-event-class pointer-boundary-event (pointer-event)
+  ((kind :reader pointer-boundary-event-kind :initarg :kind
+	 :type (member :ancestor :virtual :inferior :nonlinear :nonlinear-virtual
+		       nil))))
+(define-event-class pointer-exit-event (pointer-boundary-event) ())
+(define-event-class pointer-enter-event (pointer-boundary-event) ())
 
 
 (define-event-class window-event (event)
diff --git a/sys/sysdcl.lisp b/sys/sysdcl.lisp
index 6bc25ddb1c6787d66b7698f3896581a02d16b6d3..671358517ad3bf3c75cac905d7d639ca553d25ce 100644
--- a/sys/sysdcl.lisp
+++ b/sys/sysdcl.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: sysdcl.lisp,v 1.20 92/07/27 11:03:10 cer Exp $
+;; $fiHeader: sysdcl.lisp,v 1.21 92/08/18 17:25:53 cer Exp Locker: cer $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :cl-user)
 
@@ -344,6 +344,7 @@
   ("pkg")
   ("macros")
   ("xt-defs")				; Used to be 'xtk'.
+  ("xt-funs")
   ("foreign-obj")
   ;; Xlib stuff
   ("xlib")
@@ -362,21 +363,43 @@
   ("xt-classes")
   ("xt-init"))
 
+#+Allegro
+(clim-defsys:defsystem xm-load
+    (:default-pathname #+Genera "SYS:CLIM;REL-2;TK;"
+		       #-Genera (frob-pathname "tk")
+     :default-binary-pathname #+Genera "SYS:CLIM;REL-2;TK;"
+			      #-Genera (frob-pathname "tk")
+     :needed-systems (xlib)
+     :load-before-compile (xlib))
+  ;; Motif specific foriegn loading.  Must be done early so defforeigns can
+  ;; be opencoded.
+  ("load-xm"))
+  
+#+Allegro
+(clim-defsys:defsystem ol-load
+    (:default-pathname #+Genera "SYS:CLIM;REL-2;TK;"
+		       #-Genera (frob-pathname "tk")
+     :default-binary-pathname #+Genera "SYS:CLIM;REL-2;TK;"
+			      #-Genera (frob-pathname "tk")
+     :needed-systems (xlib)
+     :load-before-compile (xlib))
+  ;; Motif specific foriegn loading.  Must be done early so defforeigns can
+  ;; be opencoded.
+  ("load-ol"))
+  
 #+Allegro
 (clim-defsys:defsystem xm-tk
     (:default-pathname #+Genera "SYS:CLIM;REL-2;TK;"
 		       #-Genera (frob-pathname "tk")
      :default-binary-pathname #+Genera "SYS:CLIM;REL-2;TK;"
 			      #-Genera (frob-pathname "tk")
-     :needed-systems (xt-tk)
-     :load-before-compile (xt-tk))
+     :needed-systems (xm-load xt-tk)
+     :load-before-compile (xm-load xt-tk))
   ;; Motif specific stuff
-  ("load-xm")
   ("xm-defs")
+  ("xm-funs")
   ("xm-classes")
   ("xm-callbacks")
-  ("xt-funs") ;;--- This is really in tk but because of the loading
-  ("xm-funs")
   ("xm-classes")
   ("xm-init")
   ("xm-widgets")
@@ -391,12 +414,10 @@
 		       #-Genera (frob-pathname "tk")
      :default-binary-pathname #+Genera "SYS:CLIM;REL-2;TK;"
 			      #-Genera (frob-pathname "tk")
-     :needed-systems (xt-tk)
-     :load-before-compile (xt-tk))
+     :needed-systems (ol-load xt-tk)
+     :load-before-compile (ol-load xt-tk))
   ;; OpenLook specific stuff
   ("ol-defs")
-  ("load-ol")
-  ("xt-funs") ;;--- This is really in tk but because of the loading
   ("ol-funs")
   ("ol-classes")
   ("ol-init")
diff --git a/tk-silica/ol-silica.lisp b/tk-silica/ol-silica.lisp
index 73579141567c4ebec0c0307be0df3d1e9cff9819..a9a073256890a309e6bbfc11c94be251d1edc72a 100644
--- a/tk-silica/ol-silica.lisp
+++ b/tk-silica/ol-silica.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-silica.lisp,v 1.11 92/07/01 15:48:01 cer Exp $
+;; $fiHeader: ol-silica.lisp,v 1.12 92/07/20 16:01:50 cer Exp $
 
 (in-package :xm-silica)
 
@@ -50,14 +50,17 @@
     (let ((mirror (sheet-mirror stream)))
       (when mirror 
 	(let ((window (tk::widget-window mirror)))
-	  (when (eq  (tk::window-map-state window) :viewable)
-	    ;;--- There could very well be a race condition involving
-	    ;;--- a couple of processes.  Another process could have made
-	    ;;--- this window go away at this point
-	    (tk::ol_set_input_focus 
-	     mirror
-	     2				; RevertToParent
-	     0)))))))
+	  (with-port-event-lock (port)
+	    (excl:without-interrupts
+	      (tk:with-server-grabbed ((port-display port))
+		(when (eq (tk::window-map-state window) :viewable)
+		  ;;--- There could very well be a race condition involving
+		  ;;--- a couple of processes.  Another process could have made
+		  ;;--- this window go away at this point
+		  (tk::ol_set_input_focus 
+		   mirror
+		   2			; RevertToParent
+		   0))))))))))
 
 (defmethod change-widget-geometry ((parent tk::draw-area) child
 				   &rest args
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index 5135d33aa902fc19e1f5374701592f35771946c0..cf8c5412b2fe64da727d07098d89b10326298fc4 100644
--- a/tk-silica/xm-gadgets.lisp
+++ b/tk-silica/xm-gadgets.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-gadgets.lisp,v 1.40 92/07/27 11:03:46 cer Exp $
+;; $fiHeader: xm-gadgets.lisp,v 1.41 92/08/18 17:26:35 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -728,6 +728,15 @@
   ;;-- the pane should resize its child
   )
 
+(defmethod add-sheet-callbacks
+    ((port motif-port) (sheet t) (widget tk::xm-frame))
+  (tk::add-event-handler widget
+			 '(:enter-window 
+			   :leave-window)
+			 0
+			 'sheet-mirror-event-handler
+			 sheet))
+ 
 ;;; Scrolling Window
 
 (defclass basic-motif-scrolling-window (motif-geometry-manager
diff --git a/tk-silica/xm-silica.lisp b/tk-silica/xm-silica.lisp
index e16e79d4a6db998c6daa30b7340baa4668492785..b54ed296d37401a38a257cf2d322c78604d42856 100644
--- a/tk-silica/xm-silica.lisp
+++ b/tk-silica/xm-silica.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-silica.lisp,v 1.23 92/07/08 16:31:56 cer Exp $
+;; $fiHeader: xm-silica.lisp,v 1.24 92/08/18 17:26:37 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -96,11 +96,11 @@
 							  (desired :unsigned-long))
   (my-drawing-area-query-geometry widget intended desired))
 
-(ff::defforeign 'initializemydrawingareaquerygeometry
-    :entry-point "_InitializeMyDrawingAreaQueryGeometry")
+(defun setup-mda ()
+  (tk::initializemydrawingareaquerygeometry 
+   (ff:register-function 'my-drawing-area-query-geometry-stub)))
 
-(initializemydrawingareaquerygeometry 
- (ff:register-function 'my-drawing-area-query-geometry-stub))
+(setup-mda)
 
 (defun my-drawing-area-query-geometry (widget intended desired)
   (let* ((sheet (find-sheet-from-widget-address widget))
diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp
index 69d2322c4277a8a410190debdea116dc354f69cd..7261595c06d050d89f75252f4d0d2070b1f244b6 100644
--- a/tk-silica/xt-graphics.lisp
+++ b/tk-silica/xt-graphics.lisp
@@ -20,13 +20,34 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-graphics.lisp,v 1.32 92/07/27 19:30:25 cer Exp $
+;; $fiHeader: xt-graphics.lisp,v 1.33 92/08/18 17:26:40 cer Exp Locker: cer $
 
 (in-package :tk-silica)
 
 (defclass fast-gcontext (tk::gcontext)
-  ((last-medium-clip-mask :initform nil)
-   (last-line-style :initform nil)))
+  ((last-medium-clip-mask :initform nil :fixed-index 1)
+   (last-line-style :initform nil :fixed-index 2)))
+
+(defmacro fast-gcontext-last-line-style (gcontext)
+  `(locally (declare (optimize (speed 3) (safety 0)))
+     (excl::slot-value-using-class-name 'fast-gcontext ,gcontext
+					'last-line-style)))
+(defsetf fast-gcontext-last-line-style (gcontext) (value)
+  `(locally (declare (optimize (speed 3) (safety 0)))
+     (setf (excl::slot-value-using-class-name 'fast-gcontext ,gcontext
+					      'last-line-style)
+       ,value)))
+
+(defmacro fast-gcontext-last-medium-clip-mask (gcontext)
+  `(locally (declare (optimize (speed 3) (safety 0)))
+     (excl::slot-value-using-class-name 'fast-gcontext ,gcontext
+					'last-medium-clip-mask)))
+(defsetf fast-gcontext-last-medium-clip-mask (gcontext) (value)
+  `(locally (declare (optimize (speed 3) (safety 0)))
+     (setf (excl::slot-value-using-class-name 'fast-gcontext ,gcontext
+					      'last-medium-clip-mask)
+       ,value)))
+
 
 (defclass xt-medium (basic-medium)
   ((foreground-gcontext :reader medium-foreground-gcontext :initform nil)
@@ -270,7 +291,7 @@
 (defmethod decode-ink ((ink (eql +flipping-ink+)) stream)
   (slot-value stream 'flipping-gcontext))
 
-(defmethod decode-ink ((ink color) (medium xt-medium))
+(defmethod decode-ink ((ink color) medium)
   (with-slots (ink-table sheet tile-gcontext white-pixel black-pixel drawable
 			 color-p)
       medium
@@ -378,50 +399,49 @@ and on color servers, unless using white or black")
 (defvar *default-dashes* '(4 4))
 
 (defun adjust-ink (gc medium line-style x-origin y-origin)
-  (with-slots (last-medium-clip-mask last-line-style) gc
-    (unless (eq last-line-style line-style)
-      (let* ((dashes (line-style-dashes line-style))
-	     (gc-line-style (if dashes :dash :solid)))
+  (unless (eq (fast-gcontext-last-line-style gc) line-style)
+    (let* ((dashes (line-style-dashes line-style))
+	   (gc-line-style (if dashes :dash :solid)))
 	
-	(tk::set-line-attributes 
-	 gc
-	 (let ((thickness (line-style-thickness line-style)))
-	   (ecase (line-style-unit line-style)
-	     (:normal)
-	     (:point
-	      (setq thickness (* (graft-pixels-per-point (graft medium))
-				 thickness))))
-	   (when (< thickness 2)
-	     (setq thickness 0))
-	   (setq thickness (the fixnum (round thickness)))
-	   thickness)
-	 gc-line-style
-	 (ecase (line-style-cap-shape line-style)
-	   (:butt :butt)
-	   (:square :projecting)
-	   (:round :round)
-	   (:no-end-point :not-last))
-	 (ecase (line-style-joint-shape line-style)
-	   ((:miter :none) :miter)
-	   (:bevel :bevel)
-	   (:round :round)))
+      (tk::set-line-attributes 
+       gc
+       (let ((thickness (line-style-thickness line-style)))
+	 (ecase (line-style-unit line-style)
+	   (:normal)
+	   (:point
+	    (setq thickness (* (graft-pixels-per-point (graft medium))
+			       thickness))))
+	 (when (< thickness 2)
+	   (setq thickness 0))
+	 (setq thickness (the fixnum (round thickness)))
+	 thickness)
+       gc-line-style
+       (ecase (line-style-cap-shape line-style)
+	 (:butt :butt)
+	 (:square :projecting)
+	 (:round :round)
+	 (:no-end-point :not-last))
+       (ecase (line-style-joint-shape line-style)
+	 ((:miter :none) :miter)
+	 (:bevel :bevel)
+	 (:round :round)))
     
-	(when (eq gc-line-style :dash)
-	  (setf (tk::gcontext-dashes gc)
-	    (if (excl::sequencep dashes) dashes *default-dashes*))
-	  ;; The following isn't really right, but it's better than nothing.
-	  (setf (tk::gcontext-dash-offset gc) (1- y-origin))))
-      (setf last-line-style line-style))
-
-    (let ((mcm (medium-clip-mask medium)))
-      (unless (eq last-medium-clip-mask mcm)
-	(setf (tk::gcontext-clip-mask gc) (medium-clip-mask medium))
-	(setf last-medium-clip-mask mcm)))
+      (when (eq gc-line-style :dash)
+	(setf (tk::gcontext-dashes gc)
+	  (if (excl::sequencep dashes) dashes *default-dashes*))
+	;; The following isn't really right, but it's better than nothing.
+	(setf (tk::gcontext-dash-offset gc) (1- y-origin))))
+    (setf (fast-gcontext-last-line-style gc) line-style))
+
+  (let ((mcm (medium-clip-mask medium)))
+    (unless (eq (fast-gcontext-last-medium-clip-mask gc) mcm)
+      (setf (tk::gcontext-clip-mask gc) (medium-clip-mask medium))
+      (setf (fast-gcontext-last-medium-clip-mask gc) mcm)))
     
-    (when (member (tk::gcontext-fill-style gc) '(:tiled :stippled) :test #'eq)
-      (setf (tk::gcontext-ts-x-origin gc) x-origin
-	    (tk::gcontext-ts-y-origin gc) y-origin))
-    gc))
+  (when (member (tk::gcontext-fill-style gc) '(:tiled :stippled) :test #'eq)
+    (setf (tk::gcontext-ts-x-origin gc) x-origin
+	  (tk::gcontext-ts-y-origin gc) y-origin))
+  gc)
 
 #+ignore
 (defmethod decode-ink :around ((ink t) (medium xt-medium))
@@ -759,7 +779,7 @@ and on color servers, unless using white or black")
 		  filled)))
 	      (t
 	       (port-draw-transformed-rectangle*
-		port sheet medium x1 y1 x2 y2 filled)))))))
+		(port sheet) sheet medium x1 y1 x2 y2 filled)))))))
 
 (defmethod medium-draw-polygon* ((medium xt-medium) position-seq closed filled)
   (let ((drawable (medium-drawable medium)))
@@ -1027,7 +1047,7 @@ and on color servers, unless using white or black")
 	  (declare (ignore oy)
 		   (ignore ox))
 	  (setf (tk::gcontext-clip-mask gcontext) pixmap)
-	  (setf (slot-value gcontext 'last-medium-clip-mask) nil)
+	  (setf (fast-gcontext-last-medium-clip-mask gcontext) nil)
 	  (unless start (setq start 0))
 	  (unless end (setq end (length string)))
 	  (dotimes (i (- end start))
@@ -1204,8 +1224,8 @@ and on color servers, unless using white or black")
   (tk::font-width (text-style-mapping (port medium) text-style)))
 
 (defmethod text-style-height ((text-style standard-text-style) (medium xt-medium))
-  (+ (text-style-ascent text-style medium)
-     (text-style-descent text-style medium)))
+  ;; Optimization
+  (tk::font-height (text-style-mapping (port medium) text-style)))
 
 (defmethod text-style-ascent ((text-style standard-text-style) (medium xt-medium))
   (tk::font-ascent (text-style-mapping (port medium) text-style)))
@@ -1221,5 +1241,6 @@ and on color servers, unless using white or black")
   (x11:xflush (port-display (port medium))))
 
 (defmethod medium-finish-output ((medium xt-medium))
-  (x11:xsync (port-display (port medium))))	;--- is this right?
+  (x11:xsync (port-display (port medium)) 0))
+
    
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index 15641c4ae591c444fbccd23ff2076e3e8fb7ca78..fdba30a16ccebac97905829235ff1cbed6956961 100644
--- a/tk-silica/xt-silica.lisp
+++ b/tk-silica/xt-silica.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-silica.lisp,v 1.39 92/07/27 19:30:28 cer Exp $
+;; $fiHeader: xt-silica.lisp,v 1.40 92/08/18 17:26:44 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -351,129 +351,141 @@
   (declare (ignore sheet)))
 
 (defmethod sheet-mirror-event-handler (widget event sheet)
-  (multiple-value-bind (same-p root child root-x root-y native-x native-y mask)
-      (tk::query-pointer (tk::widget-window widget))
-    (declare (ignore same-p root child root-x root-y))
-    (let ((port (port sheet))
-	  (modifiers (logand #16rff mask))
-	  (button (ash mask -8)))
-      #+ignore
-      (format excl:*initial-terminal-io* "Got event ~s~%" (tk::event-type event))
-      (let ((clim-event
-	     (ecase (tk::event-type event)
-	       ((:map-notify :unmap-notify :selection-clear :selection-request
-		 :selection-notify :client-message :mapping-notify)
-		nil)
-	       (:configure-notify
-		(sheet-mirror-resized-callback
-		  widget nil event sheet)
-		nil)
-	       (:no-expose nil)
-	       (:graphics-expose
-		;; Tricky!
-		(setf (port-safe-backing-store (port sheet)) nil))
-		;; This gets called only for an XmBulletinBoard widget.
-	       (:expose
-		(sheet-mirror-exposed-callback
-		  widget 
-		  nil				; window
-		  event
-		  sheet)
-		nil)
-	       (:key-press
-		(multiple-value-bind (character keysym)
-		    (lookup-character-and-keysym sheet widget event)
-		  (allocate-event 'key-press-event
-		    :key-name keysym
-		    :character character
-		    :sheet sheet
-		    :modifier-state 
-		      (setf (port-modifier-state port)
-			    (state->modifiers
-			      (x11::xkeyevent-state event) nil)))))
-	       (:key-release
-		(multiple-value-bind (character keysym)
-		    (lookup-character-and-keysym sheet widget event)
-		  (allocate-event 'key-release-event
-		    :key-name keysym
-		    :character character
-		    :sheet sheet
-		    :modifier-state 
-		      (setf (port-modifier-state port)
-			    (state->modifiers
-			      (x11::xkeyevent-state event) nil)))))
-	       (:button-press
-		(let ((button (x-button->silica-button 
-				(x11::xbuttonevent-button event)))
-		      (pointer (port-pointer port)))
-		  (setf (pointer-button-state pointer) 
-			(logior (pointer-button-state pointer) (or button 0)))
-		  (allocate-event 'pointer-button-press-event
-		    :sheet sheet
-		    :pointer pointer
-		    :x :?? :y :??
-		    :modifier-state 
-		      (setf (port-modifier-state port)
-			    (state->modifiers
-			      (x11::xkeyevent-state event)))
-		    :button button
-		    :native-x (x11::xbuttonevent-x event)
-		    :native-y (x11::xbuttonevent-y event))))
-	       (:button-release
-		(let ((button (x-button->silica-button 
-				(x11::xbuttonevent-button event)))
-		      (pointer (port-pointer port)))
-		  (setf (pointer-button-state pointer) 
-			(logandc2 (pointer-button-state pointer) (or button 0)))
-		  (allocate-event 'pointer-button-release-event
-		    :pointer pointer
-		    :sheet sheet
-		    :x :?? :y :??
-		    :modifier-state 
-		      (setf (port-modifier-state port)
-			    (state->modifiers
-			      (x11::xkeyevent-state event)))
-		    :button button
-		    :native-x (x11::xbuttonevent-x event)
-		    :native-y (x11::xbuttonevent-y event))))
-	       (:leave-notify
-		(allocate-event 'pointer-exit-event
-		  :native-x native-x
-		  :native-y native-y
-		  :modifier-state 
-		    (setf (port-modifier-state port)
-			  (state->modifiers (x11::xkeyevent-state event)))
-		  :sheet sheet
-		  :pointer (port-pointer port)))
-	       (:enter-notify
-		(allocate-event 'pointer-enter-event
-		  :native-x native-x
-		  :native-y native-y
-		  :modifier-state 
-		    (setf (port-modifier-state port)
-			  (state->modifiers (x11::xkeyevent-state event)))
-		    :sheet sheet
-		    :pointer (port-pointer port)))
-	       (:motion-notify
-		(allocate-event 'pointer-motion-event
-		  :native-x native-x
-		  :native-y native-y
-		  :modifier-state 
-		    (setf (port-modifier-state port)
-			  (state->modifiers (x11::xkeyevent-state event)))
-		  :sheet sheet
-		  :pointer (port-pointer port))))))
-	(when clim-event
-	  (distribute-event (port sheet) clim-event))))))
+  #+ignore
+  (format excl:*initial-terminal-io* "Got event ~s~%" (tk::event-type event))
+  (let ((port (port sheet))
+	(clim-event nil))
+    (when port
+      (setq clim-event
+	(ecase (tk::event-type event)
+	  ((:map-notify :unmap-notify :selection-clear :selection-request
+	    :selection-notify :client-message :mapping-notify :no-expose)
+	   nil)
+	  (:configure-notify
+	   (sheet-mirror-resized-callback widget nil event sheet)
+	   nil)
+	  (:graphics-expose
+	   ;; Tricky!
+	   (setf (port-safe-backing-store port) nil)
+	   nil)
+	  (:expose
+	   ;; This gets called only for an XmBulletinBoard widget.
+	   (sheet-mirror-exposed-callback widget nil event sheet)
+	   nil)
+	  (:key-press
+	   (multiple-value-bind (character keysym)
+	       (lookup-character-and-keysym sheet widget event)
+	     (allocate-event 'key-press-event
+			     :sheet sheet
+			     :key-name keysym
+			     :character character
+			     :modifier-state 
+			     (setf (port-modifier-state port)
+			       (state->modifiers
+				(x11::xkeyevent-state event) nil)))))
+	  (:key-release
+	   (multiple-value-bind (character keysym)
+	       (lookup-character-and-keysym sheet widget event)
+	     (allocate-event 'key-release-event
+			     :sheet sheet
+			     :key-name keysym
+			     :character character
+			     :modifier-state 
+			     (setf (port-modifier-state port)
+			       (state->modifiers
+				(x11::xkeyevent-state event) nil)))))
+	  (:button-press
+	   (let ((button (x-button->silica-button 
+			  (x11::xbuttonevent-button event)))
+		 (pointer (port-pointer port)))
+	     (setf (pointer-button-state pointer) 
+	       (logior (pointer-button-state pointer) button))
+	     (allocate-event 'pointer-button-press-event
+			     :sheet sheet
+			     :pointer pointer
+			     :button button
+			     :native-x (x11::xbuttonevent-x event)
+			     :native-y (x11::xbuttonevent-y event)
+			     :x :?? :y :??
+			     :modifier-state 
+			     (setf (port-modifier-state port)
+			       (state->modifiers
+				(x11::xbuttonevent-state event))))))
+	  (:button-release
+	   (let ((button (x-button->silica-button 
+			  (x11::xbuttonevent-button event)))
+		 (pointer (port-pointer port)))
+	     (setf (pointer-button-state pointer) 
+	       (logandc2 (pointer-button-state pointer) button))
+	     (allocate-event 'pointer-button-release-event
+			     :sheet sheet
+			     :pointer pointer
+			     :button button
+			     :native-x (x11::xbuttonevent-x event)
+			     :native-y (x11::xbuttonevent-y event)
+			     :x :?? :y :??
+			     :modifier-state 
+			     (setf (port-modifier-state port)
+			       (state->modifiers
+				(x11::xkeyevent-state event))))))
+	  (:leave-notify
+	   (allocate-event 'pointer-exit-event
+			   :sheet sheet
+			   :native-x (x11:xcrossingevent-x event)
+			   :native-y (x11:xcrossingevent-y event)
+			   :kind (boundary-detail->kind
+				  (x11:xcrossingevent-detail event))
+			   :pointer (port-pointer port)
+			   :modifier-state 
+			   (setf (port-modifier-state port)
+			     (state->modifiers (x11::xcrossingevent-state event)))))
+	  (:enter-notify
+	   (allocate-event 'pointer-enter-event
+			   :pointer (port-pointer port)
+			   :sheet sheet
+			   :native-x (x11:xcrossingevent-x event)
+			   :native-y (x11:xcrossingevent-y event)
+			   :kind (boundary-detail->kind
+				  (x11:xcrossingevent-detail event))
+			   :modifier-state
+			   (setf (port-modifier-state port)
+			     (state->modifiers (x11::xcrossingevent-state event)))))
+	  (:motion-notify
+	   (multiple-value-bind (same-p root child root-x root-y
+				 native-x native-y state)
+	       (tk::query-pointer (tk::widget-window widget))
+	     (declare (ignore same-p root child))
+	     (allocate-event 'pointer-motion-event
+			     :pointer (port-pointer port)
+			     :sheet sheet
+			     :x root-x	; These are actually unused...
+			     :y root-y	; ""
+			     :native-x native-x
+			     :native-y native-y
+			     :modifier-state 
+			     (setf (port-modifier-state port)
+			       (state->modifiers state))))))))
+    (when clim-event
+      (distribute-event port clim-event))))
 
 (defun x-button->silica-button (button)
-  (ecase button
-    (0 nil)
-    (4 #+ignore (warn "got an event 4")
-       +pointer-left-button+)
-    (#.x11::button3 +pointer-right-button+)
+  (case button
+    (#.x11::button1 +pointer-left-button+)
     (#.x11::button2 +pointer-middle-button+)
-    (#.x11::button1 +pointer-left-button+)))
+    (#.x11::button3 +pointer-right-button+)
+    (#.x11::button4 +pointer-left-button+) ; These two are arbitrary.
+    (#.x11::button5 +pointer-left-button+)))
+
+(defun boundary-detail->kind (detail)
+  (declare (optimize (speed 3) (safety 0))
+	   (fixnum detail))
+  (case detail
+    (#.x11:notifyancestor :ancestor)
+    (#.x11:notifyvirtual  :virtual)
+    (#.x11:notifyinferior :inferior)
+    (#.x11:notifynonlinear :nonlinear)
+    (#.x11:notifynonlinearvirtual :nonlinear-virtual)))
+
 
 (defmethod sheet-mirror-resized-callback (widget window event sheet)
   (declare (ignore widget window event))
@@ -513,65 +525,66 @@
   (let ((port (port sheet)))
     (ecase (tk::event-type event)
       (:key-press
-	(distribute-event 
-	  port
-	  (multiple-value-bind (character keysym)
-	      (lookup-character-and-keysym sheet widget event)
-	    (allocate-event 'key-press-event
-	      :key-name keysym
-	      :character character
-	      :sheet sheet
-	      :modifier-state (setf (port-modifier-state port)
-				    (state->modifiers
-				      (x11::xkeyevent-state event) nil))))))
+       (distribute-event 
+	port
+	(multiple-value-bind (character keysym)
+	    (lookup-character-and-keysym sheet widget event)
+	  (allocate-event 'key-press-event
+			  :sheet sheet
+			  :key-name keysym
+			  :character character
+			  :modifier-state (setf (port-modifier-state port)
+					    (state->modifiers
+					     (x11::xkeyevent-state event) nil))))))
       (:key-release
-	(distribute-event
-	  port
-	  (multiple-value-bind (character keysym)
-	      (lookup-character-and-keysym sheet widget event)
-	    (allocate-event 'key-release-event
-	      :key-name keysym
-	      :character character
-	      :sheet sheet
-	      :modifier-state (setf (port-modifier-state port)
-				    (state->modifiers
-				      (x11::xkeyevent-state event) nil))))))
+       (distribute-event
+	port
+	(multiple-value-bind (character keysym)
+	    (lookup-character-and-keysym sheet widget event)
+	  (allocate-event 'key-release-event
+			  :sheet sheet
+			  :key-name keysym
+			  :character character
+			  :modifier-state (setf (port-modifier-state port)
+					    (state->modifiers
+					     (x11::xkeyevent-state event) nil))))))
       (:button-press
-	(let ((button (x-button->silica-button 
-			(x11::xbuttonevent-button event)))
-	      (pointer (port-pointer port)))
-	  (setf (pointer-button-state pointer) 
-		(logior (pointer-button-state pointer) (or button 0)))
-	  (distribute-event
-	    port
-	    (allocate-event 'pointer-button-press-event
-	      :sheet sheet
-	      :pointer pointer
-	      :x :?? :y :??
-	      :modifier-state (setf (port-modifier-state port)
-				    (state->modifiers
-				      (x11::xkeyevent-state event)))
-	      :button button
-	      :native-x (x11::xbuttonevent-x event)
-	      :native-y (x11::xbuttonevent-y event)))))
+       (let ((button (x-button->silica-button 
+		      (x11::xbuttonevent-button event)))
+	     (pointer (port-pointer port)))
+	 (setf (pointer-button-state pointer) 
+	   (logior (pointer-button-state pointer) button))
+	 (distribute-event
+	  port
+	  (allocate-event 'pointer-button-press-event
+			  :sheet sheet
+			  :pointer pointer
+			  :button button
+			  :native-x (x11::xbuttonevent-x event)
+			  :native-y (x11::xbuttonevent-y event)
+			  :x :?? :y :??
+			  :modifier-state (setf (port-modifier-state port)
+					    (state->modifiers
+					     (x11::xbuttonevent-state event)))))))
       (:button-release
-	(let ((button (x-button->silica-button 
-			(x11::xbuttonevent-button event)))
-	      (pointer (port-pointer port)))
-	  (setf (pointer-button-state pointer) 
-		(logandc2 (pointer-button-state pointer) (or button 0)))
-	  (distribute-event
-	    port
-	    (allocate-event 'pointer-button-release-event
-	      :sheet sheet
-	      :pointer pointer
-	      :x :?? :y :??
-	      :modifier-state (setf (port-modifier-state port)
-				    (state->modifiers
-				      (x11::xkeyevent-state event))) 
-	      :button button
-	      :native-x (x11::xbuttonevent-x event)
-	      :native-y (x11::xbuttonevent-y event))))))))
+       (let ((button (x-button->silica-button 
+		      (x11::xbuttonevent-button event)))
+	     (pointer (port-pointer port)))
+	 (setf (pointer-button-state pointer) 
+	   (logandc2 (pointer-button-state pointer) button))
+	 (distribute-event
+	  port
+	  (allocate-event 'pointer-button-release-event
+			  :sheet sheet
+			  :pointer pointer
+			  :button button
+			  :native-x (x11::xbuttonevent-x event)
+			  :native-y (x11::xbuttonevent-y event)
+			  :x :?? :y :??
+			  :modifier-state (setf (port-modifier-state port)
+					    (state->modifiers
+					     (x11::xbuttonevent-state event)))))))
+      )))
 
 (defmethod find-widget-class-and-initargs-for-sheet
     ((port xt-port) (parent t) (sheet sheet))
@@ -652,10 +665,6 @@
   (unless (xt::is-managed-p mirror)
     (manage-child mirror)))
 
-(defmethod enable-xt-widget ((parent top-level-shell) (mirror t))
-  (manage-child mirror)
-  (popup (widget-parent mirror)))
-
 (defmethod disable-mirror ((port xt-port) sheet)
   (declare (ignore port))
   (let ((mirror (sheet-mirror sheet)))
@@ -994,10 +1003,12 @@
 (define-xt-keysym right-hyper-keysym   :right-hyper)
 
 (defun lookup-character-and-keysym (sheet mirror event)
-  (declare (ignore sheet mirror))
+  (declare (ignore sheet mirror)
+	   (optimize (speed 3) (safety 0)))
   (multiple-value-bind (character keysym)
       (tk::lookup-string event)
-    (setq character (and (= (length character) 1) (aref character 0)))
+    (setq character (and (= (length (the simple-string character)) 1)
+			 (aref (the simple-string character) 0)))
     ;;--- Map the asci control-characters into the common lisp
     ;;--- control characters except where they are special!
     ;; Also deal with the modifier bits
@@ -1016,23 +1027,29 @@
 						 #\page
 						 #\backspace
 						 #\linefeed
-						 #\escape))))
+						 #\escape)
+					       :test #'eq)))
 			     (cltl1::int-char
 			      (+ (cltl1::char-int character)
 				 (1- (if (logtest x +shift-key+)
 					 (char-int #\A)
 				       (char-int #\a)))))
 			   character)
-			 ;;-- Should deal with hyper and super also
 			 (logior
 			  (if (logtest x +control-key+)
 			      cltl1:char-control-bit 0)
 			  (if (logtest x +meta-key+)
-			      cltl1:char-meta-bit 0))))))
+			      cltl1:char-meta-bit 0)
+			  (if (logtest x +super-key+)
+			      cltl1:char-super-bit 0)
+			  (if (logtest x +hyper-key+)
+			      cltl1:char-hyper-bit 0))))))
     (values character (xt-keysym->keysym keysym))))
 
 
 (defun state->modifiers (x &optional (shift-it t))
+  (declare (optimize (speed 3) (safety 0))
+	   (fixnum x))
   (logior
     (if (and shift-it (logtest x x11:shiftmask)) +shift-key+ 0)
     (if (logtest x x11:controlmask) +control-key+ 0)
@@ -1227,20 +1244,17 @@ the geometry of the children. Instead the parent has control. "))
 	   silica::*ports*))
 
 
-(defmethod port-canonicalize-gesture-spec ((port xt-port) gesture-spec &optional modifier-state)
-  (multiple-value-bind (keysym shifts)
-      (if modifier-state
-	  (values gesture-spec modifier-state)
-	(parse-gesture-spec gesture-spec))
-    ;; Here, we must take the gesture spec, turn it back into
-    ;; a keycode, then see what the keysyms are for that keycode
-    (let ((x-keysym (if (and (characterp keysym) (standard-char-p keysym))
-			(keysym->xt-keysym (xt-keysym->keysym (char-code keysym)))
-		      (keysym->xt-keysym keysym)))
-	  (x-keycode nil))
-      (unless x-keysym 
-	(return-from port-canonicalize-gesture-spec nil))
-      (cons keysym shifts))))
+(defmethod port-canonicalize-gesture-spec ((port xt-port) keysym &optional shifts)
+  (declare (optimize (speed 3) (safety 0)))
+  ;; Here, we must take the gesture spec, turn it back into
+  ;; a keycode, then see what the keysyms are for that keycode
+  (let ((x-keysym (if (and (characterp keysym) (standard-char-p keysym))
+		      (keysym->xt-keysym (xt-keysym->keysym (char-code keysym)))
+		    (keysym->xt-keysym keysym)))
+	(x-keycode nil))
+    (unless x-keysym 
+      (return-from port-canonicalize-gesture-spec nil))
+    (cons keysym shifts)))
 
 
 (defmethod port-set-pointer-position ((port xt-port) pointer x y)
@@ -1260,13 +1274,13 @@ the geometry of the children. Instead the parent has control. "))
 
 
 (defmethod enable-mirror ((port xt-port) (sheet top-level-sheet))
-   (let* ((mirror (sheet-mirror sheet))
+  (let* ((mirror (sheet-mirror sheet))
  	 (parent (widget-parent mirror)))
-     (manage-child mirror)
-     (xt:realize-widget parent)		; Make sure widget is realized.
-     (let ((ussp (slot-value sheet 'silica::user-specified-size-p))
+    (manage-child mirror)
+    (xt:realize-widget parent)		; Make sure widget is realized.
+    (let ((ussp (slot-value sheet 'silica::user-specified-size-p))
  	  (uspp (slot-value sheet 'silica::user-specified-position-p)))
-       (unless (and (eq ussp :unspecified)
+      (unless (and (eq ussp :unspecified)
  		   (eq uspp :unspecified))
  	(let* ((window (tk::widget-window parent))
  	       (display (tk::widget-display parent))
@@ -1287,9 +1301,9 @@ the geometry of the children. Instead the parent has control. "))
  		 then (setf flags (logandc2 flags x11::ussizehint)))
  	      (setf (x11::xsizehints-flags size-hints) flags))
  	    (x11::xsetwmnormalhints display window size-hints)))))
-     (popup parent)))
+    (popup parent)))
  
- (defmethod enable-xt-widget ((parent top-level-shell) (mirror t))
-   (manage-child mirror)
-   (popup (widget-parent mirror)))
+(defmethod enable-xt-widget ((parent top-level-shell) (mirror t))
+  (manage-child mirror)
+  (popup (widget-parent mirror)))
 
diff --git a/tk/convenience.lisp b/tk/convenience.lisp
index 32da4951a490c8133eae89a4a3eb331c031e4dc8..175e59a72c7312c1c2ec166391019c195fc4905b 100644
--- a/tk/convenience.lisp
+++ b/tk/convenience.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: convenience.lisp,v 1.10 92/06/16 19:10:47 cer Exp $
+;; $fiHeader: convenience.lisp,v 1.11 92/07/27 19:28:54 cer Exp $
 
 (in-package :tk)
 
@@ -30,7 +30,13 @@
 	   (intern (substitute #\_ #\- 
 			       (lispify-tk-name entry-point :package nil)))))
       `(progn
-	 (defforeign ',c-function-name :entry-point ,entry-point)
+	 (eval-when (eval compile)
+	   (defforeign ',c-function-name
+	       :entry-point ,entry-point
+	       :call-direct t
+	       :arguments '(foreign-address foreign-address foreign-address fixnum)
+	       :arg-checking nil
+	       :return-type :unsigned-integer))
 	 (defclass ,class ,superclasses
 	   ()
 	   (:metaclass xt-class))
diff --git a/tk/font.lisp b/tk/font.lisp
index 5d92d4155314c25d7385591d2915ee11ea03c0d3..c0b8a53509de184c7a2c3d5689ca85e2d14aa023 100644
--- a/tk/font.lisp
+++ b/tk/font.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: font.lisp,v 1.11 92/04/28 09:25:00 cer Exp $
+;; $fiHeader: font.lisp,v 1.12 92/05/22 19:26:18 cer Exp $
 
 (in-package :tk)
 
@@ -48,23 +48,23 @@
 		    :display display
 		    :foreign-address h)))
 
-(defmethod font-width (font)
+(defun font-width (font)
   (x11::xfontstruct-max-bounds-width font))
  
-(defmethod font-height (font)
-  (+ (font-ascent font)
-     (font-descent font)))
+(defun font-height (font)
+  (+ (x11:xfontstruct-ascent font)
+     (x11:xfontstruct-descent font)))
 
-(defmethod font-ascent (font)
+(defun font-ascent (font)
   (x11:xfontstruct-ascent font))
 
-(defmethod font-descent (font)
+(defun font-descent (font)
   (x11:xfontstruct-descent font))
 
-(defmethod font-all-chars-exist-p (font)
+(defun font-all-chars-exist-p (font)
   (x11:xfontstruct-all-chars-exist font))
 
-(defmethod font-range (font)
+(defun font-range (font)
   (let* ((h font)
 	 (min-byte-1 (x11:xfontstruct-min-byte1 h))
 	 (max-byte-1 (x11:xfontstruct-max-byte1 h)))
@@ -73,7 +73,7 @@
 	   (values (x11:xfontstruct-min-char-or-byte2 h)
 		   (x11:xfontstruct-max-char-or-byte2 h))))))
 
-(defmethod char-width (font index)
+(defun char-width (font index)
   (multiple-value-bind
       (min max) (font-range font)
     (if (and (<= min index)
@@ -82,7 +82,7 @@
 	 (x11:xfontstruct-per-char font)
 	 (- index min)))))
 
-(defmethod char-dimensions (font index)
+(defun char-dimensions (font index)
   (multiple-value-bind
       (min max) (font-range font)
     (if (and (<= min index)
diff --git a/tk/foreign.lisp b/tk/foreign.lisp
index 92d7717370b9970cd289052b03a9d5293bc00d72..9c8bd81ed9cb08ac8a43cad09ab670eae66f7e31 100644
--- a/tk/foreign.lisp
+++ b/tk/foreign.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: foreign.lisp,v 1.11 92/05/13 17:10:13 cer Exp Locker: cer $
+;; $fiHeader: foreign.lisp,v 1.12 92/05/22 19:26:19 cer Exp $
 
 (in-package :tk)
 
@@ -70,8 +70,11 @@
 			      argc
 			      argv))))
     (if (zerop d)
-	(error "cannot open the display: ~A" host)
-      d)))
+	(error "cannot open the display: ~A" host))
+    ;; Used for debugging:
+    #+ignore
+    (x11:xsynchronize d 1)
+    d))
 
 (defmethod initialize-instance :after ((d display) &rest args
 				       &key display
diff --git a/tk/init.lisp b/tk/init.lisp
deleted file mode 100644
index d3ece19a63a7f5600ee83f8f09280467c6a48a7e..0000000000000000000000000000000000000000
--- a/tk/init.lisp
+++ /dev/null
@@ -1,33 +0,0 @@
-;; -*- mode: common-lisp; package: tk -*-
-;;
-;;				-[]-
-;; 
-;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
-;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA  All rights reserved.
-;;
-;; The software, data and information contained herein are proprietary
-;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
-;; given in confidence by Franz, Inc. pursuant to a written license
-;; agreement, and may be stored and used only in accordance with the terms
-;; of such license.
-;;
-;; Restricted Rights Legend
-;; ------------------------
-;; Use, duplication, and disclosure of the software, data and information
-;; contained herein by any agency, department or entity of the U.S.
-;; Government are subject to restrictions of Restricted Rights for
-;; Commercial Software developed at private expense as specified in FAR
-;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
-;; applicable.
-;;
-;; $fiHeader: init.lisp,v 1.4 92/02/24 13:03:05 cer Exp $
-
-
-(in-package :tk)
-
-(defvar *done* nil)
-(unless *done*
-  (insert_classes)
-  (xt_toolkit_initialize)
-  (make-classes)
-  (setq *done* t))
diff --git a/tk/load-ol.lisp b/tk/load-ol.lisp
index e51d2a0e7c0501314d18292a671868401aaf1fcd..87409db10f9351cd3c3e4f5fedf6e9053f4f00ac 100644
--- a/tk/load-ol.lisp
+++ b/tk/load-ol.lisp
@@ -1,4 +1,4 @@
-;; -*- mode: common-lisp; package: tk -*-
+;; -*- mode: common-lisp; package: user -*-
 ;;
 ;;				-[]-
 ;; 
@@ -20,52 +20,23 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: load-ol.lisp,v 1.12 92/06/23 08:19:07 cer Exp $
+;; $fiHeader: load-ol.lisp,v 1.13 92/07/27 19:28:56 cer Exp $
 
-(in-package :tk)
+(in-package :user)
 
-(defvar sys::*libxol-pathname* "/vapor/usr/tech/cer/stuff/clim-2.0/tk/lib2/libXol.a")
-(defvar sys::*libxt-pathname* "/x11/R4/sun4-lib/libXt_d.a")
+(provide :climxm)
+(require :climg)
 
-(defun load-from-ol ()
-  (unless (ff:get-entry-point (ff:convert-to-lang "ol_appl_add_item"))
-    #+ignore (mapc #'ff::remove-entry-point
-		   '("__unpack_quadruple" 
-		     "__prod_b10000" 
-		     "__carry_out_b10000" 
-		     "__prod_65536_b10000"
-		     "__unpacked_to_decimal"
-		     ;; got these when compiling on ox
-		     "__pack_integer"
-		     "_class_double"
-		     "_class_single"
-		     "_class_extended"
-		     "__unpack_integer"))
-    (load "olsupport.o"
-	  :system-libraries (list sys::*libxol-pathname*
-				  sys::*libxt-pathname*
-				  sys::*libx11-pathname*)
-	  :print t))
-  (x11::load-undefined-symbols-from-library
-   "stub-olit.o"
-   (x11::symbols-from-file 
-    "misc/undefinedsymbols.xt"
-    "misc/undefinedsymbols.olit")
-   #+ignore '("__unpack_quadruple" 
-	      "__unpacked_to_decimal"
-	      "__prod_b10000" 
-	      "__carry_out_b10000" 
-	      "__prod_65536_b10000"
-	      ;; got these when compiling on ox
-	      "__pack_integer"
-	      "_class_double"
-	      "_class_single"
-	      "_class_extended"
-	      "__unpack_integer")
-   #-ignore nil
-   (list sys::*libxol-pathname*
-	 sys::*libxt-pathname*
-	 sys::*libx11-pathname*)))
+(defvar sys::*libxt-pathname* "/x11/R4/sun4-lib/libXt.a")
 
-(load-from-ol)
+(x11::load-undefined-symbols-from-library
+ "clim-olit"
+ (x11::symbols-from-file "misc/undefinedsymbols.olit")
+ (list sys::*libxt-pathname* sys::*libx11-pathname*))
+(unless (ff:get-entry-point (ff:convert-to-lang "ol_appl_add_item"))
+  (load "olsupport.o"
+	:system-libraries (list sys::*libxt-pathname*
+				sys::*libx11-pathname*)
+	:print t))
 
+(pushnew :clim-openlook *features*)
diff --git a/tk/load-xm.lisp b/tk/load-xm.lisp
index 8574d83178971b583035eb616127954b5924fc96..1a532ca750fb04139d1d18b678f176eec4c2a05b 100644
--- a/tk/load-xm.lisp
+++ b/tk/load-xm.lisp
@@ -1,4 +1,4 @@
-;; -*- mode: common-lisp; package: tk -*-
+;; -*- mode: common-lisp; package: user -*-
 ;;
 ;;				-[]-
 ;; 
@@ -20,51 +20,25 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: load-xm.lisp,v 1.16 92/07/06 18:51:19 cer Exp $
+;; $fiHeader: load-xm.lisp,v 1.17 92/07/27 19:28:57 cer Exp $
 
-(in-package :tk)
+(in-package :user)
+
+(provide :climxm)
+(require :climg)
 
 ;;;; 
-(defvar sys::*libxt-pathname* "/x11/R4/sun4-lib/libXt_d.a")
-(defvar sys::*libxm-pathname* "/x11/R4/sun4-lib/libXm_d.a")
+(defvar sys::*libxt-pathname* "/x11/R4/sun4-lib/libXt.a")
 
-(defun load-from-xm ()
-  (unless (ff:get-entry-point (ff:convert-to-lang "XmCreateMyDrawingArea"))
-    #+ignore (mapc #'ff::remove-entry-point
-		   '("__unpack_quadruple" 
-		     "__prod_b10000" 
-		     "__carry_out_b10000" 
-		     "__prod_65536_b10000"
-		     ;; got these when compiling on ox
-		     "__pack_integer"
-		     "_class_double"
-		     "_class_single"
-		     "_class_extended"
-		     "__unpack_integer"))
-    (load "MyDrawingA.o"
-	  :system-libraries (list sys::*libxm-pathname* 
-				  sys::*libxt-pathname*
-				  sys::*libx11-pathname*)
-	  :print t))
-  (x11::load-undefined-symbols-from-library
-   "stub-motif.o"
-   (x11::symbols-from-file 
-    "misc/undefinedsymbols.xt"
-    "misc/undefinedsymbols.motif")
-   #+ignore '("__unpack_quadruple" 
-	      "__prod_b10000" 
-	      "__carry_out_b10000" 
-	      "__prod_65536_b10000"
-	      ;; got these when compiling on ox
-	      "__pack_integer"
-	      "_class_double"
-	      "_class_single"
-	      "_class_extended"
-	      "__unpack_integer")
-   #-ignore nil
-   (list sys::*libxm-pathname*
-	 sys::*libxt-pathname*
-	 sys::*libx11-pathname*)))
+(x11::load-undefined-symbols-from-library
+ "clim-motif.o"
+ (x11::symbols-from-file "misc/undefinedsymbols.motif")
+ (list sys::*libxt-pathname* sys::*libx11-pathname*))
 
-(load-from-xm)
+(unless (ff:get-entry-point (ff:convert-to-lang "XmCreateMyDrawingArea"))
+  (load "MyDrawingA.o"
+	:system-libraries (list sys::*libxt-pathname*
+				sys::*libx11-pathname*)
+	:print t))
 
+(pushnew :clim-motif *features*)
diff --git a/tk/load-xt.lisp b/tk/load-xt.lisp
index b1c9a22564772d61b2f1624eef1a97ea3a7f6b21..a7aa9c0539386411c328e0637428f0a478faa2e9 100644
--- a/tk/load-xt.lisp
+++ b/tk/load-xt.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: load-xt.lisp,v 1.2 92/06/02 13:30:38 cer Exp $
+;; $fiHeader: load-xt.lisp,v 1.3 92/07/27 19:28:59 cer Exp $
 
 (in-package :tk)
 
@@ -28,19 +28,14 @@
 
 ;;;; 
 
-(defvar *libxt-pathname* "/x11/R4/sun4-lib/libXt_d.a")
+(defvar sys::*libxt-pathname* "/x11/R4/sun4-lib/libXt.a")
 
 
 (defun load-from-xt ()
   (x11::load-undefined-symbols-from-library
    "stub-xt.o"
    (x11::symbols-from-file "misc/undefinedsymbols.xt")
-   #+ignore '("__unpack_quadruple" 
-	      "__prod_b10000" 
-	      "__carry_out_b10000" 
-	      "__prod_65536_b10000")
-   #-ignore nil
-   (list *libxt-pathname* x11::*libx11-pathname*)))
+   (list sys::*libxt-pathname* sys::*libx11-pathname*)))
 
 (load-from-xt)
 
diff --git a/tk/make-classes.lisp b/tk/make-classes.lisp
index 06a0dd15055562a943cd9dad5dc51f0d38842ba0..babd2c12ab9d18606e21ade54c869b0a6b2219af 100644
--- a/tk/make-classes.lisp
+++ b/tk/make-classes.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: make-classes.lisp,v 1.23 92/07/27 19:29:00 cer Exp $
+;; $fiHeader: make-classes.lisp,v 1.24 92/08/18 17:23:20 cer Exp Locker: cer $
 
 (in-package :tk)
 
@@ -62,6 +62,11 @@
       (error "No resource named ~s found for class ~s" resource-name class))
     result))
 
+;; These are so we don't need the foreign functions at run time.
+(defun xt-get-resource-list (class res-return num-res-return)
+  (xt_get_resource_list class res-return num-res-return))
+(defun xt-get-constraint-resource-list (class res-return num-res-return)
+  (xt_get_constraint_resource_list class res-return num-res-return))
 
 (defmethod find-class-resource ((class xt-class) resource-name)
   (declare (optimize (speed 3) (safety 0)))
@@ -76,7 +81,7 @@
 		     :key #'resource-name)
 	     thenret
 	     else (get-resource-internal class
-					 #'xt_get_resource_list
+					 #'xt-get-resource-list
 					 'resource
 					 resource-name)))))))
 
@@ -90,7 +95,7 @@
 	  value				; Never had it, never will
 	(setf (gethash resource-name cached-constraint-resources)
 	  (get-resource-internal class
-				 #'xt_get_constraint_resource_list
+				 #'xt-get-constraint-resource-list
 				 'constraint-resource
 				 resource-name))))))
 
@@ -126,10 +131,10 @@
       r)))
       
 (defun get-resource-list (class) 
-  (get-resource-list-internal class #'xt_get_resource_list 'resource))
+  (get-resource-list-internal class #'xt-get-resource-list 'resource))
 
 (defun get-constraint-resource-list (class) 
-  (get-resource-list-internal class #'xt_get_constraint_resource_list
+  (get-resource-list-internal class #'xt-get-constraint-resource-list
 			      'constraint-resource))
 
 
@@ -183,6 +188,7 @@
   (let ((clist nil))
     
     (dolist (class-ep classes)
+      #+ignore
       (format excl:*initial-terminal-io* ";; Initializing class ~s~%" class-ep)
       (let ((h (get-foreign-variable-value class-ep)))
 	(push (list h class-ep) clist)
@@ -257,11 +263,12 @@
 
 
 (defun-c-callable toolkit-error-handler ((message :unsigned-long))
-  (error "toolkit error: ~a" (char*-to-string message)))
+  (let ((*error-output* excl:*initial-terminal-io*))
+    (error "Xt: ~a" (char*-to-string message))))
 
 (defun-c-callable toolkit-warning-handler ((message :unsigned-long))
   (let ((*error-output* excl:*initial-terminal-io*))
-    (warn "toolkit warning: ~a" (char*-to-string message))))
+    (warn "Xt: ~a" (char*-to-string message))))
 
 
 ;; This is a terrible hack used to compensate for bugs/inconsistencies
diff --git a/tk/ol-classes.lisp b/tk/ol-classes.lisp
index 247e9678ee36f5bd6343aea1033bf2e27efc153f..c7558796d005bcb857eeca28f68fb47103642528 100644
--- a/tk/ol-classes.lisp
+++ b/tk/ol-classes.lisp
@@ -20,10 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-classes.lisp,v 1.5 92/05/07 13:10:54 cer Exp Locker: cer $
-
-(provide :climol)
-(require :climg)
+;; $fiHeader: ol-classes.lisp,v 1.6 92/06/23 08:19:12 cer Exp $
 
 (in-package :tk)
 
diff --git a/tk/ol-funs.lisp b/tk/ol-funs.lisp
index 89eb4cd104a0580d49d5e8bf5070eae689037d2c..eb96b53ce1bbb910f5f26ee18cf3b49a0c3a9b93 100644
--- a/tk/ol-funs.lisp
+++ b/tk/ol-funs.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-funs.lisp,v 1.4 92/06/23 08:19:14 cer Exp Locker: cer $
+;; $fiHeader: ol-funs.lisp,v 1.5 92/06/29 14:04:21 cer Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -28,33 +28,122 @@
 
 (in-package :tk)
 
-(defforeign 'ol_toolkit_initialize :entry-point "_OlToolkitInitialize")
+(defforeign 'ol_toolkit_initialize
+    :entry-point "_OlToolkitInitialize"
+    :call-direct t
+    :arguments nil 
+    :arg-checking nil
+    :return-type :void)
 
 (defforeign 'ol_set_warning_handler 
-    :entry-point "_OlSetWarningHandler")
+    :entry-point "_OlSetWarningHandler"
+    :call-direct t
+    :arguments '(integer)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 (defforeign 'ol_set_error_handler 
-  :entry-point "_OlSetErrorHandler")
-
+    :entry-point "_OlSetErrorHandler"
+    :call-direct t
+    :arguments '(integer)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+    
 (defforeign 'ol_set_va_display_error_msg_handler
-    :entry-point "_OlSetVaDisplayErrorMsgHandler")
+    :entry-point "_OlSetVaDisplayErrorMsgHandler"
+    :call-direct t
+    :arguments '(integer)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 (defforeign 'ol_set_va_display_warning_msg_handler
-    :entry-point "_OlSetVaDisplayWarningMsgHandler")
+    :entry-point "_OlSetVaDisplayWarningMsgHandler"
+    :call-direct t
+    :arguments '(integer)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+    
+(defforeign 'ol_add_callback
+    :entry-point "_OlAddCallback"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :void)
+
+(defforeign 'ol_set_input_focus
+    :entry-point "_OlSetInputFocus"
+    :call-direct t
+    :arguments '(foreign-address fixnum integer)
+    :arg-checking nil
+    :return-type :void)
 
-(defforeign 'ol_add_callback :entry-point "_OlAddCallback")
+(defforeign 'ol_menu_post
+    :entry-point "_OlMenuPost"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :void)
+    
+(defforeign 'ol_menu_popdown
+    :entry-point "_OlMenuPopdown"
+    :call-direct t
+    :arguments '(foreign-address fixnum)
+    :arg-checking nil
+    :return-type :void)
+    
+(defforeign 'ol_text_edit_clear_buffer
+    :entry-point "_OlTextEditClearBuffer"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :fixnum)
 
-(defforeign 'ol_set_input_focus :entry-point "_OlSetInputFocus")
+(defforeign 'ol_text_edit_read_substring
+    :entry-point "_OlTextEditReadSubString"
+    :call-direct t
+    :arguments '(foreign-address foreign-address fixnum fixnum)
+    :arg-checking nil
+    :return-type :fixnum)
 
-(defforeign 'ol_menu_post :entry-point "_OlMenuPost")
-(defforeign 'ol_menu_popdown :entry-point "_OlMenuPopdown")
-(defforeign 'ol_appl_add_item :entry-point "_ol_appl_add_item")
-(defforeign 'ol_list_item_pointer :entry-point "_ol_list_item_pointer")
+(defforeign 'ol_text_edit_insert
+    :entry-point "_OlTextEditInsert"
+    :call-direct t
+    :arguments '(foreign-address foreign-address fixnum)
+    :arg-checking nil
+    :return-type :fixnum)
+    
+(defforeign 'ol_text_edit_get_last_position
+    :entry-point "_OlTextEditGetLastPosition"
+    :call-direct t
+    :arguments '(foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :fixnum)
+    
+(defforeign 'ol_register_help
+    :entry-point "_OlRegisterHelp"
+    :call-direct t
+    :arguments '(fixnum foreign-address foreign-address fixnum foreign-address)
+    :arg-checking nil
+    :return-type :void)
 
-(defforeign 'ol_appl_touch_item :entry-point "_ol_appl_touch_item")
+(defforeign 'ol_appl_add_item
+    :entry-point "_ol_appl_add_item"
+    :call-direct t
+    :arguments '(integer foreign-address foreign-address foreign-address
+		 foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+    
+(defforeign 'ol_list_item_pointer
+    :entry-point "_ol_list_item_pointer"
+    :call-direct t
+    :arguments '(integer)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
-(defforeign 'ol_text_edit_clear_buffer :entry-point "_OlTextEditClearBuffer")
-(defforeign 'ol_text_edit_read_substring :entry-point "_OlTextEditReadSubString")
-(defforeign 'ol_text_edit_insert :entry-point "_OlTextEditInsert")
-(defforeign 'ol_text_edit_get_last_position :entry-point "_OlTextEditGetLastPosition")
-(defforeign 'ol_register_help :entry-point "_OlRegisterHelp")
+(defforeign 'ol_appl_touch_item
+    :entry-point "_ol_appl_touch_item"
+    :call-direct t
+    :arguments '(integer foreign-address integer)
+    :arg-checking nil
+    :return-type :void)
diff --git a/tk/ol-init.lisp b/tk/ol-init.lisp
index b6421aa3466ab7656635dafd55e470ea69ceed48..cd94c31de9045ea7f106d8d1e0312a243709f879 100644
--- a/tk/ol-init.lisp
+++ b/tk/ol-init.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-init.lisp,v 1.14 92/06/02 13:30:39 cer Exp $
+;; $fiHeader: ol-init.lisp,v 1.15 92/07/27 19:29:11 cer Exp $
 
 
 (in-package :tk)
@@ -29,36 +29,24 @@
   (ol_toolkit_initialize))
 
 (defun-c-callable ol-error-handler ((message :unsigned-long))
-  (error "toolkit error: ~A"
-	 (char*-to-string message)))
+  (let ((*error-output* excl:*initial-terminal-io*))
+    (error "OLit: ~A" (char*-to-string message))))
 
 
 (defun-c-callable ol-warning-handler ((message :unsigned-long))
-  (warn "toolkit error: ~A"
-	(char*-to-string message)))
+  (let ((*error-output* excl:*initial-terminal-io*))
+    (warn "OLit: ~A" (char*-to-string message))))
 
 (defun-c-callable ol-error-va-handler ((message :unsigned-long))
-  (error "toolkit error: ~A"
-	 (char*-to-string message)))
+  (let ((*error-output* excl:*initial-terminal-io*))
+    (error "OLit: ~A" (char*-to-string message))))
 
 
 (defun-c-callable ol-warning-va-handler ((message :unsigned-long))
-  (warn "toolkit error: ~A"
-	(char*-to-string message)))
+  (let ((*error-output* excl:*initial-terminal-io*))
+    (warn "OLit: ~A" (char*-to-string message))))
 
 
-(defforeign 'ol_set_warning_handler 
-    :entry-point "_OlSetWarningHandler")
-
-(defforeign 'ol_set_error_handler 
-  :entry-point "_OlSetErrorHandler")
-
-(defforeign 'ol_set_va_display_error_msg_handler
-    :entry-point "_OlSetVaDisplayErrorMsgHandler")
-
-(defforeign 'ol_set_va_display_warning_msg_handler
-    :entry-point "_OlSetVaDisplayWarningMsgHandler")
-
 (ol_set_warning_handler (register-function 'ol-warning-handler))
 (ol_set_va_display_warning_msg_handler (register-function 'ol-warning-va-handler))
 (ol_set_error_handler (register-function 'ol-error-handler))
diff --git a/tk/pkg.lisp b/tk/pkg.lisp
index 8c88ff8b1a2134dd975b8d35e419a18d64989389..5ddd12c3b72b7acf8534f16c4c80e5216e0f81dc 100644
--- a/tk/pkg.lisp
+++ b/tk/pkg.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: pkg.lisp,v 1.10 92/06/16 19:10:53 cer Exp $
+;; $fiHeader: pkg.lisp,v 1.11 92/07/27 19:29:16 cer Exp $
 
 (defpackage :tk
   ;;-- No we really need
@@ -45,5 +45,6 @@
    #:int32
    #:int16
    #:int8
+   #:with-server-grabbed
    ))
 
diff --git a/tk/resources.lisp b/tk/resources.lisp
index 71429f8553f934dcef0e1105aef07a012f941822..dce12bb55bd632dc16ffd2755ac436965866a0d8 100644
--- a/tk/resources.lisp
+++ b/tk/resources.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: resources.lisp,v 1.27 92/07/01 15:44:36 cer Exp $
+;; $fiHeader: resources.lisp,v 1.28 92/07/08 16:28:50 cer Exp $
 
 (in-package :tk)
 
@@ -42,17 +42,6 @@
   (cerror "Try again" "cannot convert-in resource for ~S,~S,~S" class type value)
   (convert-resource-in class type value))
 
-(defconstant xm_string_default_char_set "")
-
-(defmethod convert-resource-in (class (type (eql 'xm-string)) value)
-  (and (not (zerop value))
-       (with-ref-par ((string 0))
-	 ;;--- I think we need to read the book about
-	 ;;--- xm_string_get_l_to_r and make sure it works with multiple
-	 ;;-- segment strings
-	 (xm_string_get_l_to_r value xm_string_default_char_set string)
-	 (char*-to-string (aref string 0)))))
-
 (define-enumerated-resource separator-type (:no-line 
 					    :single-line
 					    :double-line 
@@ -489,9 +478,6 @@
 	result
       (ff:foreign-pointer-address result))))
 
-(defmethod convert-resource-out ((parent t) (type (eql 'xm-string)) value)
-  (xm_string_create_l_to_r (string-to-char* value) (string-to-char* "")))
-
 (defmethod convert-resource-out ((parent t) (type (eql 'orientation)) value)
   (ecase value
     (:vertical 1)
@@ -553,11 +539,6 @@
 (defmethod convert-resource-out ((parent t) (type (eql 'window)) x)
   x)
 
-(defmethod convert-resource-out ((parent t) (type (eql 'xm-background-pixmap)) value)
-  (etypecase value
-    (pixmap
-     (encode-pixmap nil value))))
-
 (defmethod convert-resource-out ((widget t) (type (eql 'widget)) x)
   x)
 
@@ -600,17 +581,6 @@
 
 
 
-;;-- This is a problem cos we dont know the number of items
-
-(defmethod convert-resource-in ((parent t) (type (eql 'xm-string-table)) value)
-  value)
-
-(defun convert-xm-string-table-in (parent table n)
-  (let ((r nil))
-    (dotimes (i n (nreverse r))
-      (push (convert-resource-in parent 'xm-string (x-arglist table i))
-	    r))))
-
 (defmethod convert-resource-out ((parent t) (type (eql 'proc)) value)
   (etypecase value
     ;;-- Should check to see if its registered
diff --git a/tk/widget.lisp b/tk/widget.lisp
index 7f07b3d43a08a978a4e70565ef7bf2ff9486093c..b2af6fca569614ddd7ee8e9c4162f466b6ff6f82 100644
--- a/tk/widget.lisp
+++ b/tk/widget.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: widget.lisp,v 1.22 92/06/29 14:04:24 cer Exp $
+;; $fiHeader: widget.lisp,v 1.23 92/07/27 19:29:18 cer Exp $
 
 (in-package :tk)
 
@@ -46,14 +46,20 @@
 	    :display display
 	    args))))
 
+;; These are so we don't need the foreign functions at run time.
+(defun xt-create-widget (name class parent args num-args)
+  (xt_create_widget name class parent args num-args))
+(defun xt-create-managed-widget (name class parent args num-args)
+  (xt_create_managed_widget name class parent args num-args))
+
 (defun create-widget (name widget-class parent &rest args)
   (apply #'create-widget-1 
-	 #'xt_create_widget name widget-class parent 
+	 #'xt-create-widget name widget-class parent 
 	 args))
 
 (defun create-managed-widget (name widget-class parent &rest args)
   (apply #'create-widget-1 
-	 #'xt_create_managed_widget name widget-class parent 
+	 #'xt-create-managed-widget name widget-class parent 
 	 args))
 
 
@@ -242,7 +248,7 @@
 	      (error (c) c "Get-values failed!")))))
 
 (defun set-sensitive (widget value)
-  (xtsetsensitive widget (if value 1 0)))
+  (xt_set_sensitive widget (if value 1 0)))
 
 
 ;; Could not think of anywhere better!
diff --git a/tk/xlib.lisp b/tk/xlib.lisp
index 8c9de2df5a25dce0de70a8991d08103c9be41589..a49677343db5ce91c054e8a0ca1d51ab725e5a7c 100644
--- a/tk/xlib.lisp
+++ b/tk/xlib.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xlib.lisp,v 1.22 92/07/01 15:44:38 cer Exp Locker: cer $
+;; $fiHeader: xlib.lisp,v 1.23 92/07/24 10:53:40 cer Exp $
 
 (in-package :tk)
 
@@ -132,6 +132,7 @@
 (define-window-reader map-state decode-window-map-state)
 
 (defun decode-window-map-state (x)
+  (declare (optimize (speed 3) (safety 0)))
   (ecase x
     (0 :unmapped)
     (1 :unviewable)
@@ -176,13 +177,57 @@
 	 depth))
       (register-xid p display))))
 
-(defun-c-callable x-error-handler ((display :unsigned-long) (x :unsigned-long))
-  (error "x-error:~S" 
-	 (get-error-text (x11:xerrorevent-error-code x) display)))
-
-(defun-c-callable x-io-error-handler (x)
-  (error "x-io-error:~S" x))
-
+;; --
+;; Error handling
+
+(define-condition x-error (error)
+  ((display :reader x-error-display :initarg :display)
+   (error-code :reader x-error-error-code :initarg :error-code)
+   (request-code :reader x-error-request-code :initarg :request-code)
+   (minor-code :reader x-error-minor-code :initarg :minor-code)
+   (serial :reader x-error-serial :initarg :serial)
+   (resourceid :reader x-error-resourceid :initarg :resourceid)
+   (current-serial :reader x-error-current-serial :initarg :current-serial)
+   (asynchronous :reader x-error-asynchronous :initarg :asynchronous))
+  (:report report-x-error))
+
+(defun report-x-error (condition stream)
+  (let ((display (x-error-display condition))
+	(error-code (x-error-error-code condition))
+	(request-code (x-error-request-code condition))
+	(minor-code (x-error-minor-code condition))
+	(serial (x-error-serial condition))
+	(resourceid (x-error-resourceid condition))
+	(current-serial (x-error-current-serial condition)))
+    (format stream "~@<Xlib: ~;~a ~:_in ~:[request ~d (last request was ~d)~;current request~2*~], ~:_Code: ~d.~d~@[ [~a]~], ~:_ResourceID: ~d~:>"
+	    (get-error-text error-code display)
+	    (= serial current-serial)
+	    serial current-serial request-code minor-code
+	    (when (< 1 request-code 128)
+	      (let ((request-cstring (princ-to-string request-code))
+		    (s (make-string 1000)))
+		(x11:xgeterrordatabasetext display "XRequest" request-cstring
+					   0 s 1000)
+		(let ((n (position (cltl1::int-char 0) s)))
+		  (when n (setq s (subseq s 0 n))))
+		s))
+	    resourceid)))
+
+(defun-c-callable x-error-handler ((display :unsigned-long) (event :unsigned-long))
+  (let ((*error-output* excl:*initial-terminal-io*))
+    (error 'x-error
+	   :display display
+	   :error-code (x11:xerrorevent-error-code event)
+	   :request-code (x11:xerrorevent-request-code event)
+	   :minor-code (x11:xerrorevent-minor-code event)
+	   :resourceid (x11:xerrorevent-resourceid event)
+	   :serial (x11:xerrorevent-serial event)
+	   :current-serial (x11:display-request display))))
+
+(defun-c-callable x-io-error-handler ((display :unsigned-long))
+  (let ((*error-output* excl:*initial-terminal-io*))
+    (error "Xlib: Connection to X11 server '~a' lost"
+	   (ff:char*-to-string (x11:display-display-name display)))))
 
 
 (defun get-error-text (code display-handle)
@@ -199,6 +244,7 @@
 (eval-when (load)
   (setup-error-handlers))
 
+;;--
 
 (defmethod display-root-window (display)
   (intern-object-xid
@@ -521,3 +567,15 @@
 (defun destroy-image (image)
   (x11:xdestroyimage image))
 
+;;
+
+(defmacro with-server-grabbed ((display) &body body)
+  `(let ((.display. ,display))
+     (unwind-protect
+	 (let ((result nil))
+	  (x11:xgrabserver .display.)
+	  (x11:xflush .display.)
+	  (excl:errorset (setq result (multiple-value-list (progn ,@body))) t)
+	  (values-list (cdr result)))
+       (x11:xungrabserver .display.)
+       (x11:xflush .display.))))
diff --git a/tk/xm-classes.lisp b/tk/xm-classes.lisp
index 1ac9e8ef3a241e76ccc2fa7e75205e1cf550fbe5..0f6f0b9d044ce223d77d4e0218d065ab3861d207 100644
--- a/tk/xm-classes.lisp
+++ b/tk/xm-classes.lisp
@@ -20,12 +20,9 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-classes.lisp,v 1.5 92/05/13 17:10:29 cer Exp $
+;; $fiHeader: xm-classes.lisp,v 1.6 92/07/01 15:44:39 cer Exp $
 
 
-(provide :climxm)
-(require :climg)
-
 (in-package :tk)
 
 ;;; This has to kept consistent with the Makefile
diff --git a/tk/xm-funs.lisp b/tk/xm-funs.lisp
index 0378df27acf20a9a12ecbd93d6d67dc2326780c0..9010a551c459cc02a9c2feefbbdf9ecf2d28cc71 100644
--- a/tk/xm-funs.lisp
+++ b/tk/xm-funs.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-funs.lisp,v 1.4 92/04/28 09:25:09 cer Exp Locker: cer $
+;; $fiHeader: xm-funs.lisp,v 1.5 92/05/06 15:37:11 cer Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -30,48 +30,122 @@
 
 (defforeign 'xm_string_create_l_to_r
     :entry-point "_XmStringCreateLtoR"
-    :return-type :integer)
+    :call-direct t
+    :callback nil
+    :arguments '(foreign-address foreign-address)
+    :return-type :unsigned-integer)
 
 (defforeign 'xm_string_get_l_to_r
     :entry-point "_XmStringGetLtoR"
-    :return-type :integer)
+    :call-direct t
+    :callback nil
+    :arguments '(foreign-address foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :fixnum)
 
 (defforeign 'xm_get_pixmap
-    :entry-point "_XmGetPixmap")
+    :entry-point "_XmGetPixmap"
+    :call-direct t
+    :arguments '(foreign-address foreign-address integer integer)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 (defforeign 'xm_font_list_init_font_context
-    :entry-point "_XmFontListInitFontContext")
+    :entry-point "_XmFontListInitFontContext"
+    :call-direct t
+    :callback nil
+    :arguments '(foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :fixnum)
 
 (defforeign 'xm_font_list_free_font_context
-    :entry-point "_XmFontListFreeFontContext")
+    :entry-point "_XmFontListFreeFontContext"
+    :call-direct t
+    :callback nil
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :void)
 
 (defforeign 'xm_font_list_get_next_font
-    :entry-point "_XmFontListGetNextFont")
+    :entry-point "_XmFontListGetNextFont"
+    :call-direct t
+    :callback nil
+    :arguments '(foreign-address foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :fixnum)
 
 (defforeign 'xm_font_list_create
-    :entry-point "_XmFontListCreate")
+    :entry-point "_XmFontListCreate"
+    :call-direct t
+    :callback nil
+    :arguments '(foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 (defforeign 'xm_add_protocol_callback
-    :entry-point "_XmAddProtocolCallback")
+    :entry-point "_XmAddProtocolCallback"
+    :call-direct t
+    :arguments '(foreign-address integer integer foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :void)
 
 (defforeign 'xm_intern_atom 
-    :entry-point "_XmInternAtom")
-
-(defforeign 'xm_main_window_set_area :entry-point
-  "_XmMainWindowSetAreas")
+    :entry-point "_XmInternAtom"
+    :call-direct t
+    :callback nil
+    :arguments '(foreign-address foreign-address fixnum)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+
+(defforeign 'xm_main_window_set_area
+    :entry-point "_XmMainWindowSetAreas"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address
+		 foreign-address foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :void)
 
 (ff:defforeign 'xm_process_traversal
-    :entry-point "_XmProcessTraversal")
+    :entry-point "_XmProcessTraversal"
+    :call-direct t
+    :arguments '(foreign-address integer)
+    :arg-checking nil
+    :return-type :fixnum)
 
 (defforeign 'xm-message-box-get-child
-    :entry-point "_XmMessageBoxGetChild")
+    :entry-point "_XmMessageBoxGetChild"
+    :call-direct t
+    :arguments '(foreign-address fixnum)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 
 (defforeign 'xm_file_selection_do_search
-    :entry-point "_XmFileSelectionDoSearch")
+    :entry-point "_XmFileSelectionDoSearch"
+    :call-direct t
+    :arguments '(foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :void)
 
 (defforeign 'xm_option_label_gadget
-    :entry-point "_XmOptionLabelGadget")
+    :entry-point "_XmOptionLabelGadget"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 (defforeign 'xm_option_button_gadget
-    :entry-point "_XmOptionButtonGadget")
+    :entry-point "_XmOptionButtonGadget"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+
+(defforeign 'initializemydrawingareaquerygeometry
+    :entry-point "_InitializeMyDrawingAreaQueryGeometry"
+    :call-direct t
+    :callback nil
+    :arguments '(integer)
+    :arg-checking nil
+    :return-type :void)
+
diff --git a/tk/xm-widgets.lisp b/tk/xm-widgets.lisp
index 6f30796e21200954248605c1c7195f00aa63f25e..32293900e040978e527a87c09af4f177fb83a0f4 100644
--- a/tk/xm-widgets.lisp
+++ b/tk/xm-widgets.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-widgets.lisp,v 1.6 92/04/21 20:27:49 cer Exp $
+;; $fiHeader: xm-widgets.lisp,v 1.7 92/07/27 19:29:20 cer Exp $
 
 (in-package :tk)
 
@@ -62,3 +62,34 @@
 					   "keyboardFocusPolicy")))
 
 
+;; Moved here as to be after loading xm-funs.
+
+;;-- This is a problem cos we dont know the number of items
+
+(defconstant xm_string_default_char_set "")
+
+(defmethod convert-resource-in (class (type (eql 'xm-string)) value)
+  (and (not (zerop value))
+       (with-ref-par ((string 0))
+	 ;;--- I think we need to read the book about
+	 ;;--- xm_string_get_l_to_r and make sure it works with multiple
+	 ;;-- segment strings
+	 (xm_string_get_l_to_r value xm_string_default_char_set string)
+	 (char*-to-string (aref string 0)))))
+
+(defmethod convert-resource-in ((parent t) (type (eql 'xm-string-table)) value)
+  value)
+
+(defun convert-xm-string-table-in (parent table n)
+  (let ((r nil))
+    (dotimes (i n (nreverse r))
+      (push (convert-resource-in parent 'xm-string (x-arglist table i))
+	    r))))
+
+(defmethod convert-resource-out ((parent t) (type (eql 'xm-string)) value)
+  (xm_string_create_l_to_r (string-to-char* value) (string-to-char* "")))
+
+(defmethod convert-resource-out ((parent t) (type (eql 'xm-background-pixmap)) value)
+  (etypecase value
+    (pixmap
+     (encode-pixmap nil value))))
diff --git a/tk/xt-funs.lisp b/tk/xt-funs.lisp
index e290a4a52d49b1dfd6e2886d121f597c91f7f161..46e903035d127226af71688ac8a402fcd843f775 100644
--- a/tk/xt-funs.lisp
+++ b/tk/xt-funs.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-funs.lisp,v 1.7 92/07/01 15:44:40 cer Exp $
+;; $fiHeader: xt-funs.lisp,v 1.8 92/07/08 16:28:51 cer Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -28,100 +28,255 @@
 
 (in-package :xt)
 
-(defforeign 'xt_get_resource_list :entry-point "_XtGetResourceList")
-(defforeign 'xt_get_constraint_resource_list :entry-point "_XtGetConstraintResourceList")
+(defforeign 'xt_get_resource_list
+    :entry-point "_XtGetResourceList"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :void)
+    
+(defforeign 'xt_get_constraint_resource_list
+    :entry-point "_XtGetConstraintResourceList"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :void)
 
-(defforeign 'xt_initialize_widget_class :entry-point "_XtInitializeWidgetClass")
+(defforeign 'xt_initialize_widget_class
+    :entry-point "_XtInitializeWidgetClass"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :void)
 
 (defforeign 'xt_free
-    :arguments '(ff:foreign-address)
+    :entry-point "_XtFree"
     :call-direct t
     :callback nil
+    :arguments '(foreign-address)
     :arg-checking nil
-    :return-type :void
-    :entry-point "_XtFree")
+    :return-type :void)
 
 (defforeign 'xt_toolkit_initialize
-    :entry-point "_XtToolkitInitialize")
+    :entry-point "_XtToolkitInitialize"
+    :call-direct t
+    :arguments nil
+    :arg-checking nil
+    :return-type :void)
 
 (defforeign 'xt_create_application_context
-    :entry-point "_XtCreateApplicationContext")
-
+    :entry-point "_XtCreateApplicationContext"
+    :call-direct t
+    :arguments nil
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 (defforeign 'xt_app_set_error_handler
-    :entry-point "_XtAppSetErrorHandler")
+    :entry-point "_XtAppSetErrorHandler"
+    :call-direct t
+    :arguments '(foreign-address integer)
+    :arg-checking nil
+    :return-type :integer)
 
 (defforeign 'xt_app_set_warning_handler
-    :entry-point "_XtAppSetWarningHandler")
+    :entry-point "_XtAppSetWarningHandler"
+    :call-direct t
+    :arguments '(foreign-address integer)
+    :arg-checking nil
+    :return-type :integer)
 
 (defforeign 'xt_open_display
-    :entry-point "_XtOpenDisplay")
+    :entry-point "_XtOpenDisplay"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address foreign-address
+		 foreign-address fixnum foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 (defforeign 'xt_app_create_shell 
-    :entry-point "_XtAppCreateShell")
+    :entry-point "_XtAppCreateShell"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address foreign-address
+		 foreign-address fixnum)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 ;;;; 
 
-(defforeign 'xt_create_widget :entry-point "_XtCreateWidget")
+(defforeign 'xt_create_widget
+    :entry-point "_XtCreateWidget"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address
+		 foreign-address fixnum)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+    
+    
 (defforeign 'xt_create_managed_widget
-    :arguments '(simple-string ff:foreign-address ff:foreign-address
-		 ff:foreign-address fixnum)
-    :call-direct t
-    :callback t
-    :arg-checking nil
-    :return-type :unsigned-integer
-    :entry-point "_XtCreateManagedWidget")
-
-(defforeign 'xt_realize_widget :entry-point "_XtRealizeWidget")
-(defforeign 'xt_manage_child :entry-point "_XtManageChild")
-(defforeign 'xt_is_managed :entry-point "_XtIsManaged")
-(defforeign 'xt_unmanage_child :entry-point "_XtUnmanageChild")
-(defforeign 'xt_manage_children :entry-point "_XtManageChildren")
-(defforeign 'xt_destroy_widget :entry-point "_XtDestroyWidget")
-(defforeign 'xt_create_popup_shell :entry-point "_XtCreatePopupShell")
-(defforeign 'xt_popup :entry-point "_XtPopup")
-(defforeign 'xt_popdown :entry-point "_XtPopdown")
-(defforeign 'xt_window :entry-point "_XtWindow")
-(defforeign 'xt_parent :entry-point "_XtParent")
-(defforeign 'xt_query_geometry :entry-point "_XtQueryGeometry")
-(defforeign 'xt_configure_widget :entry-point "_XtConfigureWidget")
+    :entry-point "_XtCreateManagedWidget"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address
+		 foreign-address fixnum)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+
+(defforeign 'xt_realize_widget
+    :entry-point "_XtRealizeWidget"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :void)
+    
+(defforeign 'xt_destroy_widget
+    :entry-point "_XtDestroyWidget"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :void)
+
+(defforeign 'xt_manage_child
+    :entry-point "_XtManageChild"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :void)
+
+(defforeign 'xt_is_managed
+    :entry-point "_XtIsManaged"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :fixnum)
+    
+(defforeign 'xt_unmanage_child
+    :entry-point "_XtUnmanageChild"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :void)
+
+(defforeign 'xt_manage_children
+    :entry-point "_XtManageChildren"
+    :call-direct t
+    :arguments '(foreign-address fixnum)
+    :arg-checking nil
+    :return-type :void)
+
+(defforeign 'xt_create_popup_shell
+    :entry-point "_XtCreatePopupShell"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address foreign-address fixnum)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+    
+(defforeign 'xt_popup
+    :entry-point "_XtPopup"
+    :call-direct t
+    :arguments '(foreign-address integer)
+    :arg-checking nil
+    :return-type :void)
+
+(defforeign 'xt_popdown
+    :entry-point "_XtPopdown"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :void)
+    
+(defforeign 'xt_window
+    :entry-point "_XtWindow"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+    
+(defforeign 'xt_parent
+    :entry-point "_XtParent"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+	    
+(defforeign 'xt_query_geometry
+    :entry-point "_XtQueryGeometry"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+
+(defforeign 'xt_configure_widget
+    :entry-point "_XtConfigureWidget"
+    :call-direct t
+    :arguments '(foreign-address fixnum fixnum fixnum fixnum fixnum)
+    :arg-checking nil
+    :return-type :void)
 
 (defforeign 'xt_set_values
-    :arguments '(ff:foreign-address ff:foreign-address fixnum)
+    :arguments '(foreign-address foreign-address fixnum)
     :call-direct t
-    :callback t
     :arg-checking nil
     :return-type :void
     :entry-point "_XtSetValues")
 (defforeign 'xt_get_values
-    :arguments '(ff:foreign-address ff:foreign-address fixnum)
+    :arguments '(foreign-address foreign-address fixnum)
     :call-direct t
-    :callback t
     :arg-checking nil
     :return-type :void
     :entry-point "_XtGetValues")
 
-
 (defforeign 'xt_app_pending
-    :arguments '(ff:foreign-address)
+    :arguments '(foreign-address)
     :call-direct t
-    ;; Maybe callback can be safely set to nil...
-    :callback t
     :arg-checking nil
     :return-type :fixnum
     :entry-point "_XtAppPending")
 (defforeign 'xt_app_process_event
-    :arguments '(ff:foreign-address fixnum)
+    :arguments '(foreign-address fixnum)
     :call-direct t
-    :callback t
     :arg-checking nil
     :return-type :void
     :entry-point "_XtAppProcessEvent")
-(defforeign 'xt_add_event_handler :entry-point "_XtAddEventHandler")
-(defforeign 'xt_build_event_mask :entry-point "_XtBuildEventMask")
 
-(defforeign 'xt_add_callback :entry-point "_XtAddCallback")
-(defforeign 'xt_has_callbacks :entry-point "_XtHasCallbacks")
-(defforeign 'xt_remove_all_callbacks :entry-point "_XtRemoveAllCallbacks")
+(defforeign 'xt_add_event_handler
+    :entry-point "_XtAddEventHandler"
+    :call-direct t
+    :arguments '(foreign-address integer fixnum foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :void)
+    
+(defforeign 'xt_build_event_mask
+    :entry-point "_XtBuildEventMask"
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+
+(defforeign 'xt_add_callback
+    :entry-point "_XtAddCallback"
+    :call-direct t
+    :arguments '(foreign-address foreign-address foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :void)
+    
+(defforeign 'xt_has_callbacks
+    :entry-point "_XtHasCallbacks"
+    :call-direct t
+    :arguments '(foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+    
+(defforeign 'xt_remove_all_callbacks
+    :entry-point "_XtRemoveAllCallbacks"
+    :call-direct t
+    :arguments '(foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :void)
+    
+(defforeign 'xt_set_sensitive
+    :entry-point "_XtSetSensitive"
+    :call-direct t
+    :arguments '(foreign-address fixnum)
+    :arg-checking nil
+    :return-type :void)
+    
 
-(defforeign 'xtsetsensitive :entry-point "_XtSetSensitive")
diff --git a/xlib/load-xlib.lisp b/xlib/load-xlib.lisp
index c563f06ae1a220890b217945d8901c8b6f2f5f48..8d4c2fb457eda0ad249f4e4aaac499e83aa77ca6 100644
--- a/xlib/load-xlib.lisp
+++ b/xlib/load-xlib.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: load-xlib.lisp,v 1.6 92/06/16 15:01:26 cer Exp $
+;; $fiHeader: load-xlib.lisp,v 1.7 92/07/27 19:29:30 cer Exp $
 
 (in-package :x11)
 
@@ -33,7 +33,7 @@
 	  (push l r))))))
 
 
-(defun load-undefined-symbols-from-library (file what kludges libraries)
+(defun load-undefined-symbols-from-library (file what libraries)
   (let* ((n (length what))
 	 (names (coerce what 'vector))
 	 (entry-points (make-array n :element-type '(unsigned-byte 32))))
@@ -44,12 +44,11 @@
 	    (when (= (aref entry-points i)
 			sys::*impossible-load-address*)
 	      (format t ";; ~A is undefined~%" (aref names i))))
-      (mapc #'foreign-functions:remove-entry-point kludges)
       (load file
 	    :system-libraries libraries
 	    :print t))))
 
-(defvar sys::*libx11-pathname* "/x11/R4/sun4-lib/libX_d.a")
+(defvar sys::*libx11-pathname* "/x11/R4/sun4-lib/libX11.a")
 
 (unless (ff:get-entry-point (ff:convert-to-lang "lisp_XDrawString"))
   (load "xlibsupport.o" :system-libraries (list sys::*libx11-pathname*) :print t))
@@ -57,11 +56,5 @@
 (x11::load-undefined-symbols-from-library
  "stub-x.o"
  (x11::symbols-from-file "misc/undefinedsymbols")
- ;; This was only needed when bogus removesyms was done.
- #+ignore '("__unpack_quadruple" 
-	    "__prod_b10000" 
-	    "__carry_out_b10000" 
-	    "__prod_65536_b10000")
- #-ignore nil
  (list sys::*libx11-pathname*))