From 265f17a2296be4edd081b0392383e76da8165820 Mon Sep 17 00:00:00 2001
From: colin <colin>
Date: Tue, 17 Oct 1995 05:04:21 +0000
Subject: [PATCH] see ChangeLog.n for Mon Oct 16 21:58:05 PDT 1995

---
 .cvsignore                        |   2 +-
 ChangeLog.n                       | 164 ++++++++
 Makefile.cobjs                    |   4 +-
 Makefile.generic                  |   8 +-
 Makefile.sun4-svr4                |  14 +-
 clim/accept-values.lisp           |   9 +-
 clim/command.lisp                 |  61 +--
 clim/db-stream.lisp               |  96 ++---
 clim/frames.lisp                  |  13 +-
 clim/gadget-output.lisp           |   5 +-
 clim/input-protocol.lisp          |   9 +-
 clim/interactive-defs.lisp        |   6 +-
 clim/menus.lisp                   |  74 ++--
 clim/tracking-pointer.lisp        | 272 ++++++------
 clim/translators.lisp             |  32 +-
 demo/color-editor.lisp            | 127 +++---
 postscript/postscript-medium.lisp |  49 ++-
 postscript/postscript-port.lisp   | 124 +++---
 silica/db-border.lisp             |  24 +-
 silica/db-layout.lisp             | 110 +++--
 silica/db-scroll.lisp             |  69 ++--
 silica/event.lisp                 |  50 +--
 silica/gadgets.lisp               | 176 ++++----
 silica/port.lisp                  |  18 +-
 silica/sheet.lisp                 |  34 +-
 test/test-suite.lisp              |   4 +-
 tk-silica/last.lisp               |   8 +-
 tk-silica/xm-frames.lisp          |  53 ++-
 tk-silica/xm-gadgets.lisp         | 362 +++++++++++-----
 tk-silica/xm-silica.lisp          |  22 +-
 tk-silica/xt-gadgets.lisp         |  59 ++-
 tk-silica/xt-graphics.lisp        |  67 ++-
 tk-silica/xt-silica.lisp          | 116 ++++--
 tk/callbacks.lisp                 |  81 ++--
 tk/ol-init.lisp                   |   4 +-
 tk/resources.lisp                 |  54 +--
 tk/xlib.lisp                      |   8 +-
 tk/xm-defs.lisp                   |  20 +-
 tk/xm-funs.lisp                   |  21 +-
 tk/xm-init.lisp                   |   4 +-
 tk/xt-defs.lisp                   |  10 +-
 tk/xt-funs.lisp                   |  52 ++-
 utils/base-designs.lisp           |  18 +-
 utils/designs.lisp                |  31 +-
 utils/packages.lisp               |   6 +-
 xlib/xlib-funs.lisp               | 663 +++++++++++++++---------------
 46 files changed, 1925 insertions(+), 1288 deletions(-)

diff --git a/.cvsignore b/.cvsignore
index 6d2d1b38..a2bc171b 100755
--- a/.cvsignore
+++ b/.cvsignore
@@ -12,4 +12,4 @@ test-suite-reportol.lisp
 test-suite-reportxm.lisp
 hpgl.output
 foo.diffs
-update.out
+update.log
diff --git a/ChangeLog.n b/ChangeLog.n
index d93578b4..7844eca3 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -1,3 +1,167 @@
+*************************************************************
+Mon Oct 16 21:58:05 PDT 1995	Colin Meldrum (colin@vapor)
+
+Makefile.cobjs		fix library path for ol version
+
+Makefile.generic	added rule clean-notes
+			fixed library path for make train rule
+
+Makefile.sun4-svr4	defs for multiple versions of Motif libraries
+
+clim/accept-values.lisp	fixed bug positioning own-window t dialogs
+			improved appearance of dialogs produced with
+			display-invalid-queries
+			fix typo in display-invalid-queries 
+
+clim/command.lisp	added support for user defined accelerator-text in
+			add-menu-item-to-command-table 
+
+clim/db-stream.lisp	added support for scroller-pane options to
+			make-clim-stream-pane
+
+clim/frames.lisp	reinstated 0.9 fudge factor in limit-size-to-graft
+			to workaround bug in openwindows window managers
+			fixed find-application-frame to create new frame when 
+			no existing frame found
+			changed enable-frame to use position-sheet-carefully
+			rather than move-sheet - allows correct positioning 
+			of non avv popup-frames.
+
+clim/gadget-output.lisp	fixed option-pane to activate/de-activate correctly
+
+clim/input-protocol.lisp
+			changed repaint-sheet to not require a viewport so
+			that cursor redraw works correctly in panes without
+			scroll-bars 
+
+clim/interactive-defs.lisp
+			fixed bug in read-token's handling of activation
+			and delimiter gestures
+
+clim/menus.lisp		fixed bug in open-window-stream by moving :left and 
+			:top args into call to make-application-frame
+
+clim/tracking-pointer.lisp
+			fixed bug with tracking-pointer over multiple panes 
+			when mouse button grabbed
+
+clim/translators.lisp	removed restriction on priorities to be >0 in
+			define-presentation-trasnlator-1
+
+climtoys/calendar.lisp	removed com-print3
+
+demo/color-editor.lisp	include tick-marks on sliders
+
+postscript/postscript-medium.lisp
+			added dummy maybe-set-color method to hack
+			compose-in inks for postscript port
+			fixed prolog to do calculate the correct
+			bounding-rectangle for encapsulted postscript
+
+silica/db-border.lisp	changed region painted in repaint-boder-pane to
+			workaround bug with repaint drawing over cursor
+
+silica/db-layout.lisp	tentative compose-space :around method for 			
+			client-overridability-mixin
+
+silica/db-scroll.lisp	added support for :vertical-page-scroll-amount and
+			:horizontal-page-scroll-amount
+
+silica/gadgets.lisp	added :decimal-places 0 initarg for slider
+			added echo-character initarg to text-fields for
+			password entry support
+			support in compute-list-pane-selected-items for
+			auto scrolling of list-pane to show selected item
+			support for armed/disarmed events
+
+silica/port.lisp, tk/xm-init.lisp tk/ol-init.lisp
+			new *restart-actions* syntax
+
+silica/sheet.lisp	new gf port-remove-all-pointer-grabs (to fix
+			tracking pointer multiple window bug)
+	
+
+test/test-suite.lisp	fixed title of region-intersects-region-p test
+
+tk/callbacks.lisp	support for text-field echo-character
+
+tk/resources.lisp	support for auto-scrolling list-pane
+			added top-item-position resource
+
+tk/xlib.lisp		fix bug with non-standard bits-per-pixel image
+			format in image initialize-instance :after method
+
+tk/xm-defs.lisp		support for text-field echo-character
+
+tk/xm-funs.lisp		support for setting scale value
+			support for changing widget background color and
+			associated shadows
+
+tk/xt-defs.lisp		misc typdef fixes
+
+tk/xt-funs.lisp		added xt_ungrab_button
+			fixed init_clim_gc_cursor_stuff to be :call-direct t
+
+tk-silica/last.lisp	changed patch load pathname to be ";update-clim;"
+
+tk-silica/xm-frames.lisp
+			replaced frobulate-menubars with more general
+			frobulate-mirrors to fix bug with gadgets coming up
+			wrong size
+			support for user-defined accelerator-text
+			fixed bug with shifted accelerators
+
+tk-silica/xm-gadgets.lisp
+			added armed/disarmed callbacks
+			support for quantized slider values
+			support for slider tick marks
+			support for min/max label
+			variable page-increment for scroll-bars
+			support for text-field echo-character 
+			support for auto-scrolling list-pane
+			added motif specific port-set-pane-background to
+			deal with shadow colors
+			handle :default keyword arg frame-manager-select-file
+
+tk-silica/xm-silica.lisp
+			added note-sheet-degrafter method on
+			clim-stream-sheets to destroy any cursor widget
+
+tk-silica/xt-gadgets.lisp
+			redone find-widget-resouce-initargs-for-sheet
+			support for variable page-increment for scroll-bars	
+			simplified get-accelerator-text
+
+tk-silica/xt-graphics.lisp
+			added palette slot to xt-medium
+			medium-palette only goes to the sheet the first time
+			new decode-ink-1 method on composite-in inks
+			decode-ink-opacity now takes an optional color arg
+			fixes bug in decode-layered-color-set for layers
+			which are not exact powers of 2
+
+tk-silica/xt-silica.lisp
+			support to inhibit use of scalable fonts.
+			new queue-armed-event and queue-disarmed-event
+			explicitly switch off program-specified position
+			hints in enable-mirror on top-level-sheet to make
+			OpenWindows cascading work properly
+			added new method port-remove-all-pointer-grabs 
+
+utils/base-designs.lisp	coerce designs in make-pattern to be a
+			simple-vector 
+
+utils/designs.lisp	*use-closest-color* can now be :warn
+			check for recursive errors when no closest color
+			available 
+
+utils/packages.lisp	armed-gadget-event
+			disarmed-gadget-event
+			port-remove-all-pointer-grabs
+			text-field-echo-character
+
+xlib/xlib-funs.lisp	added defforeign for _XGetBitsPerPixel
+
 *************************************************************
 4.3.devel.4 (aka 4.3.alpha.0)
 
diff --git a/Makefile.cobjs b/Makefile.cobjs
index 18a97716..9125ac8b 100644
--- a/Makefile.cobjs
+++ b/Makefile.cobjs
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.cobjs,v 1.8 1994/12/04 23:56:22 colin Exp $
+# $fiHeader: Makefile.cobjs,v 1.9 1995/05/17 19:46:58 colin Exp $
 #
 #  Makefile.cobj for CLIM 2.0
 #
@@ -55,7 +55,7 @@ climxm.so: xlibsupport.o xtsupport.o xmsupport.o
 		$(IMPORTS) $(TKLIB) $(XTLIB) $(XLIB) $(MOTIFXTRAS))
 
 climol.so: xlibsupport.o xtsupport.o olsupport.o
-	(eval '$(SET_LIBRARY_PATH)' ;
+	(eval '$(SET_LIBRARY_PATH)' ; \
 	$(MAKE_SHARED) $(SHAREFLAGS) -o climol.so \
 		xlibsupport.o xtsupport.o olsupport.o \
 		$(IMPORTS) $(TKLIB) $(XTLIB) $(XLIB))
diff --git a/Makefile.generic b/Makefile.generic
index aa0b6c08..7f31f4f6 100644
--- a/Makefile.generic
+++ b/Makefile.generic
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.generic,v 1.28 1994/12/18 06:44:37 duane Exp $
+# $fiHeader: Makefile.generic,v 1.30 1995/06/21 21:24:08 georgej Exp $
 #
 #  Makefile.generic for CLIM 2.0
 #
@@ -125,6 +125,7 @@ clim: FORCE $(PRODUCT-GENERIC-OBJS) $(PRODUCT-TK-OBJS)
 # Training
 
 train: FORCE
+	(eval '$(SET_LIBRARY_PATH)' ; \
 	$(ECHO) " \
 	(progn \
 	  (load \"misc/train.lisp\") \
@@ -132,7 +133,7 @@ train: FORCE
 		:benchmarkp $(TRAIN_BM) :profilep $(TRAIN_PROFILEP) \
 		:compile $(TRAIN_COMPILE) :psview $(PSVIEW) \
 		:hpglview $(HPGLVIEW)))" \
-	| $(CLIM) $(CLOPTS)
+	| $(CLIM) $(CLOPTS))
 	echo $(SYSTEM) trained!!!!	
 
 # the following two rules are used by make-dist so that we don't have 
@@ -189,6 +190,9 @@ clean:
 	  	stub-motif.c stub-olit.c stub-xt.c stub-x.c 
 	rm -f *.z *.Z *.gz *.ilt *.out
 
+clean-notes:
+	cd notes ; find . -name '*.lisp' -print | xargs rm -f
+
 tags:
 	$(TAGS) $(ALL_SRC)
 
diff --git a/Makefile.sun4-svr4 b/Makefile.sun4-svr4
index c287b28b..66e92acf 100644
--- a/Makefile.sun4-svr4
+++ b/Makefile.sun4-svr4
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile.sun4-svr4,v 1.6 1995/05/15 07:17:43 duane Exp $
+# $fiHeader: Makefile.sun4-svr4,v 1.7 1995/05/17 19:47:15 colin Exp $
 #
 #  Makefile.sun4-svr4 for CLIM 2.0
 #
@@ -7,14 +7,20 @@ include Makefile.defs
 
 Makefile=Makefile.sun4-svr4
 
-XINCLUDES=-I/usr/openwin/include -I/usr/dt/include
+XINCLUDES= \
+	-I/usr/openwin/include -I/usr/dt/include
+#	-I/net/sole/opt/ICS/Motif1.2.4/usr/include
+#	-I/net/vapor/3rd/motif-1.2.2-sol2/ICS/Motif/usr/include
 
 TKLIB=-lXm
 XTLIB=-lXt
 XLIB=-lX11
 
-SET_LIBRARY_PATH= \
-  LD_LIBRARY_PATH=/usr/dt/lib:/usr/openwin/lib:/usr/lib; export LD_LIBRARY_PATH
+SET_LIBRARY_PATH= LD_LIBRARY_PATH= \
+	/usr/dt/lib:/usr/openwin/lib:/usr/lib; \
+#	/net/sole/opt/ICS/Motif1.2.4/usr/lib:/usr/lib; \
+#	/net/vapor/3rd/motif-1.2.2-sol2/ICS/Motif/usr/lib:/usr/lib; \
+   export LD_LIBRARY_PATH
 
 PRODUCT-TK-OBJS= $(STATIC-XM-OBJS) $(SHARED-XM-OBJS)
 
diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index 0ee58be3..64ad585a 100644
--- a/clim/accept-values.lisp
+++ b/clim/accept-values.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: accept-values.lisp,v 1.75 1994/12/04 23:57:18 colin Exp $
+;; $fiHeader: accept-values.lisp,v 1.76 1995/05/17 19:47:38 colin Exp $
 
 (in-package :clim-internals)
 
@@ -377,6 +377,7 @@
 			:own-window-properties (list x-position y-position
 						     width height
 						     right-margin bottom-margin)
+			:left x-position :right y-position
 			:initially-select-query-identifier
 			  (and initially-select-query-identifier
 			       (cons initially-select-query-identifier modify-initial-query))
@@ -1004,7 +1005,7 @@
 (defmethod display-invalid-queries ((frame standard-application-frame) stream query-info)
   (declare (ignore stream))
   (notify-user frame
-	       (format nil "The following fields are not valid:~{ ~{~A~:[~;~:* : ~A~]~}~}"
+	       (format nil "The following fields are not valid:~:{~%~4T~A~@[: ~A~]~}"
 		       (mapcar #'(lambda (query-stuff)
 				   (destructuring-bind (query id condition) query-stuff
 				     (declare (ignore query))
@@ -1018,8 +1019,8 @@
 				      (and (not (eq condition t)) condition))))
 			       query-info))
 	       :title "Invalid Fields"
-	       :style :error :
-	       exit-boxes '(:exit)))
+	       :style :error
+	       :exit-boxes '(:exit)))
 
 (defmethod display-invalid-queries ((frame accept-values-own-window) stream queries)
   (display-invalid-queries (frame-calling-frame frame) stream queries))
diff --git a/clim/command.lisp b/clim/command.lisp
index 9e1d5d6f..22841ba0 100644
--- a/clim/command.lisp
+++ b/clim/command.lisp
@@ -1,6 +1,6 @@
 s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: command.lisp,v 1.27 1994/12/04 23:57:24 colin Exp $
+;; $fiHeader: command.lisp,v 1.28 1995/05/17 19:47:42 colin Exp $
 
 (in-package :clim-internals)
 
@@ -49,7 +49,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 ;; in the form (MENU-NAME KEYSTROKE COMMAND-MENU-ITEM), where the menu item is of the
 ;; form (TYPE VALUE . OPTIONS).  MENU-TICK is incremented when MENU changes.
 ;; TRANSLATORS is the set of presentation translators for this command table.
-(defclass standard-command-table 
+(defclass standard-command-table
 	  (command-table)
     ((name :reader command-table-name
 	   :initarg :name)
@@ -73,7 +73,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
   (print-unreadable-object (command-table stream :type t :identity t)
     (write (command-table-name command-table) :stream stream :escape nil)))
 
-(defmethod (setf command-table-inherit-from) 
+(defmethod (setf command-table-inherit-from)
 	   (new-inherit-from (command-table standard-command-table))
   (with-slots (inherit-from completion-alist translators-cache) command-table
     (unless (eq new-inherit-from inherit-from)
@@ -106,7 +106,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 		nil))))
 	(t
 	 (error "~S is not a symbol or command table"))))
-	
+
 
 (defun make-command-table (name &key inherit-from menu inherit-menu (errorp t))
   (check-type name symbol)
@@ -140,12 +140,12 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 	  (dovector (element menu)
 	    (destructuring-bind (string keystroke (type value &rest options)) element
 	      (when (case inherit-menu
-		      (:menu (setq keystroke nil) 
+		      (:menu (setq keystroke nil)
 			     t)
-		      (:keystrokes (setq string nil) 
+		      (:keystrokes (setq string nil)
 				   keystroke)
 		      (otherwise t))
-		(apply #'add-menu-item-to-command-table 
+		(apply #'add-menu-item-to-command-table
 		       command-table string type value
 		       :keystroke keystroke :errorp nil
 		       options))))))))
@@ -167,8 +167,8 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
   #+Genera (declare (zwei:indentation 1 1))
   (setf (compile-time-property name 'command-table-name) t)
   `(define-group ,name define-command-table
-     (define-command-table-1 ',name 
-	 :inherit-from ',inherit-from 
+     (define-command-table-1 ',name
+	 :inherit-from ',inherit-from
 	 ,@(and menu-p `(:menu ',menu))
 	 :inherit-menu ,inherit-menu)))
 
@@ -198,7 +198,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 	   (setf (slot-value old-command-table 'keystrokes) nil)
 	   old-command-table)
 	  (t
-	   (make-command-table name :inherit-from inherit-from 
+	   (make-command-table name :inherit-from inherit-from
 				    :menu menu :inherit-menu inherit-menu)))))
 
 ;; CLIM's general "user" command table
@@ -308,7 +308,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
   (dolist (comtab (command-table-inherit-from command-table))
     (do-command-table-inheritance-1 function (find-command-table comtab))))
 
-(defmethod command-present-in-command-table-p 
+(defmethod command-present-in-command-table-p
 	   (command-name (command-table standard-command-table))
   (gethash command-name (slot-value command-table 'commands)))
 
@@ -418,8 +418,8 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
   (and s1 s2 (string-equal s1 s2)))
 
 (defun add-menu-item-to-command-table (command-table string type value
-				       &key documentation (after ':end) 
-					    keystroke mnemonic
+				       &key documentation (after ':end)
+					    keystroke mnemonic accelerator-text
 					    text-style button-type (errorp t))
   (check-type string (or string null))
   (check-type type (member :command :function :menu :divider))
@@ -449,16 +449,17 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
       (when (and n-required
 		 (not (zerop n-required))
 		 (< n-supplied n-required))
-	(setq value (append value 
+	(setq value (append value
 			    (make-list (- n-required n-supplied)
 				       :initial-element *unsupplied-argument-marker*))))))
   (with-slots (menu menu-tick commands keystrokes) command-table
     (incf menu-tick)
     (setq keystrokes nil)
-    (let* ((item `(,type ,value 
+    (let* ((item `(,type ,value
 		   ,@(and documentation `(:documentation ,documentation))
 		   ,@(and text-style `(:text-style ,text-style))
 		   ,@(and mnemonic `(:mnemonic ,mnemonic))
+		   ,@(and accelerator-text `(:accelerator-text ,accelerator-text))
 		   ,@(and button-type `(:button-type ,button-type))))
 	   ;; Entries are of the form (MENU-NAME KEYSTROKE MENU-ITEM)
 	   (entry (list string keystroke item)))
@@ -584,7 +585,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 (defun display-command-table-menu (command-table stream
 				   &key max-width max-height
 					n-rows n-columns
-					x-spacing y-spacing 
+					x-spacing y-spacing
 					(cell-align-x ':left) (cell-align-y ':top)
 					(initial-spacing t) (row-wise nil) move-cursor)
   (unless (or max-width max-height)
@@ -605,7 +606,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 	    (cond ((eq (command-menu-item-type (third element)) :divider)
 		   (typecase (first element)
 		     (string
-		       (let ((text-style 
+		       (let ((text-style
 			       (getf (command-menu-item-options (third element)) :text-style)))
 			 (with-text-style (stream text-style)
 			   (formatting-cell (stream :align-x cell-align-x
@@ -619,7 +620,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 			 (formatting-cell (stream :align-x cell-align-x
 						  :align-y :center)
 			   (with-local-coordinates (stream)
-			     (draw-line* stream 0 0 width 0 
+			     (draw-line* stream 0 0 width 0
 					 :line-thickness thickness :ink ink)))))))
 		  ((first element)
 		   (formatting-cell (stream :align-x cell-align-x :align-y cell-align-y)
@@ -683,7 +684,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
       (cond ((eq (command-menu-item-type (third item)) :divider)
 	     (typecase (first item)
 	       (string
-		 (let ((text-style 
+		 (let ((text-style
 			 (getf (command-menu-item-options (third item)) :text-style)))
 		   (with-text-style (stream text-style)
 		     (formatting-cell (stream)
@@ -696,7 +697,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 		   (formatting-cell (stream :align-x :left
 					    :align-y :center)
 		     (with-local-coordinates (stream)
-		       (draw-line* stream 0 0 width 0 
+		       (draw-line* stream 0 0 width 0
 				   :line-thickness thickness :ink ink)))))))
 	    ((first item)
 	     (formatting-cell (stream)
@@ -707,7 +708,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 		   (present item 'command-menu-element :stream stream)))))))
   nil)
 
-(defun extract-command-menu-item-value (menu-item gesture 
+(defun extract-command-menu-item-value (menu-item gesture
 					&optional (numeric-argument *numeric-argument*))
   (let ((type (command-menu-item-type menu-item))
 	(value (command-menu-item-value menu-item)))
@@ -767,7 +768,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 		 (apply function entry)))
        (slot-value (find-command-table command-table) 'menu)))
 
-(defun find-keystroke-item (keystroke command-table 
+(defun find-keystroke-item (keystroke command-table
 			    &key (test #'keyboard-event-matches-gesture-name-p) (errorp t))
   (declare (values menu-item command-table))
   (let* ((command-table (find-command-table command-table))
@@ -786,7 +787,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 	   :format-string "Keystroke ~S has no menu item present in ~S"
 	   :format-args (list keystroke command-table))))
 
-(defun lookup-keystroke-item (keystroke command-table 
+(defun lookup-keystroke-item (keystroke command-table
 			      &key (test #'keyboard-event-matches-gesture-name-p))
   (declare (values menu-item command-table))
   (labels ((map-menu (command-table)
@@ -816,7 +817,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
   (let ((item (lookup-keystroke-item keystroke command-table :test test)))
     (when item
       (let* ((type (command-menu-item-type item))
-	     (command 
+	     (command
 	       (and (or (eq type ':command)
 			(eq type ':function))
 		    (extract-command-menu-item-value item t numeric-argument))))
@@ -1031,7 +1032,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 	      (push `(and ,(cadr l) '(,keyword)) conditional-keywords))
 	    (:documentation
 	      (push `(,keyword ,(second l)) keyword-documentation))))
-	(when default 
+	(when default
 	  (push default keyword-defaults))
 	(unless when
 	  (push keyword constant-keywords))
@@ -1040,7 +1041,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
     `(flet ((read-keyword-value (keyword)
 	      (ecase keyword
 		,@clauses)))
-       (process-keyword-args 
+       (process-keyword-args
 	 parsing-stream ,(if conditional-keywords
 			     `(append ,@conditional-keywords ',constant-keywords)
 			     `',constant-keywords)
@@ -1198,7 +1199,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 					      command-line-name)))
 	       (n-required (or (position '&key arguments) (length arguments))))
 	  (setf (compile-time-property command-name 'command-name) t)
-	  `(define-group ,command-name define-command 
+	  `(define-group ,command-name define-command
 	     ,parser-function
 	     (defun ,command-name ,(deduce-body-arglist arguments)
 	       ,@body)
@@ -1213,7 +1214,7 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 
 
 (defun ensure-command-in-command-table (command-name command-table &key name menu keystroke)
-  
+
   (when menu
     (let ((menu-options (and (consp menu) (cdr menu)))
 	  (menu-name (if (consp menu) (car menu) menu)))
@@ -1235,10 +1236,10 @@ s;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10
 		  (t
 		   (setf (getf menu-options :after) (first (aref menu-vector (1- position)))
 			 menu (cons menu-name menu-options)))))))))
-    
+
   (remove-command-from-command-table command-name command-table
 				     :errorp nil)
-    
+
   (add-command-to-command-table command-name command-table
 				:name name
 				:menu menu
diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp
index a68acc05..103bd142 100644
--- a/clim/db-stream.lisp
+++ b/clim/db-stream.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-stream.lisp,v 1.60 1994/12/04 23:57:29 colin Exp $
+;; $fiHeader: db-stream.lisp,v 1.61 1995/05/17 19:47:47 colin Exp $
 
 (in-package :clim-internals)
 
@@ -13,7 +13,7 @@
 
 ;;--- How to keep PANE-BACKGROUND/FOREGROUND in sync with the medium?
 ;;--- I'm not convinced that including WINDOW-STREAM here is right...
-(defclass clim-stream-sheet 
+(defclass clim-stream-sheet
 	  (window-stream			;includes output recording
 	   sheet-permanently-enabled-mixin
 	   sheet-mute-input-mixin
@@ -23,18 +23,18 @@
 	   permanent-medium-sheet-output-mixin
 	   basic-pane)
     ((input-editor-stream :initform nil :accessor stream-input-editor-stream))
-  (:default-initargs 
-    :medium t 
+  (:default-initargs
+    :medium t
     :transformation +identity-transformation+))
 
 (defmethod stream-input-editor-stream ((stream sheet)) nil)
 (defmethod (setf stream-input-editor-stream) (value (stream sheet))
   value)
 
-(defmethod stream-input-editor-stream ((stream standard-encapsulating-stream)) 
+(defmethod stream-input-editor-stream ((stream standard-encapsulating-stream))
   (stream-input-editor-stream (encapsulating-stream-stream stream)))
 
-(defmethod (setf stream-input-editor-stream) (value (stream standard-encapsulating-stream)) 
+(defmethod (setf stream-input-editor-stream) (value (stream standard-encapsulating-stream))
   (setf (stream-input-editor-stream (encapsulating-stream-stream stream)) value))
 
 (defun maybe-redraw-input-editor-stream (stream region)
@@ -119,12 +119,12 @@
 (defclass clim-stream-pane (clim-stream-sheet)
     ((incremental-redisplay-p
        :initarg :incremental-redisplay :initform nil)
-     (display-function 
+     (display-function
        :reader pane-display-function
        :initarg :display-function :initform nil)
      (display-time
        :reader pane-display-time
-       :initarg :display-time :initform :command-loop		
+       :initarg :display-time :initform :command-loop
        :type (member nil :command-loop :no-clear t))))
 
 
@@ -137,19 +137,19 @@
   (with-slots (display-time) pane
     (ecase display-time
       ((t)
-       (setq display-time nil) 
+       (setq display-time nil)
        (values t t))
       ((nil)
        (values nil nil))
       (:command-loop
        (values t t))
-      (:no-clear 
+      (:no-clear
        (values t nil)))))
 
-(defmethod pane-needs-redisplay ((pane basic-pane)) 
+(defmethod pane-needs-redisplay ((pane basic-pane))
   (values nil nil))
 
-(defmethod (setf pane-needs-redisplay) (value (pane basic-pane)) 
+(defmethod (setf pane-needs-redisplay) (value (pane basic-pane))
   value)
 
 ;;--- Although the unit options are mostly applicable here I guess
@@ -162,7 +162,7 @@
   (unless vars
     (setq vars '(sr-width sr-min-width sr-max-width sr-height sr-min-height sr-max-height)))
   `(multiple-value-bind ,vars
-       (space-requirement-components ,sr) 
+       (space-requirement-components ,sr)
      (macrolet ((do-with-space-req-components (operator var vars &body body)
 		  `(,operator
 		    ,@(mapcar #'(lambda (a-var)
@@ -180,13 +180,13 @@
   (compute-space-for-clim-stream-pane pane (call-next-method) width height))
 
 (defun compute-space-for-clim-stream-pane (pane sr width height)
-  (labels 
+  (labels
       ((process-compute-space-requirements ()
 	 (with-space-requirement (sr)
 	   (when (do-with-space-req-components or
-		   sr-component 
+		   sr-component
 		   (sr-width sr-min-width sr-max-width
-			     sr-height sr-min-height sr-max-height) 
+			     sr-height sr-min-height sr-max-height)
 		   (eq sr-component :compute))
 	     (multiple-value-bind (width height)
 		 (let ((record
@@ -196,9 +196,9 @@
 			      history
 			    (let ((*sizing-application-frame* t))
 			      (with-output-to-output-record (pane)
-				(funcall 
+				(funcall
 				 (if (slot-value pane 'incremental-redisplay-p)
-				     #'invoke-pane-redisplay-function 
+				     #'invoke-pane-redisplay-function
 				   #'invoke-pane-display-function)
 				 (pane-frame pane) pane
 				 ;;--- Are all pane display functions prepared to
@@ -213,19 +213,19 @@
 
 	       (flet ((process-computes (size preferred min max)
 			(values
-			 (if (eq preferred :compute) 
+			 (if (eq preferred :compute)
 			     (let ((size size))
 			       (when (numberp min) (maxf size min))
 			       (when (numberp max) (minf size max))
 			       size)
-			   preferred) 
+			   preferred)
 			 (if (eq min :compute) size min)
 			 (if (eq max :compute) size max))))
 		 (multiple-value-setq (sr-width sr-min-width sr-max-width)
 		   (process-computes width sr-width sr-min-width sr-max-width))
 		 (multiple-value-setq (sr-height sr-min-height sr-max-height)
 		   (process-computes height sr-height sr-min-height sr-max-height)))
-	       
+
 	       #+ignore
 	       (do-with-space-req-components progn
 		 sr-component (sr-width sr-min-width sr-max-width)
@@ -241,9 +241,9 @@
 	    (with-space-requirement (sr)
 	      (let ((changed nil))
 		(do-with-space-req-components progn
-		  sr-component 
+		  sr-component
 		  (sr-width sr-min-width sr-max-width
-			    sr-height sr-min-height sr-max-height) 
+			    sr-height sr-min-height sr-max-height)
 		  (when (unit-space-requirement-p sr-component)
 		    (setq sr-component (process-unit-space-requirement pane sr-component)
 			  changed t)))
@@ -254,9 +254,9 @@
 	    (unless (and (numberp sr-width)
 			 (numberp sr-height)
 			 (do-with-space-req-components and
-			   sr-component 
+			   sr-component
 			   (sr-min-width sr-max-width
-					 sr-min-height sr-max-height) 
+					 sr-min-height sr-max-height)
 			   (or (numberp sr-component)
 			       (relative-space-requirement-p sr-component))))
 	      (error "Illegal space requirement ~S" sr))
@@ -337,7 +337,7 @@
 	(setf (sheet-transformation pane) xform)))))
 
 (defmethod pane-stream ((pane clim-stream-pane))
-  (unless (port pane) 
+  (unless (port pane)
     (error "Can't call ~S on ~S until it's been grafted!"
 	   'pane-stream pane))
   pane)
@@ -348,8 +348,8 @@
 ;; available viewport space.
 
 ;; well this method breaks accepting-values :own-window t by ignoring
-;; explicit :width/:height so I'm going to ignore it and see what else 
-;; breaks instead. Then perhaps we can make a fix which satisfies both 
+;; explicit :width/:height so I'm going to ignore it and see what else
+;; breaks instead. Then perhaps we can make a fix which satisfies both
 ;; constraints. (cim 2/13/95)
 
 #+ignore
@@ -375,7 +375,7 @@
 
 (defclass pointer-documentation-pane (clim-stream-pane) ())
 
-(defclass title-pane (clim-stream-pane) 
+(defclass title-pane (clim-stream-pane)
     ((display-string :initform nil :initarg :display-string)))
 
 (defclass command-menu-pane (clim-stream-pane) ())
@@ -383,9 +383,9 @@
 (defun make-clim-stream-pane-1 (framem frame
 				&rest options
 				&key (type 'clim-stream-pane)
-				     label 
+				     label
 				     (label-alignment #+Genera :bottom #-Genera :top)
-				     (scroll-bars ':vertical)
+				     (scroll-bars :vertical)
 				     (borders t)
 				     (display-after-commands nil dac-p)
 				     background
@@ -405,30 +405,34 @@
 	   (pane stream))
 
       (when scroll-bars
-	(setq pane (make-pane 'scroller-pane
-			      :scroll-bars scroll-bars
-			      :contents pane
-			      :name name
-			      :background background)))
+	(let ((scroller-pane-options
+	       (if (consp scroll-bars)
+		   `(:scroll-bars ,@scroll-bars)
+		 `(:scroll-bars ,scroll-bars))))
+	  (setq pane (apply #'make-pane 'scroller-pane
+			    :contents pane
+			    :name name
+			    :background background
+			    scroller-pane-options))))
 
       (when label
 	(let ((label (if (stringp label)
-			 (make-pane 'label-pane 
+			 (make-pane 'label-pane
 				    :label label
 				    :max-width +fill+
 				    :background background)
-		       (apply #'make-pane 'label-pane 
+		       (apply #'make-pane 'label-pane
 			      :label (first label)
-			      :max-width +fill+ 
+			      :max-width +fill+
 			      :background background
 			      (rest label)))))
 	  (setq pane (make-pane 'vbox-pane
-				:contents 	  
+				:contents
 				(ecase label-alignment
 				  (:bottom (list pane label))
 				  (:top (list label pane)))
 				:background background))))
-      (when borders 
+      (when borders
 	(setq pane
 	  (make-pane 'outlined-pane
 		     :name name
@@ -490,7 +494,7 @@
     (when text-record (replay text-record stream)))
   (let ((presentation (highlighted-presentation stream nil)))
     (when presentation
-      (highlight-presentation 
+      (highlight-presentation
 	presentation (presentation-type presentation) stream :highlight))))
 
 (defmethod window-refresh :around ((stream clim-stream-sheet))
@@ -520,7 +524,7 @@
 
 (defmethod window-visibility ((stream clim-stream-sheet))
   (let ((frame (pane-frame stream)))
-    (and (if frame 
+    (and (if frame
 	     (eq (frame-state frame) :enabled)
 	   (sheet-enabled-p stream))
 	 (mirror-visible-p (port stream) stream))))
@@ -659,7 +663,7 @@
 	(let ((width (- stream-width (abs delta-x)))
 	      (height (- stream-height (abs delta-y)))
 	      (transform (sheet-transformation window)))
-	  (multiple-value-call #'copy-area 
+	  (multiple-value-call #'copy-area
 	    window
 	    (untransform-position transform from-x from-y)
 	    (untransform-distance transform width height)
@@ -672,7 +676,7 @@
   (multiple-value-bind (valid-p left top right bottom)
       (ltrb-overlaps-ltrb-p old-left old-top old-right old-bottom
 			    new-left new-top new-right new-bottom)
-    (when valid-p 
+    (when valid-p
       (with-sheet-medium (medium window)
 	(medium-clear-area medium left top right bottom)
 	(repaint-sheet window (make-bounding-rectangle left top right bottom))))))
@@ -691,7 +695,7 @@
   (:selector :visible-cursorpos-limits))
 
 #+Genera
-(defmethod stream-compatible-visible-cursorpos-limits 
+(defmethod stream-compatible-visible-cursorpos-limits
 	   ((window clim-stream-sheet) &optional (unit ':pixel))
   (with-bounding-rectangle* (left top right bottom) (window-viewport window)
     (ecase unit
diff --git a/clim/frames.lisp b/clim/frames.lisp
index d387f590..f76ed290 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.77 1994/12/04 23:57:38 colin Exp $
+;; $fiHeader: frames.lisp,v 1.78 1995/05/17 19:47:51 colin Exp $
 
 (in-package :clim-internals)
 
@@ -404,7 +404,11 @@
   `(multiple-value-bind (graft-width graft-height)
        (bounding-rectangle-size ,graft)
      ;;--- This fudge factor stuff looks dubious  --SWM
-     (let ((fudge-factor #+ignore 0.9 #-ignore 1))
+     ;; using 1 works ok by limiting the size of the top level window
+     ;; (not the top level window + frame). As you can't know (I don't
+     ;; think) what the particular wm frame size will be using a hard
+     ;; wired fudge factor of .9 seems ok to me (cim 9/4/95)
+     (let ((fudge-factor #-ignore 0.9 #+ignore 1))
        (minf-or ,width (* graft-width fudge-factor))
        (minf-or ,height (* graft-height fudge-factor)))))
 
@@ -565,7 +569,8 @@
 				   (when (typep frame frame-class)
 				     (return-from find-frame frame)))
 			       :frame-manager frame-manager
-			       :port port)))))
+			       :port port)
+	      nil))))
     (when (and create (null frame))
       (with-keywords-removed (initargs initargs '(:create :activate :own-process))
 	(setq frame (apply #'make-application-frame frame-name initargs))))
@@ -601,7 +606,7 @@
 		 (frame-top-level-sheet frame))))
 	   (layout-frame frame width height)
 	   (when (and left top)
-	     (move-sheet (frame-top-level-sheet frame) left top))
+	     (position-sheet-carefully (frame-top-level-sheet frame) left top))
 	   (note-frame-enabled (frame-manager frame) frame)))
 	(:shrunk
 	 (note-frame-deiconified (frame-manager frame) frame)))))
diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp
index 1ef778d5..c414fc27 100644
--- a/clim/gadget-output.lisp
+++ b/clim/gadget-output.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gadget-output.lisp,v 1.57 1994/12/04 23:57:41 colin Exp $
+;; $fiHeader: gadget-output.lisp,v 1.58 1995/05/17 19:47:55 colin Exp $
 
 (in-package :clim-internals)
 
@@ -791,6 +791,9 @@
   (move-cursor-to-view-position stream view)
   (flet ((update-gadget (record gadget list-pane)
 	   (declare (ignore gadget record))
+	   (if active-p
+	       (activate-gadget list-pane)
+	     (deactivate-gadget list-pane))
 	   (setf (gadget-value list-pane) default)
 	   list-pane))
     (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp
index 106f5f36..a3587f3a 100644
--- a/clim/input-protocol.lisp
+++ b/clim/input-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: input-protocol.lisp,v 1.46 1994/12/04 23:57:50 colin Exp $
+;; $fiHeader: input-protocol.lisp,v 1.47 1995/05/17 19:48:00 colin Exp $
 
 (in-package :clim-internals)
 
@@ -114,8 +114,11 @@
 
 (defmethod repaint-sheet :after ((stream input-protocol-mixin) region)
   (let ((cursor (stream-text-cursor stream))
-	(viewport (pane-viewport stream)))
-    (when (and cursor viewport)
+	#+ignore (viewport (pane-viewport stream)))
+    ;; I don't know why the requirement was being made for the stream
+    ;; to have a viewport. This was causing problems for cursor redraw
+    ;; in panes with no scroll-bars.
+    (when (and cursor #+ignore viewport)
       (when (and (cursor-active cursor)
 		 (cursor-state cursor))
 	(multiple-value-bind (x y) (cursor-position cursor)
diff --git a/clim/interactive-defs.lisp b/clim/interactive-defs.lisp
index 7ee9fcd1..f65843bd 100644
--- a/clim/interactive-defs.lisp
+++ b/clim/interactive-defs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: interactive-defs.lisp,v 1.24 1993/07/27 01:40:00 colin Exp $
+;; $fiHeader: interactive-defs.lisp,v 1.25 1995/05/17 19:48:03 colin Exp $
 
 (in-package :clim-internals)
 
@@ -179,6 +179,10 @@
 			;;--- haven't updated WRITE-CHAR yet
 			#+++ignore (write-char gesture stream))
 		       (t (beep stream))))
+		((activation-gesture-p gesture)
+		 (return-token gesture))
+		((delimiter-gesture-p gesture)
+		 (return-token gesture))
 		(t (beep stream))))))))
 
 (defun write-token (token stream &key acceptably)
diff --git a/clim/menus.lisp b/clim/menus.lisp
index 4abef5e8..30fb5e59 100644
--- a/clim/menus.lisp
+++ b/clim/menus.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: menus.lisp,v 1.47 1994/12/04 23:57:57 colin Exp $
+;; $fiHeader: menus.lisp,v 1.48 1995/05/17 19:48:06 colin Exp $
 
 (in-package :clim-internals)
 
@@ -13,9 +13,9 @@
 (defparameter *default-menu-label-text-style* (make-text-style :fix :italic :normal))
 
 (define-application-frame menu-frame ()
-  (menu 
+  (menu
    (label :initarg :label :initform nil :accessor menu-frame-label)
-   (scroll-bars :initarg :scroll-bars 
+   (scroll-bars :initarg :scroll-bars
 		:initform t
 		:reader menu-frame-scroll-bars))
   (:pane
@@ -30,7 +30,7 @@
 				      :initial-cursor-visibility nil)))))
 	 (if label
 	     (vertically ()
-	       (setq label (make-pane 'label-pane 
+	       (setq label (make-pane 'label-pane
 				      :label ""
 				      :text-style *default-menu-label-text-style*))
 	       main)
@@ -58,16 +58,16 @@
     (values (slot-value frame 'menu) frame)))
 
 (defresource menu (associated-window root &key label (scroll-bars t))
-	     :constructor 
+	     :constructor
 	     (let* ((framem (if (null root) (find-frame-manager) (frame-manager root))))
-	       (frame-manager-get-menu framem 
+	       (frame-manager-get-menu framem
 				       :scroll-bars scroll-bars
 				       :label label
 				       :parent-frame (pane-frame root)))
 	     :matcher (and (eq scroll-bars (menu-frame-scroll-bars (pane-frame menu)))
 			   (eq (not label) (not (menu-frame-label (pane-frame menu))))
 			   (eq (frame-manager menu) (frame-manager root)))
-	       
+
 	     :deinitializer (progn
 			      (setf (window-visibility menu) nil)
 			      (window-clear menu))
@@ -77,7 +77,7 @@
   ;;--- Should this flush the menu's event queue?
   (setf (stream-default-text-margin menu) nil)
   (when label
-    (let ((text-style (if (listp label) 
+    (let ((text-style (if (listp label)
 			  (getf (rest label) :text-style *default-menu-label-text-style*)
 			*default-menu-label-text-style*))
 	  (label (if (listp label) (first label) label))
@@ -126,7 +126,7 @@
 
 ;; Perhaps misguided attempt at allowing performance win if you use
 ;; simple unique-ids.
-(defvar *menu-choose-output-history-caches* 
+(defvar *menu-choose-output-history-caches*
 	(cons (make-hash-table :test #'eql)
 	      (make-hash-table :test #'equal)))
 
@@ -181,12 +181,12 @@
     (flet ((format-item (item)
 	     (let ((type (menu-item-type item)))
 	       (flet ((print-item ()
-			(formatting-cell (menu :align-x cell-align-x 
+			(formatting-cell (menu :align-x cell-align-x
 					       :align-y cell-align-y)
 			  (funcall item-printer item menu))))
 		 (declare (dynamic-extent #'print-item))
 		 (ecase type
-		   (:item 
+		   (:item
 		     (if (menu-item-active item)
 			 (let ((presentation
 				 (with-output-as-presentation (menu item presentation-type
@@ -198,7 +198,7 @@
 			 (with-drawing-options (menu :ink *command-table-menu-gray*
 						     :text-face :bold)
 			   (print-item))))
-		   (:label 
+		   (:label
 		     (print-item))
 		   (:divider
 		     (let* ((width (menu-item-getf item :width 50))
@@ -207,7 +207,7 @@
 		       (formatting-cell (menu :align-x cell-align-x
 					      :align-y :center)
 			 (with-local-coordinates (menu)
-			   (draw-line* menu 0 0 width 0 
+			   (draw-line* menu 0 0 width 0
 				       :line-thickness thickness :ink ink))))))))))
       (declare (dynamic-extent #'format-item))
       (map nil #'format-item items)))
@@ -318,12 +318,12 @@
 					       :item-printer item-printer
 					       :max-width max-width :max-height max-height
 					       :n-rows n-rows :n-columns n-columns
-					       :x-spacing x-spacing :y-spacing y-spacing 
+					       :x-spacing x-spacing :y-spacing y-spacing
 					       :row-wise row-wise
 					       :cell-align-x cell-align-x
 					       :cell-align-y cell-align-y)))
 		    (declare (dynamic-extent #'menu-choose-body))
-		    (menu-choose-from-drawer 
+		    (menu-choose-from-drawer
 		      menu 'menu-item #'menu-choose-body
 		      :cache cache
 		      :unique-id unique-id :id-test id-test
@@ -350,7 +350,7 @@
 	 (invoke-with-mouse-grabbed-in-window
 	   (frame-manager ,w) ,w #'with-mouse-grabbed-in-window-body ,@options)))))
 
-(defmethod invoke-with-mouse-grabbed-in-window 
+(defmethod invoke-with-mouse-grabbed-in-window
 	   ((framem standard-frame-manager) (window t) continuation &key)
   (funcall continuation))
 
@@ -359,10 +359,10 @@
     `(flet ((with-menu-as-popup-body () ,@body))
        (declare (dynamic-extent #'with-menu-as-popup-body))
        (let ((,w ,menu))
-	 (invoke-with-menu-as-popup 
+	 (invoke-with-menu-as-popup
 	   (frame-manager ,w) ,w #'with-menu-as-popup-body)))))
 
-(defmethod invoke-with-menu-as-popup 
+(defmethod invoke-with-menu-as-popup
 	   ((framem standard-frame-manager) (sheet basic-sheet) continuation)
   (funcall continuation))
 
@@ -374,7 +374,7 @@
 ;;     that are of different types.  See example below
 (defun menu-choose-from-drawer (menu presentation-type drawer
 				&key x-position y-position
-				     cache unique-id (id-test #'equal) 
+				     cache unique-id (id-test #'equal)
 				     (cache-value t) (cache-test #'eql)
 				     ;; for use by HIERARCHICHAL-MENU-CHOOSE
 				     leave-menu-visible
@@ -382,7 +382,7 @@
 				     pointer-documentation menu-type)
   (declare (ignore menu-type))
   (flet (#+Allegro
-	 (abort-menu-handler () 
+	 (abort-menu-handler ()
 	   (return-from menu-choose-from-drawer nil)))
     #+Allegro (declare (dynamic-extent #'abort-menu-handler))
     (with-clim-state-reset (:all t
@@ -412,7 +412,7 @@
 	       (with-output-recording-options (menu :draw nil :record t)
 		 (let ((menu-contents
 			(with-new-output-record (menu)
-			  (setq default-presentation 
+			  (setq default-presentation
 			    (funcall drawer menu presentation-type)))))
 		   (when cache
 		     (setf (get-from-output-history-cache unique-id id-test)
@@ -443,7 +443,7 @@
 			   ;; is needed.
 			   ;;--- This screws up in Allegro because querying the server
 			   ;;--- in the wait function screws event handling.
-			   (or #-Allegro 
+			   (or #-Allegro
 			       (and *abort-menus-when-buried*
 				    (not (window-visibility menu)))
 			       (pointer-motion-pending menu)))
@@ -455,7 +455,7 @@
 			     (return-from menu-choose-from-drawer nil))
 			   ;; Take care of highlighting
 			   (highlight-presentation-of-context-type menu)))
-		  #-Allegro  
+		  #-Allegro
 		  (declare (dynamic-extent #'input-wait-test #'input-wait-handler))
 		  ;; Await exposure before going any further, since X can get
 		  ;; to the call to READ-GESTURE before the menu is visible.
@@ -502,7 +502,7 @@
 					     :item-printer item-printer
 					     :max-width max-width :max-height max-height
 					     :n-rows n-rows :n-columns n-columns
-					     :x-spacing x-spacing :y-spacing y-spacing 
+					     :x-spacing x-spacing :y-spacing y-spacing
 					     :row-wise row-wise
 					     :cell-align-x cell-align-x
 					     :cell-align-y cell-align-y)))
@@ -615,7 +615,7 @@
 	  (let ((new-menu (define-static-menu-1 name this-root items
 						:default-item default-item
 						:text-style text-style
-						:printer printer 
+						:printer printer
 						:presentation-type presentation-type
 						:drawer-args drawer-args)))
 	    (setq menu-contents (slot-value new-menu 'menu-contents)
@@ -624,7 +624,7 @@
     (with-menu (menu associated-window :label label :scroll-bars scroll-bars)
       (with-text-style (menu text-style)
 	(multiple-value-bind (item gesture)
-	    (menu-choose-from-drawer 
+	    (menu-choose-from-drawer
 	      menu 'menu-item #'false		;the drawer never gets called
 	      :cache static-menu
 	      :unique-id name
@@ -645,7 +645,7 @@
 
 (define-application-frame open-window-stream-frame ()
   ((type :initarg :type)
-   (scroll-bars :initarg :scroll-bars) 
+   (scroll-bars :initarg :scroll-bars)
    (borders :initarg :borders)
    (background :initarg :background)
    (foreground :initarg :foreground)
@@ -667,12 +667,12 @@
 	:borders borders))
      pane)))
 
-(defun open-window-stream (&key (left nil leftp)
-				(top nil topp)
-				(right nil rightp)
-				(bottom nil bottomp) 
+(defun open-window-stream (&key left
+				top
+				right
+				bottom
 				width height
-				foreground 
+				foreground
 				background
 				text-style
 				(vertical-spacing 2)
@@ -708,10 +708,11 @@
 					:text-style text-style
 					:frame-manager
 					(etypecase parent
-					  ((or pane standard-application-frame) 
+					  ((or pane standard-application-frame)
 					   (frame-manager parent))
 					  (frame-manager parent)
-					  (null (find-frame-manager)))))
+					  (null (find-frame-manager)))
+					:left left :top top))
 	 (stream (slot-value frame 'stream)))
     (setf (stream-vertical-spacing stream) vertical-spacing
 	  (stream-end-of-line-action stream) end-of-line-action
@@ -725,6 +726,11 @@
       (stream-output-history stream) (make-instance output-record))
     (window-set-inside-size stream width height)
     (window-set-viewport-position stream 0 0)
+
+    ;; moved this into the :left, :top args to above make-application-frame.
+    ;; The position-sheet-carefully doesn't seem to work because the frame
+    ;;  window isn't realized at this point (cim 9/15/95)
+    #+ignore
     (when (or leftp topp rightp bottomp)
       (position-sheet-carefully
        (frame-top-level-sheet (pane-frame stream)) left top))
diff --git a/clim/tracking-pointer.lisp b/clim/tracking-pointer.lisp
index b0a3c3a6..64eddcc5 100644
--- a/clim/tracking-pointer.lisp
+++ b/clim/tracking-pointer.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: tracking-pointer.lisp,v 1.18 1993/07/27 01:41:43 colin Exp $
+;; $fiHeader: tracking-pointer.lisp,v 1.19 1994/12/04 23:58:14 colin Exp $
 
 (in-package :clim-internals)
 
@@ -41,7 +41,7 @@
 )	;eval-when
 
 (defmacro tracking-pointer ((&optional stream
-			     &key pointer multiple-window transformp 
+			     &key pointer multiple-window transformp
 				  (context-type t) (highlight nil
 						    highlight-p) timeout)
 			    &body clauses)
@@ -91,7 +91,7 @@
 				      :timeout ,timeout))))))
 
 (defun tracking-pointer-1 (stream pointer generator
-			   &key multiple-window transformp 
+			   &key multiple-window transformp
 				context-type highlight timeout)
   (unless pointer
     (setq pointer (stream-primary-pointer stream)))
@@ -117,8 +117,8 @@
 	 (highlighted-presentation-window nil)
 	 ;; Bind the input context so that presentation searching works
 	 (*input-context*
-	   (with-presentation-type-decoded (name parameters) context-type
-	     (list (list (list* name parameters) nil))))
+	  (with-presentation-type-decoded (name parameters) context-type
+					  (list (list (list* name parameters) nil))))
 	 ;; Bind these to NIL in case someone is doing TRACKING-POINTER
 	 ;; inside of a presentation action
 	 (*input-wait-test* nil)
@@ -130,141 +130,145 @@
 			  highlighted-presentation-type (presentation-type ,presentation)
 			  highlighted-presentation-window current-window)
 		    (when (output-recording-stream-p current-window)
-		      (highlight-presentation 
-		        highlighted-presentation highlighted-presentation-type
-		        highlighted-presentation-window :highlight))))
+		      (highlight-presentation
+		       highlighted-presentation highlighted-presentation-type
+		       highlighted-presentation-window :highlight))))
 	       (unhighlight ()
 		 `(when highlighted-presentation
 		    (when (output-recording-stream-p current-window)
 		      (highlight-presentation
-		        highlighted-presentation highlighted-presentation-type
-		        highlighted-presentation-window :unhighlight))
+		       highlighted-presentation highlighted-presentation-type
+		       highlighted-presentation-window :unhighlight))
 		    (setq highlighted-presentation nil)))
 	       (find-presentation (window x y &key event)
 		 `(if (eq context-type t)
 		      (find-innermost-presentation ,window ,x ,y)
-		      (frame-find-innermost-applicable-presentation
-			*application-frame* *input-context*
-			,window ,x ,y ,@(and event `(:event ,event))))))
+		    (frame-find-innermost-applicable-presentation
+		     *application-frame* *input-context*
+		     ,window ,x ,y ,@(and event `(:event ,event))))))
       (unwind-protect
-	  (loop
-	    ;; Handle pointer motion
-	    (block handle-simple-motion
-	      (when (or motion-function presentation-motion-function highlight)
-		(when multiple-window
-		  (setq current-window (or (pointer-sheet pointer) (graft pointer))))
-		(multiple-value-bind (x y) (sheet-pointer-position
-					    current-window pointer)
-		  (when moved-p
-		    (setq moved-p nil)
-		    (setq last-x x last-y y
-			  last-window current-window)
-		    ;; Pointer position is in root (graft) coordinates
-		    (when (or presentation-motion-function highlight)
-		      (let ((presentation
-			      (and (output-recording-stream-p current-window)
-				   (find-presentation current-window x y))))
-			(when presentation
-			  (when highlight
-			    (unless (eq presentation highlighted-presentation)
-			      (unhighlight)
-			      (highlight presentation)))
-			  (when presentation-motion-function
-			    (funcall presentation-motion-function
-				     presentation current-window x y))
-			  (return-from handle-simple-motion))))
-		    (unhighlight)
-		    (when motion-function
-		      (when transformp
-			(multiple-value-bind (tx ty)
-			    (transform-position
-			      (medium-transformation current-window) x y)
-			  (setq x (coordinate tx)
-				y (coordinate ty))))
-		      (funcall motion-function current-window x y))))))
-	    (block input-wait
-	      (loop
-		;; Handle any clicks or characters, otherwise wait for something
-		;; interesting to happen.
-		(when multiple-window
-		  (setq current-window (or (pointer-sheet pointer) (graft pointer))))
-		(flet ((pointer-motion-pending (window)
-			 (when (and (or multiple-window
-					(eq current-window (pointer-sheet pointer)))
-				    (eq (stream-primary-pointer window) pointer))
-			   (multiple-value-setq (moved-p last-window last-x last-y)
-			     (pointer-state-changed pointer last-window last-x last-y))
-			   (and moved-p last-window))))
-		  #-Allegro (declare (dynamic-extent #'pointer-motion-pending))
-		  ;; It's OK to do the input wait on STREAM instead of on
-		  ;; CURRENT-WINDOW, because multiple-window mode only works
-		  ;; when all the windows share the same I/O buffer.  Same
-		  ;; deal with the READ-GESTURE below, too.
-		  ;;--- It's a bug that multiple-window has that restriction...
-		  (multiple-value-setq (input-happened timed-out)
-		    (stream-input-wait stream
-				       :timeout timeout
-				       :input-wait-test #'pointer-motion-pending)))
-		;; Don't call READ-GESTURE if there is no gesture to read
-		;;--- If we called READ-GESTURE on CURRENT-WINDOW, we would
-		;;--- get the (possibly undesirable) side-effect that the
-		;;--- "input focus" will follow the mouse, having particularly 
-		;;--- weird behavior regarding keystrokes.
-		(let ((gesture
-			(and input-happened
-			     (read-gesture :stream stream :timeout 0))))
-		  (block process-gesture
-		    (cond ((null gesture)
-			   (if (and (eq timed-out :timeout)
-				    timeout-function)
-			       (funcall timeout-function))
-			   (return-from input-wait))
-			  ((keyboard-event-p gesture)
-			   (when keyboard-function
-			     (funcall keyboard-function gesture)
-			     (return-from process-gesture)))
-			  ((or (typep gesture 'pointer-button-press-event)
-			       (typep gesture 'pointer-button-release-event))
-			   (let* ((px (pointer-event-x gesture))
-				  (py (pointer-event-y gesture))
-				  (wx px)
-				  (wy py))
-			     (when transformp
-			       (multiple-value-bind (tx ty)
-				   (transform-position
-				     (medium-transformation current-window) px py)
-				 (setq wx (coordinate tx)
-				       wy (coordinate ty))))
-			     (typecase gesture
-			       (pointer-button-press-event
-				 (when presentation-press-function
-				   (let* ((window (event-sheet gesture))
-					  (presentation
-					    (and (output-recording-stream-p window)
-						 (find-presentation 
-						   window px py :event gesture))))
-				     (when presentation
-				       (funcall presentation-press-function
-						presentation gesture wx wy)
-				       (return-from process-gesture))))
-				 (when button-press-function
-				   (funcall button-press-function gesture wx wy))
-				 (return-from process-gesture))
-			       (t		;pointer-button-release-event
-				 (when presentation-release-function
-				   (let* ((window (event-sheet gesture))
-					  (presentation
-					    (and (output-recording-stream-p window)
-						 (find-presentation
-						   window px py :event gesture))))
-				     (when presentation
-				       (funcall presentation-release-function
-						presentation gesture wx wy)
-				       (return-from process-gesture))))
-				 (when button-release-function
-				   (funcall button-release-function gesture wx wy))
-				 (return-from process-gesture))))))
-		    (beep stream))))))
+	  (when multiple-window
+	    (port-remove-all-pointer-grabs (port pointer)))
+	(loop
+	  ;; Handle pointer motion
+	  (block handle-simple-motion
+	    (when (or motion-function presentation-motion-function highlight)
+	      (when multiple-window
+		(setq current-window (or (pointer-sheet pointer) (graft pointer))))
+	      (multiple-value-bind (x y) (sheet-pointer-position
+					  current-window pointer)
+		(when moved-p
+		  (setq moved-p nil)
+		  (setq last-x x last-y y
+			last-window current-window)
+		  ;; Pointer position is in root (graft) coordinates
+		  (when (or presentation-motion-function highlight)
+		    (let ((presentation
+			   (and (output-recording-stream-p current-window)
+				(find-presentation current-window x y))))
+		      (when presentation
+			(when highlight
+			  (unless (eq presentation highlighted-presentation)
+			    (unhighlight)
+			    (highlight presentation)))
+			(when presentation-motion-function
+			  (funcall presentation-motion-function
+				   presentation current-window x y))
+			(return-from handle-simple-motion))))
+		  (unhighlight)
+		  (when motion-function
+		    (when transformp
+		      (multiple-value-bind (tx ty)
+			  (transform-position
+			   (medium-transformation current-window) x y)
+			(setq x (coordinate tx)
+			      y (coordinate ty))))
+		    (funcall motion-function current-window x y))))))
+	  (block input-wait
+	    (loop
+	      ;; Handle any clicks or characters, otherwise wait for something
+	      ;; interesting to happen.
+	      (when multiple-window
+		(setq current-window (or (pointer-sheet pointer) (graft pointer))))
+	      (flet ((pointer-motion-pending (window)
+		       (when (and (or multiple-window
+				      (eq current-window (pointer-sheet pointer)))
+				  (eq (stream-primary-pointer window) pointer))
+			 (multiple-value-setq (moved-p last-window last-x last-y)
+			   (pointer-state-changed pointer last-window last-x last-y))
+			 (and moved-p last-window))))
+		#-Allegro (declare (dynamic-extent #'pointer-motion-pending))
+		;; It's OK to do the input wait on STREAM instead of on
+		;; CURRENT-WINDOW, because multiple-window mode only works
+		;; when all the windows share the same I/O buffer.  Same
+		;; deal with the READ-GESTURE below, too.
+		;;--- It's a bug that multiple-window has that restriction...
+		(multiple-value-setq (input-happened timed-out)
+		  (stream-input-wait stream
+				     :timeout timeout
+				     :input-wait-test #'pointer-motion-pending)))
+	      ;; Don't call READ-GESTURE if there is no gesture to read
+	      ;;--- If we called READ-GESTURE on CURRENT-WINDOW, we would
+	      ;;--- get the (possibly undesirable) side-effect that the
+	      ;;--- "input focus" will follow the mouse, having particularly
+	      ;;--- weird behavior regarding keystrokes.
+	      (let ((gesture
+		     (and input-happened
+			  (read-gesture :stream stream :timeout 0))))
+		(block process-gesture
+		  (cond ((null gesture)
+			 (if (and (eq timed-out :timeout)
+				  timeout-function)
+			     (funcall timeout-function))
+			 (return-from input-wait))
+			((keyboard-event-p gesture)
+			 (when keyboard-function
+			   (funcall keyboard-function gesture)
+			   (return-from process-gesture)))
+			((or (typep gesture 'pointer-button-press-event)
+			     (typep gesture 'pointer-button-release-event))
+			 (let* ((px (pointer-event-x gesture))
+				(py (pointer-event-y gesture))
+				(wx px)
+				(wy py))
+			   (when transformp
+			     (multiple-value-bind (tx ty)
+				 (transform-position
+				  (medium-transformation current-window) px py)
+			       (setq wx (coordinate tx)
+				     wy (coordinate ty))))
+			   (typecase gesture
+			     (pointer-button-press-event
+			      (when multiple-window
+				(port-remove-all-pointer-grabs (port pointer)))
+			      (when presentation-press-function
+				(let* ((window (event-sheet gesture))
+				       (presentation
+					(and (output-recording-stream-p window)
+					     (find-presentation
+					      window px py :event gesture))))
+				  (when presentation
+				    (funcall presentation-press-function
+					     presentation gesture wx wy)
+				    (return-from process-gesture))))
+			      (when button-press-function
+				(funcall button-press-function gesture wx wy))
+			      (return-from process-gesture))
+			     (t		;pointer-button-release-event
+			      (when presentation-release-function
+				(let* ((window (event-sheet gesture))
+				       (presentation
+					(and (output-recording-stream-p window)
+					     (find-presentation
+					      window px py :event gesture))))
+				  (when presentation
+				    (funcall presentation-release-function
+					     presentation gesture wx wy)
+				    (return-from process-gesture))))
+			      (when button-release-function
+				(funcall button-release-function gesture wx wy))
+			      (return-from process-gesture))))))
+		  (beep stream))))))
 	(unhighlight)
 	(when last-window
 	  (unhighlight-highlighted-presentation last-window))))))
@@ -276,13 +280,13 @@
   (let ((x (coordinate x))
 	(y (coordinate y)))
     (declare (type coordinate x y))
-    (labels 
+    (labels
       ((mapper (record presentations x-offset y-offset)
 	 (declare (type coordinate x-offset y-offset))
 	 (multiple-value-bind (sensitive superior-sensitive inferior-presentation)
 	     (if (presentationp record)
 		 ;;--- This should call PRESENTATION-REFINED-POSITION-TEST
-		 (if (output-record-refined-position-test 
+		 (if (output-record-refined-position-test
 		       record (- x x-offset) (- y y-offset))
 		     (let ((displayed (displayed-output-record-p record))
 			   (single-box (presentation-single-box record)))
@@ -302,7 +306,7 @@
 	     (when inferior-presentation
 	       (setq presentations more-presentations))
 	     (multiple-value-bind (dx dy) (output-record-position record)
-	       (map-over-output-records-containing-position 
+	       (map-over-output-records-containing-position
 		 #'mapper record x y
 		 (- x-offset) (- y-offset)
 		 presentations (+ x-offset dx) (+ y-offset dy)))
diff --git a/clim/translators.lisp b/clim/translators.lisp
index c38a81da..ff2afd50 100644
--- a/clim/translators.lisp
+++ b/clim/translators.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: translators.lisp,v 1.12 93/03/04 19:00:20 colin Exp $
+;; $fiHeader: translators.lisp,v 1.13 1993/07/27 01:41:46 colin Exp $
 
 (in-package :clim-internals)
 
@@ -27,7 +27,7 @@
 (defclass presentation-translator ()
      ((name      :initarg :name
 		 :reader presentation-translator-name)
-      (function  :initform nil :initarg :function 
+      (function  :initform nil :initarg :function
 		 :reader presentation-translator-function)
       (tester    :initform nil :initarg :tester
 		 :reader presentation-translator-tester)
@@ -172,7 +172,7 @@
     (check-type documentation (or string symbol list))
     (check-type pointer-documentation (or string symbol list))
     (check-type menu symbol)
-    (check-type priority (or null (integer 0)))
+    (check-type priority (or null integer))
     (check-type translator-class (or null symbol))
     (let ((defining-forms nil)
 	  (translator-functions nil))
@@ -192,7 +192,7 @@
 							    name ',clause-name ,extra-args)
 			       (emit function)
 			       (push `#',gensym translator-functions))))
-		      (push (intern (symbol-name ',clause-name) *keyword-package*) 
+		      (push (intern (symbol-name ',clause-name) *keyword-package*)
 			    translator-functions))))
 	(do-translator-function tester)
 	(do-translator-function documentation '(stream) t)
@@ -232,13 +232,13 @@
 	     (or translator-class 'presentation-translator))
 	   (translator
 	     (apply #'make-instance
-		    translator-class 
+		    translator-class
 		    :name translator-name
 		    :from-type from-type
 		    :to-type to-type
 		    :gesture-name gesture
 		    :pointer-documentation (or pointer-documentation documentation)
-		    ;; Err on the side of performance: if there's no tester, 
+		    ;; Err on the side of performance: if there's no tester,
 		    ;; assume that it is definitive.
 		    :tester-definitive (or (null tester) tester-definitive)
 		    :priority (or priority 0)
@@ -302,7 +302,7 @@
 		(and cache (gethash key cache))
 	      (cond ((or (null found-p)
 			 (/= (pop translators) *translators-cache-tick*))
-		     (let ((translators (find-presentation-translators-1 
+		     (let ((translators (find-presentation-translators-1
 					  from-key to-key command-table)))
 		       (when (null cache)
 			 (setq translators-cache
@@ -310,7 +310,7 @@
 						:test #'equal))
 			 (setq cache translators-cache))
 		       ;; Need to copy the whole tree, since the from- and to-keys
-		       ;; could themselves be stack-consed. 
+		       ;; could themselves be stack-consed.
 		       (setf (gethash (copy-tree key) cache)
 			     (cons *translators-cache-tick* translators))
 		       translators))
@@ -339,10 +339,10 @@
       (declare (dynamic-extent #'collect-translators))
       (map-over-command-table-translators #'collect-translators command-table))
     ;; The translator ordering is as follows, in this order:
-    ;;  - Translators with higher high-order priority precede ones with lower 
+    ;;  - Translators with higher high-order priority precede ones with lower
     ;;    high-order priority
     ;;  - Translators on more specific types precede ones on less specific types
-    ;;  - Translators with higher low-order priority precede ones with lower 
+    ;;  - Translators with higher low-order priority precede ones with lower
     ;;    low-order priority
     ;;  - Translators from this command table precede inherited translators
     ;; First get the command table ordering correct.
@@ -453,8 +453,8 @@
 					  &key event (modifier-state 0))
   (declare (values translator any-match-p))
   (let ((one-matched nil)
-	(translators 
-	  (find-presentation-translators 
+	(translators
+	  (find-presentation-translators
 	    (presentation-type presentation) context-type (frame-command-table frame))))
     (when translators
       (dolist (translator translators)
@@ -470,7 +470,7 @@
 	  (when by-tester
 	    ;; We matched by the tester, it's OK to try the menu translator
 	    ;; unless the translator is not supposed to be in a menu.
-	    (setq one-matched (or one-matched 
+	    (setq one-matched (or one-matched
 				  (presentation-translator-menu translator))))))
       ;; If EVENT is non-NIL, then we are running on behalf of the user having
       ;; pressed a pointer button, which means that some translator must have
@@ -512,7 +512,7 @@
 			     (test-presentation-translator translator
 							   presentation context-type
 							   frame window x y
-							   :event event 
+							   :event event
 							   :modifier-state modifier-state
 							   :for-menu for-menu))
 		    (when fastp
@@ -532,7 +532,7 @@
 			 (test-presentation-translator *presentation-menu-translator*
 						       presentation context-type
 						       frame window x y
-						       :event event 
+						       :event event
 						       :modifier-state modifier-state
 						       :for-menu for-menu))
 		(push (list *presentation-menu-translator* presentation
@@ -566,7 +566,7 @@
       (cond ((stringp documentation)
 	     (write-string documentation stream))
 	    (documentation
-	     (funcall documentation 
+	     (funcall documentation
 		      (presentation-object presentation) presentation context-type
 		      frame event window x y
 		      stream))
diff --git a/demo/color-editor.lisp b/demo/color-editor.lisp
index cfc02771..ff6dd027 100644
--- a/demo/color-editor.lisp
+++ b/demo/color-editor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: color-editor.lisp,v 1.12 1993/09/17 00:20:23 colin Exp $
+;; $fiHeader: color-editor.lisp,v 1.13 1993/09/17 19:05:51 cer Exp $
 
 (in-package :clim-demo)
 
@@ -14,69 +14,72 @@
   (display-color (pane-frame stream) stream))
 
 (define-application-frame color-chooser ()
-    (color dynamic-p
-     red blue green
-     intensity hue saturation)
+  (color dynamic-p
+	 red blue green
+	 intensity hue saturation)
   (:menu-bar nil)
-  (:panes 
-    (display (make-clim-stream-pane 
-	       :type 'color-chooser-pane
-	       :scroll-bars nil
-	       :display-function 'display-color
-	       ;; Make sure we don't have a useless cursor blinking away...
-	       :initial-cursor-visibility nil))
-    (exit push-button 
-	  :label "Exit"
-	  :activate-callback #'(lambda (button)
-				 (frame-exit (pane-frame button))))
-    (rgb (with-slots (red green blue) *application-frame*
-	   (outlining ()
-	     (horizontally ()
-	       (setq red (make-pane 'slider
-			   :label "Red" :foreground +red+
-			   :orientation :vertical
-			   :min-value 0.0 :max-value 1.0 
-			   :show-value-p t :decimal-places 3
-			   :client 'color :id 'red))
-	       (setq green (make-pane 'slider
-			     :label "Green" :foreground +green+
-			     :orientation :vertical
-			     :min-value 0.0 :max-value 1.0 
-			     :show-value-p t :decimal-places 3
-			     :client 'color :id 'green))
-	       (setq blue (make-pane 'slider
-			    :label "Blue" :foreground +blue+
-			    :orientation :vertical
-			    :min-value 0.0 :max-value 1.0 
-			    :show-value-p t :decimal-places 3
-			    :client 'color :id 'blue))))))
-    (ihs (with-slots (intensity hue saturation) *application-frame*
-	   (outlining ()
-	     (horizontally ()
-	       (setq intensity (make-pane 'slider
-				 :label "Intensity"
-				 :orientation :vertical
-				 :min-value 0.0 :max-value (sqrt 3)
-				 :show-value-p t :decimal-places 3
-				 :client 'color :id 'intensity))
-	       (setq hue (make-pane 'slider
-			   :label "Hue"
-			   :orientation :vertical
-			   :min-value 0.0 :max-value 1.0 
-			   :show-value-p t :decimal-places 3
-			   :client 'color :id 'hue))
-	       (setq saturation (make-pane 'slider
-				  :label "Saturation"
-				  :orientation :vertical
-				  :min-value 0.0 :max-value 1.0 
-				  :show-value-p t :decimal-places 3
-				  :client 'color :id 'saturation)))))))
+  (:panes
+   (display (make-clim-stream-pane
+	     :type 'color-chooser-pane
+	     :scroll-bars nil
+	     :display-function 'display-color
+	     ;; Make sure we don't have a useless cursor blinking away...
+	     :initial-cursor-visibility nil))
+   (exit push-button
+	 :label "Exit"
+	 :activate-callback #'(lambda (button)
+				(frame-exit (pane-frame button))))
+   (rgb (with-slots (red green blue) *application-frame*
+	  (outlining ()
+	    (horizontally ()
+	      (setq red (make-pane 'slider
+				   :label "Red" :foreground +red+
+				   :orientation :vertical
+				   :min-value 0.0 :max-value 1.0
+				   :min-label "0.0" :max-label "1.0"
+				   :number-of-tick-marks 9 :decimal-places 3
+				   :client 'color :id 'red))
+	      (setq green (make-pane 'slider
+				     :label "Green" :foreground +green+
+				     :orientation :vertical
+				     :min-value 0.0 :max-value 1.0
+				     :min-label "0.0" :max-label "1.0"
+				     :number-of-tick-marks 9 :decimal-places 3
+				     :client 'color :id 'green))
+	      (setq blue (make-pane 'slider
+				    :label "Blue" :foreground +blue+
+				    :orientation :vertical
+				    :min-value 0.0 :max-value 1.0
+				    :min-label "0.0" :max-label "1.0"
+				    :number-of-tick-marks 9 :decimal-places 3
+				    :client 'color :id 'blue))))))
+   (ihs (with-slots (intensity hue saturation) *application-frame*
+	  (outlining ()
+	    (horizontally ()
+	      (setq intensity (make-pane 'slider
+					 :label "Intensity"
+					 :orientation :vertical
+					 :min-value 0.0 :max-value (sqrt 3)
+					 :show-value-p t :decimal-places 3
+					 :client 'color :id 'intensity))
+	      (setq hue (make-pane 'slider
+				   :label "Hue"
+				   :orientation :vertical
+				   :min-value 0.0 :max-value 1.0
+				   :show-value-p t :decimal-places 3
+				   :client 'color :id 'hue))
+	      (setq saturation (make-pane 'slider
+					  :label "Saturation"
+					  :orientation :vertical
+					  :min-value 0.0 :max-value 1.0
+					  :show-value-p t :decimal-places 3
+					  :client 'color :id 'saturation)))))))
   (:layouts
-    (default 
-      (horizontally ()
-	(outlining ()
-	  (vertically () display exit))
-	rgb ihs))))
+   (default
+       (horizontally ()
+	 (outlining ()
+	   (vertically () display exit))
+	 rgb ihs))))
 
 (defmethod run-frame-top-level :before ((frame color-chooser) &key)
   (with-slots (color dynamic-p) frame
diff --git a/postscript/postscript-medium.lisp b/postscript/postscript-medium.lisp
index 7730924f..da3d2a02 100644
--- a/postscript/postscript-medium.lisp
+++ b/postscript/postscript-medium.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: postscript-medium.lisp,v 1.16 1993/06/21 20:50:48 cer Exp $
+;; $fiHeader: postscript-medium.lisp,v 1.17 1994/12/05 00:00:05 colin Exp $
 
 (in-package :postscript-clim)
 
@@ -35,7 +35,7 @@
 (defun use-line-style (medium line-style)
   (let* ((printer-stream (slot-value medium 'printer-stream))
 	 (thickness (ecase (line-style-unit line-style)
-		      (:normal (normal-line-thickness 
+		      (:normal (normal-line-thickness
 				(port medium) (line-style-thickness line-style)))
 		      (:point (line-style-thickness line-style))))
 	 (dashes (line-style-dashes line-style))
@@ -119,9 +119,16 @@
 	   ((medium postscript-medium) (ink contrasting-ink))
   (maybe-set-color medium (make-color-for-contrasting-ink ink)))
 
+;; a temporary hack
+
+(defmethod maybe-set-color
+    ((medium postscript-medium) (ink composite-in))
+  (maybe-set-color medium
+		   (elt (slot-value ink 'clim-utils::designs) 0)))
+
 (defmacro with-postscript-drawing-options ((medium printer-stream-var
 					    &key ink (filled nil
-						      filled-p) line-style 
+						      filled-p) line-style
 						 clip-region
 						 epilogue (newpath t))
 					   &body body)
@@ -286,7 +293,7 @@
 	  position-seq)))))
 
 (defmethod medium-draw-ellipse* ((medium postscript-medium)
-				 center-x center-y 
+				 center-x center-y
 				 radius-1-dx radius-1-dy radius-2-dx radius-2-dy
 				 start-angle end-angle filled)
   (maybe-send-feature medium 'ellipse *ps-ellipse-code*)
@@ -295,7 +302,7 @@
 	 (line-style (medium-line-style medium))
 	 (clip-region (medium-clipping-region medium)))
     (convert-to-postscript-coordinates transform center-x center-y)
-    (convert-to-postscript-distances transform 
+    (convert-to-postscript-distances transform
       radius-1-dx radius-1-dy radius-2-dx radius-2-dy)
     (when (null start-angle)
       (setq start-angle 0
@@ -356,9 +363,9 @@
 	   (height (psfck-clim-height fcs))
 	   (descent (psfck-clim-descent fcs))
 	   (ascent (- height descent)))
-      (let ((x-adjust 
+      (let ((x-adjust
 	      (compute-text-x-adjustment align-x medium string text-style start end))
-	    (y-adjust 
+	    (y-adjust
 	      (compute-text-y-adjustment align-y descent ascent height)))
 	(incf x x-adjust)
 	(incf y y-adjust)
@@ -367,14 +374,14 @@
 	  (incf towards-y y-adjust)))
       ;; do raster/ink stuff.
       (set-font-if-needed medium fcs)
-      
+
       (ps-pos-op medium "m" x y)
       (with-postscript-drawing-options (medium printer-stream
 					       :epilogue nil :newpath nil
 					       :ink ink
 					       :clip-region clip-region)
 	(if towards-x
-	    (with-postscript-gsave medium 
+	    (with-postscript-gsave medium
 	      (format printer-stream " currentpoint translate ~D rotate "
 		      (- 360 (truncate (* (atan (- towards-y y) (- towards-x x)) (/ 360 (* pi 2))))))
 	      (carefully-output-ps-showstring printer-stream string start end))
@@ -393,7 +400,7 @@
 	    string-or-char ch1buf
 	    start 0
 	    end 1))
-    (medium-draw-string* medium string-or-char x y start end 
+    (medium-draw-string* medium string-or-char x y start end
 			 align-x align-y towards-x towards-y transform-glyphs)))
 
 (defmethod medium-text-bounding-box ((medium postscript-medium)
@@ -406,7 +413,7 @@
       (left top right bottom cx cy towards-x towards-y) (call-next-method)
     (if (and towards-y towards-x)
 	(let ((transformation
-	       (make-rotation-transformation 
+	       (make-rotation-transformation
 		(atan (- towards-y cy) (- towards-x cx))
 		(make-point cx cy))))
 	  (multiple-value-setq (left top)
@@ -431,15 +438,15 @@
 	 (height (psfck-clim-height fcs))
 	 (descent (psfck-clim-descent fcs))
 	 (ascent (- height descent)))
-    (let ((x-adjust 
+    (let ((x-adjust
 	    (compute-text-x-adjustment align-x medium string text-style start end))
-	  (y-adjust 
+	  (y-adjust
 	    (compute-text-y-adjustment align-y descent ascent height)))
       (set-font-if-needed medium fcs)
       (with-postscript-drawing-options (medium printer-stream
 					:epilogue nil :newpath nil
 					:ink ink)
-	(with-postscript-gsave medium 
+	(with-postscript-gsave medium
 	  (ps-pos-op medium "m" x y)
 	  (format printer-stream " currentpoint translate 90 rotate ")
 	  (ps-rel-pos-op medium "rmoveto" x-adjust y-adjust)
@@ -475,7 +482,7 @@
 		   ;; about.
 		   (let* ((fcs (or ,our-font (get-font-compat-str ,port nil ,style)))
 			  (cwt (psfck-width-table fcs))
-			  (relwidth (if (numberp cwt) 
+			  (relwidth (if (numberp cwt)
 					cwt
 					(aref cwt index)))
 			  (escapement-x (* (psfck-clim-height fcs) relwidth))
@@ -499,10 +506,10 @@
 ;;-- Is this needed??
 
 #+ignore
-(defmethod stream-scan-string-for-writing 
+(defmethod stream-scan-string-for-writing
 	   ((stream clim-internals::output-protocol-mixin) (medium postscript-medium)
 	    string start end style cursor-x max-x &optional glyph-buffer)
-  (with-postscript-glyph-for-character 
+  (with-postscript-glyph-for-character
     (stream-scan-string-for-writing-1
       stream medium string start end style cursor-x max-x glyph-buffer)))
 
@@ -545,13 +552,13 @@
 		   (return fcs))
 		 (when (eq styledesc (psfck-style-descriptor fcs))
 		   (return fcs))))))
-      (when (and fcs 
+      (when (and fcs
 		 medium
 		 (let ((stream (medium-sheet medium)))
 		   (or (not (output-recording-stream-p stream))
 		       (stream-drawing-p stream)))
 		 (not (psfck-established fcs)))
-	  (with-slots (printer-stream) medium 
+	  (with-slots (printer-stream) medium
 	    (format printer-stream "~D ~D /~A estfont~%"
 		    (psfck-index fcs) (psfck-points fcs) (get-ps-fam-face-name fcs))
 	    (setf (psfck-established fcs) t)))
@@ -568,7 +575,7 @@
   ;;--- This should consult the real metrics.
   (nth-value 6 (port-glyph-for-character (port medium) #\M text-style)))
 
-(defmethod text-style-height 
+(defmethod text-style-height
 	   ((text-style standard-text-style) (medium postscript-medium))
   (nth-value 7 (port-glyph-for-character (port medium) #\M text-style)))
 
@@ -593,7 +600,7 @@
 		     (point-size-for-size-keyword size famdat))))
     points))
 
-(defmethod text-style-fixed-width-p 
+(defmethod text-style-fixed-width-p
 	   ((text-style standard-text-style) (medium postscript-medium))
   (let* ((family (text-style-family text-style))
 	 (face (text-style-face text-style))
diff --git a/postscript/postscript-port.lisp b/postscript/postscript-port.lisp
index f3b4dfa5..317e8354 100644
--- a/postscript/postscript-port.lisp
+++ b/postscript/postscript-port.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: postscript-port.lisp,v 1.23 1993/11/18 18:44:51 cer Exp $
+;; $fiHeader: postscript-port.lisp,v 1.24 1994/12/05 00:00:07 colin Exp $
 
 (provide :climps)
 
@@ -145,7 +145,7 @@
 ;; The second element is a character size, which is either a number or a
 ;; place to go looking to get the character width table
 (defparameter *ps-font-family-data*
-	      '(("Times" 
+	      '(("Times"
 		 (nil "tir" "Times-Roman")
 		 (:bold "tib" "Times-Bold")
 		 (:italic "tii" "Times-Italic")
@@ -168,13 +168,13 @@
 			    (error "No info for PostScript font family ~A" fam)))))
       (third (or (assoc face famdata)
 		 (error "No info for PostScript family ~A face ~A." fam face))))))
-	
+
 ;; Value is a 3 element list acceptable as a returned value from
 ;; CONVERT-CLIM-TO-PS-FONT-DESCRIPTION:  a postscript family name as
 ;; appears in the CARs of the elements of *PS-FONT-FAMILY-DATA*, a face
 ;; keyword as returned by the function KEYWORDIFY-STYLE-FACE, and a
 ;; size in points.
-(defparameter *ps-font-description-for-undefined-style* '("Courier" nil 4))	      
+(defparameter *ps-font-description-for-undefined-style* '("Courier" nil 4))
 
 (defun convert-clim-to-ps-font-description (style)
   (let ((size (text-style-size style))
@@ -346,7 +346,7 @@
 
 ;;; the software that drives the LGP2 (sys:hardcopy;postscript.lisp)
 ;;; uses LGP:FAST-PRINT-NUM except for writing transformation matrices,
-;;; for which it uses 
+;;; for which it uses
 ;;;       (prin1 (if (fixp elem) elem (float elem)) output-stream)
 ;;; and also some cases of Format ~D.
 (defun ps-optimal-flonize (n stream)
@@ -367,7 +367,7 @@
 		  (negative-p nil))
 	      (when (minusp n)
 		(setq negative-p t))
-	      (with-stack-array (string from :element-type #+ANSI-90 'character 
+	      (with-stack-array (string from :element-type #+ANSI-90 'character
 							   #-ANSI-90 'string-char)
 		(macrolet ((add-char (char)
 			     `(setf (aref string (decf from)) ,char)))
@@ -412,10 +412,10 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
         /str 100 string def
         nbits 0 ne {
           gsave width height scale
-          bitwidth height true [bitwidth 0 0 height neg 0 height] 
-            {   nbits 800 ge {/nbits nbits 800 sub def str} 
+          bitwidth height true [bitwidth 0 0 height neg 0 height]
+            {   nbits 800 ge {/nbits nbits 800 sub def str}
                                {nbits 8 idiv string /nbits 0 def}
-                            ifelse 
+                            ifelse
                   currentfile exch readhexstring pop}
           imagemask grestore
         } if end
@@ -443,7 +443,7 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
         width 0 ne { height 0 ne {
         /scanline -1 def /linebits 0 def
         width height idtransform abs scale scal dup scale
-        width height true [width 0 0 height neg 0 height] 
+        width height true [width 0 0 height neg 0 height]
 % This procedure returns the same row the right number of times
 % I suppose if the pattern does not fit exactly it does not matter
 % since there is a clipping region.
@@ -460,12 +460,12 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
 /patfill1 { initmatrix clippath
 %condition-case for nocurrentpoint, returning empty rectangle
              errordict begin
-               /nocurrentpoint dup dup load exch { pop 0 0 0 0 } def 
+               /nocurrentpoint dup dup load exch { pop 0 0 0 0 } def
                  pathbbox
                6 -2 roll def end
 % pattern scale opaque-p bx1 by1 bx2 by2
              4 2 roll 2 copy translate 4 -2 roll
-% pattern scale opaque-p  bx1 by1 bx2 by2 
+% pattern scale opaque-p  bx1 by1 bx2 by2
              3 -1 roll sub 3 1 roll exch sub exch
 % pattern scale opaque-p dx dy
              3 -1 roll { 2 copy gsave 1 setgray newpath
@@ -482,11 +482,11 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
  [/depth /height /width] {exch def} forall
  gsave
    clip
-% Get the bounding box of the clip path on the stack   
+% Get the bounding box of the clip path on the stack
    initmatrix clippath
    %condition-case for nocurrentpoint, returning empty rectangle
              errordict begin
-               /nocurrentpoint dup dup load exch { pop 0 0 0 0 } def 
+               /nocurrentpoint dup dup load exch { pop 0 0 0 0 } def
                  pathbbox
                6 -2 roll def end
 % Stack is bx1 by1 bx2 by2
@@ -510,36 +510,56 @@ end } def
 ")
 
 (defmethod postscript-prologue ((medium postscript-medium)
-				&key scale-factor (orientation :portrait)
+				&key (scale-factor 1) (orientation :portrait)
 				     header-comments)
   (let ((printer-stream (slot-value medium 'printer-stream))
 	(port (port medium)))
-    (format printer-stream "%!PS-Adobe-2.0 EPSF-2.0~%")
-    (multiple-value-bind (left top right bottom)
-	(postscript-bounding-box-edges (medium-sheet medium))
-      (format printer-stream "%%BoundingBox: ~D ~D ~D ~D~%"
-	(float left) (float top) (float right) (float bottom)))
-    (format printer-stream "%%Creator: CLIM 2.0~%")
-    (let ((title (getf header-comments :title)))
-      (when title
-        (format printer-stream "%%Title: ~A~%" title)))
-    (let ((for (or (getf header-comments :for) #+Genera zl:user-id)))
-      (when for
-        (format printer-stream "%%For: ~A~%" for)))
-    
-    (multiple-value-bind (second minute hour date month year)
-	(decode-universal-time (get-universal-time))
-      (format printer-stream "%%CreationDate: ~D-~A-~D ~2,'0D:~2,'0D:~2,'0D~%"
-	date (svref #("Jan" "Feb" "Mar" "Apr" "May" "Jun"
-		      "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") (1- month)) year
-	hour minute second))
-    (format printer-stream "%%DocumentFonts: (atend)~%")
-    (format printer-stream "%%EndComments~%")
-    (format printer-stream *postscript-prologue* (length (slot-value (port medium) 'font-map)))
-    (with-slots (page-indent page-height page-width device-units-per-inch) 
+    (with-slots (page-indent page-height page-width device-units-per-inch)
 	port
       (flet ((device-units (x)
-	       (float (* x device-units-per-inch))))
+	       (float (* x device-units-per-inch)))
+	     (scale (x)
+	       (* x scale-factor)))
+
+	(format printer-stream "%!PS-Adobe-2.0 EPSF-2.0~%")
+
+	(multiple-value-bind (left top right bottom)
+	    (postscript-bounding-box-edges (medium-sheet medium))
+	  (let (llx lly urx ury)
+	    (ecase orientation
+	      (:portrait
+	       (let ((dx (device-units page-indent))
+		     (dy (device-units (+ page-indent page-height))))
+		 (setq llx (+ dx (scale left)) lly (- dy (scale bottom))
+		       urx (+ dx (scale right)) ury (- dy (scale top)))))
+	      (:landscape
+	       (let ((dx (device-units (+ page-indent page-height)))
+		     (dy (device-units (+ page-indent page-width))))
+		 (setq llx (- dx (scale bottom)) lly (- dy (scale right))
+		       urx (- dx (scale top)) ury (- dy (scale left))))))
+	    (format printer-stream "%%BoundingBox: ~D ~D ~D ~D~%"
+		    llx lly urx ury)
+	    #+debug
+	    (format printer-stream
+		    "newpath ~D ~D moveto ~D ~D lineto stroke~%"
+		    llx lly urx ury)))
+
+	(format printer-stream "%%Creator: CLIM 2.0~%")
+	(let ((title (getf header-comments :title)))
+	  (when title
+	    (format printer-stream "%%Title: ~A~%" title)))
+	(let ((for (or (getf header-comments :for) #+Genera zl:user-id)))
+	  (when for
+	    (format printer-stream "%%For: ~A~%" for)))
+	(multiple-value-bind (second minute hour date month year)
+	    (decode-universal-time (get-universal-time))
+	  (format printer-stream "%%CreationDate: ~D-~A-~D ~2,'0D:~2,'0D:~2,'0D~%"
+		  date (svref #("Jan" "Feb" "Mar" "Apr" "May" "Jun"
+				"Jul" "Aug" "Sep" "Oct" "Nov" "Dec") (1- month)) year
+		  hour minute second))
+	(format printer-stream "%%DocumentFonts: (atend)~%")
+	(format printer-stream "%%EndComments~%")
+	(format printer-stream *postscript-prologue* (length (slot-value (port medium) 'font-map)))
 	(ecase orientation
 	  (:portrait
 	   (format printer-stream
@@ -548,10 +568,10 @@ end } def
 		   (device-units (+ page-indent page-height))))
 	  (:landscape
 	   (format printer-stream
-		   "/format-rotation -90 def ~%/format-translation {~D ~D} def~%" 
+		   "/format-rotation -90 def ~%/format-translation {~D ~D} def~%"
 		   (device-units (+ page-indent page-height))
 		   (device-units (+ page-indent page-width)))))))
-    (format printer-stream "/format-scale ~D def~%" (float (or scale-factor 1)))
+    (format printer-stream "/format-scale ~D def~%" (float scale-factor))
     (format printer-stream
         "/new-matrix {format-translation translate
 		      format-rotation rotate
@@ -593,7 +613,7 @@ end } def
   (assert (= bottom (1+ top)))
   (unless (zerop (rem right 8))
     (error "Sorry, can't hack right /= 0 (mod 8); you have ~D" right))
-  (with-stack-array (arr (array-total-size raster) 
+  (with-stack-array (arr (array-total-size raster)
 			 :element-type #+Genera '(unsigned-byte 8)
 				       #-Genera (array-element-type raster)
 			 :displaced-to raster)
@@ -618,7 +638,7 @@ end } def
 		 ((< index toprow))
 	      (repeat bytes-per-raster
 		(let ((byte (aref arr i)))
-		  (setf (aref buf j) 
+		  (setf (aref buf j)
 			(aref bigend-digit-char (ldb (byte 4 0) byte)))
 		  (setf (aref buf (1+ j))
 			(aref bigend-digit-char (ldb (byte 4 4) byte)))
@@ -637,7 +657,7 @@ end } def
       (error "Sorry, can't hack right - left /= 0 (mod 8); you have ; ~D,~D" right left))
     (let ((i left)
 	  (n-cells (/ 8 bits-per-cell)))
-      (loop 
+      (loop
 	(when (= i right) (return))
 	(let ((value 0))
 	  (dotimes (j n-cells)
@@ -750,7 +770,7 @@ end } def
 
 (defmethod make-palette ((port postscript-port) &key)
   (make-instance 'postscript-palette
-    :port port 
+    :port port
     :color-p t
     :dynamic-p nil))
 
@@ -762,14 +782,14 @@ end } def
   (with-slots (page-width page-height) port
     (with-slots (silica::mm-height silica::mm-width
 				   silica::pixel-height silica::pixel-width
-				   silica::pixels-per-point) 
+				   silica::pixels-per-point)
 	graft
       (setf silica::pixel-width    (* page-width 72)
 	    silica::pixel-height   (* page-height 72)
 	    silica::mm-width	   (* page-width 25.4)
 	    silica::mm-height      (* page-height 25.4)
 	    silica::pixels-per-point 1)
-      
+
       (setf (sheet-region graft)
 	(ecase (graft-units graft)
 	  (:device (make-rectangle* 0 0 silica::pixel-width silica::pixel-height))
@@ -815,7 +835,7 @@ end } def
 (defclass apple-laser-writer (postscript-port)
   ;; x-resolution and y-resolution should *never* appear in any
   ;; calculations - they have no relevance whatsoever as postscript is
-  ;; co-ordinates are given in user space *not* device space. 
+  ;; co-ordinates are given in user space *not* device space.
   ((x-resolution :initform 300)		;pixels per inch
    (y-resolution :initform 300)
    (page-indent :initform  0.5)		;in inches
@@ -848,7 +868,7 @@ end } def
    (device-transformation :accessor sheet-device-transformation
 			  :initform +identity-transformation+)
    (generating-postscript :initform t :accessor stream-generating-postscript))
-  (:default-initargs 
+  (:default-initargs
       :default-text-margin 1000
     :output-record (make-instance 'standard-sequence-output-history)))
 
@@ -943,11 +963,11 @@ end } def
 		      (incf viewport-y page-height))
 		  (setq viewport-x 0 viewport-y 0))))))))))
 
-(defmethod invoke-with-output-recording-options :before 
+(defmethod invoke-with-output-recording-options :before
 	   ((stream postscript-stream) continuation record draw)
   (declare (ignore record continuation))
   ;; See [clim2bug459]
-  (when (and draw 
+  (when (and draw
 	     (not (stream-drawing-p stream))
 	     (not (stream-generating-postscript stream)))
     (error "Cannot turning drawing on for postscript stream ~S" stream)))
@@ -993,7 +1013,7 @@ end } def
 	    (let ((record  (stream-output-history stream)))
 	      (when (or scale-to-fit multi-page)
 		(bounding-rectangle-set-position record 0 0))
-	      (multiple-value-bind (width height) 
+	      (multiple-value-bind (width height)
 		  (bounding-rectangle-size record)
 		(let* ((page-width
 			(floor (* (slot-value port 'page-width)
diff --git a/silica/db-border.lisp b/silica/db-border.lisp
index 23bccd8d..829122f2 100644
--- a/silica/db-border.lisp
+++ b/silica/db-border.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-border.lisp,v 1.20 93/04/16 09:45:18 cer Exp $
+;; $fiHeader: db-border.lisp,v 1.21 1993/07/27 01:50:23 colin Exp $
 
 "Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
  Portions copyright (c) 1991, 1992 by Symbolics, Inc.  All rights reserved."
@@ -23,7 +23,7 @@
 	(child (sheet-child pane)))
     (space-requirement+
       (compose-space child :width width :height height)
-      (make-space-requirement 
+      (make-space-requirement
 	:width (* 2 thickness)
 	:height (* 2 thickness)))))
 
@@ -34,17 +34,21 @@
       thickness thickness
       (- width (* 2 thickness)) (- height (* 2 thickness)))
     (repaint-border-pane pane)))
-  
+
 (defmethod handle-repaint ((pane border-pane) region)
   (declare (ignore region))		;not worth checking
   (repaint-border-pane pane))
 
 (defun repaint-border-pane (pane)
   (with-sheet-medium (medium pane)
-    (with-bounding-rectangle* (left top right bottom) 
+    (with-bounding-rectangle* (left top right bottom)
       (sheet-region pane)
       (let* ((thickness (slot-value pane 'thickness))
-	     (ht (ceiling thickness 2)))
+	     ;; this used to be ceiling but it sometimes caused
+	     ;; borders to overwrite the child pane - which played
+	     ;; havoc with the flipping-ink mechanism used to draw the
+	     ;; cursor (cim 9/14/95)
+	     (ht (floor thickness 2)))
 	(incf left ht)
 	(incf top ht)
 	(decf right ht)
@@ -94,10 +98,10 @@
 
 ;;; Label panes
 
-(defparameter *default-label-text-style* 
+(defparameter *default-label-text-style*
 	      (make-text-style :sans-serif :italic :small))
 
-(defclass label-pane 
+(defclass label-pane
 	  (sheet-with-resources-mixin
 	   labelled-gadget-mixin
 	   pane)
@@ -107,9 +111,9 @@
 		     ;; mechanism for the Motif/OpenLook ports
 		     :text-style nil))
 
-(defmacro labelling ((&rest options 
-		      &key (label-alignment #+Genera :bottom #-Genera :top) 
-		      &allow-other-keys) 
+(defmacro labelling ((&rest options
+		      &key (label-alignment #+Genera :bottom #-Genera :top)
+		      &allow-other-keys)
 		     &body contents &environment env)
   #-(or Genera Minima) (declare (ignore env))
   (assert (null (cdr contents)) (contents)
diff --git a/silica/db-layout.lisp b/silica/db-layout.lisp
index 3ba10563..f447ed7e 100644
--- a/silica/db-layout.lisp
+++ b/silica/db-layout.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-layout.lisp,v 1.35 1993/06/21 20:51:16 cer Exp $
+;; $fiHeader: db-layout.lisp,v 1.36 1993/07/22 15:38:51 cer Exp $
 
 (in-package :silica)
 
@@ -58,18 +58,18 @@
 (defmethod note-sheet-region-changed :after ((pane layout-mixin) &key port-did-it)
   (note-layout-mixin-region-changed pane :port port-did-it))
 
-(defmethod note-layout-mixin-region-changed ((pane layout-mixin) &key port)  
+(defmethod note-layout-mixin-region-changed ((pane layout-mixin) &key port)
   (declare (ignore port))
   (multiple-value-bind (width height) (bounding-rectangle-size pane)
     (allocate-space pane width height)))
 
 
-(defmacro changing-space-requirements ((&rest options &key resize-frame layout) 
+(defmacro changing-space-requirements ((&rest options &key resize-frame layout)
 				       &body body)
   (declare (ignore resize-frame layout))
   `(flet ((changing-space-requirements-body () ,@body))
      (declare (dynamic-extent #'changing-space-requirements-body))
-     (invoke-with-changing-space-requirements 
+     (invoke-with-changing-space-requirements
        #'changing-space-requirements-body ,@options)))
 
 (defmethod change-space-requirements-to ((pane layout-mixin) space-requirement)
@@ -77,7 +77,7 @@
 			height min-height max-height)
       (space-requirement-components space-requirement)
     (change-space-requirements pane
-      :width width :min-width min-width :max-width max-width 
+      :width width :min-width min-width :max-width max-width
       :height height :min-height min-height :max-height max-height)))
 
 
@@ -92,9 +92,9 @@
 
 (defun invoke-with-changing-space-requirements (continuation &key resize-frame (layout t))
   (declare (ignore resize-frame))   ;-- Why?
-  (let ((old-inside-changing-space-requirements 
+  (let ((old-inside-changing-space-requirements
 	  *inside-changing-space-requirements*)
-	(*inside-changing-space-requirements* 
+	(*inside-changing-space-requirements*
 	  (cons nil *inside-changing-space-requirements*)))
     (multiple-value-prog1
       (funcall continuation)
@@ -102,7 +102,7 @@
 	;; Layout that frames that need to be laid out and
 	;; re-layout the minimal subtrees that need to be laid out
 	(let* ((frames (remove-duplicates
-			 (remove-if-not 
+			 (remove-if-not
 			   #'(lambda (x) (application-frame-p x))
 			   *inside-changing-space-requirements*)))
 	       (panes (remove-if #'(lambda (x)
@@ -111,17 +111,17 @@
 				 *inside-changing-space-requirements*)))
 	  (mapc #'layout-frame frames)
 	  (dolist (pane panes)
-	    (unless (some #'(lambda (p) 
+	    (unless (some #'(lambda (p)
 			      (and (not (eq p pane))
 				   (sheet-ancestor-p pane p)))
 			  panes)
 	      ;; do this because the change has occurred somewhere in
 	      ;; the tree
-	      (clear-space-requirement-caches-in-tree pane) 
-	      (multiple-value-call #'allocate-space 
+	      (clear-space-requirement-caches-in-tree pane)
+	      (multiple-value-call #'allocate-space
 	        pane (bounding-rectangle-size pane)))))))))
 
-(defmethod change-space-requirements :around ((pane layout-mixin) 
+(defmethod change-space-requirements :around ((pane layout-mixin)
 					      &key resize-frame &allow-other-keys)
   (call-next-method)
   (let ((frame (pane-frame pane)))
@@ -153,7 +153,7 @@
 ;; The "spread" version of the above...
 (defun space-requirement+* (sr &key (width 0) (max-width width) (min-width width)
 				    (height 0) (max-height height) (min-height height))
-  (multiple-value-bind (srwidth  srmin-width  srmax-width 
+  (multiple-value-bind (srwidth  srmin-width  srmax-width
 			srheight srmin-height srmax-height)
       (space-requirement-components sr)
     (make-space-requirement
@@ -188,13 +188,13 @@
 
 ;;;
 ;;; Space Req Mixin
-;;; 
+;;;
 
 (defclass basic-space-requirement-mixin (layout-mixin)
     ((initial-space-requirement :reader pane-initial-space-requirements)
      (space-requirement :reader pane-space-requirements)))
 
-(defmethod initialize-instance :after ((pane basic-space-requirement-mixin) 
+(defmethod initialize-instance :after ((pane basic-space-requirement-mixin)
 				       &rest args
 				       &key width max-width min-width
 					    height max-height min-height)
@@ -206,7 +206,7 @@
 			  height min-height max-height)
 	(apply #'default-space-requirements pane :allow-other-keys t args)
       (let ((sr (make-space-requirement
-		  :width width :min-width min-width :max-width max-width 
+		  :width width :min-width min-width :max-width max-width
 		  :height height :min-height min-height :max-height max-height)))
 	;; Space requirements are immutable...
 	(setf space-requirement sr
@@ -216,7 +216,7 @@
   (when (pane-initial-space-requirements pane)
     (change-space-requirements-to pane (pane-initial-space-requirements pane))))
 
-(defmethod default-space-requirements ((pane basic-space-requirement-mixin) 
+(defmethod default-space-requirements ((pane basic-space-requirement-mixin)
 				       &key (width 0)
 					    (min-width width)
 					    (max-width width)
@@ -226,16 +226,16 @@
   (values width  min-width  max-width
 	  height min-height max-height))
 
-(defmethod change-space-requirements ((pane basic-space-requirement-mixin) 
+(defmethod change-space-requirements ((pane basic-space-requirement-mixin)
 				      &key width min-width max-width
 					   height min-height max-height
 					   resize-frame)
   (declare (ignore resize-frame))
   (with-slots (space-requirement) pane
-    (multiple-value-bind (srwidth  srmin-width  srmax-width 
+    (multiple-value-bind (srwidth  srmin-width  srmax-width
 			  srheight srmin-height srmax-height)
 	(space-requirement-components space-requirement)
-      (setq space-requirement (make-space-requirement 
+      (setq space-requirement (make-space-requirement
 				:width (or width srwidth)
 				:min-width (or min-width srmin-width)
 				:max-width (or max-width srmax-width)
@@ -261,7 +261,7 @@
 (defclass client-overridability-mixin (basic-space-requirement-mixin)
     ())
 
-(defmethod default-space-requirements ((pane client-overridability-mixin) 
+(defmethod default-space-requirements ((pane client-overridability-mixin)
 				       &key width min-width max-width height min-height max-height)
   (values width  min-width  max-width
 	  height min-height max-height))
@@ -272,7 +272,7 @@
 (defmethod compose-space :around ((pane client-overridability-mixin) &key width height)
   (declare (ignore width height))
   (with-slots (space-requirement) pane
-    (multiple-value-bind (width1 min-width1 max-width1 height1 min-height1 max-height1) 
+    (multiple-value-bind (width1 min-width1 max-width1 height1 min-height1 max-height1)
 	(space-requirement-components (normalize-space-requirement pane space-requirement))
       (multiple-value-bind (width2 min-width2 max-width2 height2 min-height2 max-height2)
 	  (space-requirement-components (call-next-method))
@@ -289,7 +289,63 @@
 	     :height height
 	     :min-height (or (mmin min-height1 height1 min-height2) height)
 	     :max-height (or (mmax max-height1 height1 max-height2) height))))))))
-;;;
+
+;; A more correct version. This was implemented to make :max-height
+;; override the :visible-items in list-panes. This is "more correct"
+;; than the above definition in that it ensures that as long as the
+;; original space requirement is well formed (ie min<=desired<=max)
+;; then the result space requirement is well formed. Unfortunately
+;; this breaks other code which relies in certain circumstances that
+;; desired>max. In other words the whole thing is a complete mess and
+;; I give up (cim 8/31/95)
+
+#+ignore
+(defmethod compose-space :around ((pane client-overridability-mixin) &key width height)
+  (declare (ignore width height))
+  (with-slots (space-requirement) pane
+    (multiple-value-bind (width1 min-width1 max-width1 height1 min-height1 max-height1)
+	(space-requirement-components (normalize-space-requirement pane space-requirement))
+      (multiple-value-bind (width2 min-width2 max-width2 height2 min-height2 max-height2)
+	  (space-requirement-components (call-next-method))
+
+	(macrolet ((nmin (arg &rest args)
+		     (if args
+			 (with-gensyms (a b)
+			   `(let ((,a ,arg)
+				  (,b (nmin ,@args)))
+			      (if ,a (if ,b (min ,a ,b) ,a) ,b)))
+		       arg))
+		   (nmax (arg &rest args)
+		     (if args
+			 (with-gensyms (a b)
+			   `(let ((,a ,arg)
+				  (,b (nmax ,@args)))
+			      (if ,a (if ,b (max ,a ,b) ,a) ,b)))
+		       arg)))
+	  (let* ((min-width (nmin (nmax min-width1 min-width2)
+				  width1
+				  max-width1))
+		 (max-width (nmax (nmin max-width1 max-width2)
+				  width1
+				  min-width1))
+		 (width (or width1
+			    (and width2
+				 (nmin max-width
+				       (nmax min-width width2)))))
+		 (min-height (nmin (nmax min-height1 min-height2)
+				   height1
+				   max-height1))
+		 (max-height (nmax (nmin max-height1 max-height2)
+				   height1
+				   min-height1))
+		 (height (or height1
+			     (and height2
+				  (nmin max-height
+					(nmax min-height height2))))))
+	    (make-space-requirement
+	     :width width :min-width min-width :max-width max-width
+	     :height height :min-height min-height :max-height max-height)))))))
+
 ;;; Space Req Cache
 ;;;
 
@@ -321,7 +377,7 @@
   (clear-space-requirement-cache pane))
 
 (defun clear-space-requirement-caches-in-tree (sheet)
-  (map-over-sheets #'(lambda (sheet) 
+  (map-over-sheets #'(lambda (sheet)
 		       (clear-space-requirement-cache sheet))
 		   sheet))
 
@@ -336,7 +392,7 @@
 
 (defclass wrapping-space-mixin (layout-mixin)
     ())
-	 
+
 (defmethod allocate-space ((pane wrapping-space-mixin) width height)
   (resize-sheet (sheet-child pane) width height))
 
@@ -405,8 +461,8 @@
       (let ((fills (count :fill sizes))
 	    (leftover (- given allocated)))
 	(when (> fills 0)
-	  (let ((x (if (> leftover 0) 
-		       (fix-coordinate (/ leftover fills)) 
+	  (let ((x (if (> leftover 0)
+		       (fix-coordinate (/ leftover fills))
 		       0)))
 	    (setf sizes (nsubstitute x :fill sizes)))))
       (nreverse sizes))))
diff --git a/silica/db-scroll.lisp b/silica/db-scroll.lisp
index 16a479c1..051d2e98 100644
--- a/silica/db-scroll.lisp
+++ b/silica/db-scroll.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-scroll.lisp,v 1.51 1993/11/23 19:58:50 cer Exp $
+;; $fiHeader: db-scroll.lisp,v 1.52 1994/12/05 00:00:14 colin Exp $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright(c) 1991, 1992 International Lisp Associates.
@@ -16,11 +16,11 @@
 			 pane)
     ((scroll-bars :initarg :scroll-bars
 		  :reader scroller-pane-scroll-bar-policy)
-     (drag-scroll :initarg :drag-scroll 
+     (drag-scroll :initarg :drag-scroll
 		  :accessor scroller-pane-drag-scroll)
      viewport
      (contents :initarg :contents :accessor pane-contents)
-     (vertical-scroll-bar :initform nil 
+     (vertical-scroll-bar :initform nil
 			  :accessor scroller-pane-vertical-scroll-bar)
      (horizontal-scroll-bar :initform nil
 			    :accessor scroller-pane-horizontal-scroll-bar)
@@ -30,8 +30,14 @@
      (vertical-line-scroll-amount :initform nil
 				  :initarg
 				  :vertical-line-scroll-amount)
-     (horizontal-line-scroll-amount :initform nil 
-				    :initarg :horizontal-line-scroll-amount))
+     (horizontal-line-scroll-amount :initform nil
+				    :initarg
+				    :horizontal-line-scroll-amount)
+     (vertical-page-scroll-amount :initform nil
+				  :initarg
+				  :vertical-page-scroll-amount)
+     (horizontal-page-scroll-amount :initform nil
+				    :initarg :horizontal-page-scroll-amount))
     (:default-initargs :scroll-bars :both :drag-scroll t))
 
 ;; Returns the viewport of the pane, if there is one
@@ -90,10 +96,10 @@
 	  (compute-dynamic-scroll-bar-values scroller)
 	(update-dynamic-scroll-bars
 	  scroller changedp
-	  hscroll-bar hscroll-bar-enabled-p 
+	  hscroll-bar hscroll-bar-enabled-p
 	  vscroll-bar vscroll-bar-enabled-p t))
-      
-      (with-bounding-rectangle* (left top right bottom) 
+
+      (with-bounding-rectangle* (left top right bottom)
 	  (viewport-contents-extent viewport)
 	(with-bounding-rectangle* (vleft vtop vright vbottom)
 	    (viewport-viewport-region viewport)
@@ -105,12 +111,12 @@
 		 (horizontal-scroll-bar (scroller-pane-horizontal-scroll-bar scroller)))
 	    (when vertical-scroll-bar
 	      (update-scroll-bar vertical-scroll-bar
-				 top bottom 
+				 top bottom
 				 vtop vbottom
 				 :vertical))
 	    (when horizontal-scroll-bar
 	      (update-scroll-bar horizontal-scroll-bar
-				 left right 
+				 left right
 				 vleft vright
 				 :horizontal))))))))
 
@@ -149,7 +155,7 @@
 		       (min 1.0s0 (max 0.0s0
 				       (if (<= contents-range viewport-range)
 					   0.0
-					 (/ (float (- vmin min) 0.0s0) 
+					 (/ (float (- vmin min) 0.0s0)
 					    contents-range))))))))
 	(declare (type single-float pos size))
 	(unless (and current-size
@@ -160,20 +166,29 @@
 	  (let* ((line-scroll (line-scroll-amount (slot-value scroll-bar 'client)
 						  orientation
 						  nil))
-		 (line-scroll (if (zerop contents-range)
-				  0	;-- Who knows
-				(* range (/ line-scroll contents-range)))))
-	    (change-scroll-bar-values scroll-bar 
+		 (page-scroll (page-scroll-amount (slot-value scroll-bar 'client)
+						  orientation
+						  nil)))
+	    (change-scroll-bar-values scroll-bar
 				      :slider-size size
 				      :value pos
-				      :line-increment line-scroll)))))))
+				      :line-increment (if (zerop contents-range)
+							  0 ;-- Who knows
+							(* range (/ line-scroll
+								    contents-range)))
+				      :page-increment (if (> page-scroll 1)
+							  (if (zerop contents-range)
+							      0 ;-- Who knows
+							    (* range (/ page-scroll
+									contents-range)))
+							(* size page-scroll)))))))))
 
-(defmethod value-changed-callback 
+(defmethod value-changed-callback
     ((sheet scroll-bar) (client scroller-pane) id value)
   (scroll-bar-value-changed-callback sheet client id value
 				     (scroll-bar-size sheet)))
 
-(defmethod drag-callback 
+(defmethod drag-callback
     ((sheet scroll-bar) (client scroller-pane) id value)
   (when (scroller-pane-drag-scroll client)
       (scroll-bar-value-changed-callback sheet client id value
@@ -206,7 +221,7 @@
 			    (gadget-range sheet)))))
 	    (bounding-rectangle-min-y region))))
       ;;-- Yuck
-      (clim-internals::maybe-redraw-input-editor-stream 
+      (clim-internals::maybe-redraw-input-editor-stream
        contents (pane-viewport-region contents)))))
 
 (defmethod update-region ((sheet basic-sheet) nleft ntop nright nbottom &key no-repaint)
@@ -221,7 +236,7 @@
   (fix-coordinates x y)
   (let ((viewport (pane-viewport sheet)))
     (when viewport
-      (with-bounding-rectangle* (left top right bottom) 
+      (with-bounding-rectangle* (left top right bottom)
 	  (pane-viewport-region sheet)
 	;; Optimize this case, since the rest of this code can be
 	;; quite expensive, especially on servers that require COPY-AREA
@@ -231,7 +246,7 @@
 	  (setf (sheet-transformation sheet)
 	    (make-translation-transformation (- x) (- y)))
 	  (bounding-rectangle-set-position (viewport-viewport-region viewport) x y)
-	  (with-bounding-rectangle* (nleft ntop nright nbottom) 
+	  (with-bounding-rectangle* (nleft ntop nright nbottom)
 	      (pane-viewport-region sheet)
 	    ;; If we are scrolling programatically then this might
 	    ;; reveal more of the sheet than currently exists
@@ -241,7 +256,7 @@
 	    (if (ltrb-overlaps-ltrb-p left top right bottom nleft ntop nright nbottom)
 		(progn
 		  ;; Move the old stuff to the new position
-		  (window-shift-visible-region sheet 
+		  (window-shift-visible-region sheet
 					       left top right bottom
 					       nleft ntop nright nbottom)
 		  (let ((rectangles (ltrb-difference nleft ntop nright nbottom
@@ -308,5 +323,13 @@
 	 (:vertical (bounding-rectangle-height r))
 	 (:horizontal (bounding-rectangle-width r)))
        10)))
-  
 
+
+(defmethod page-scroll-amount ((pane scroller-pane) orientation direction)
+  (declare (ignore direction))
+  (or (with-slots (vertical-page-scroll-amount
+		   horizontal-page-scroll-amount) pane
+	(ecase orientation
+	  (:horizontal horizontal-page-scroll-amount)
+	  (:vertical vertical-page-scroll-amount)))
+      0.9))
diff --git a/silica/event.lisp b/silica/event.lisp
index 5094ee8d..3bdea016 100644
--- a/silica/event.lisp
+++ b/silica/event.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: event.lisp,v 1.38 1993/08/12 16:04:13 cer Exp $
+;; $fiHeader: event.lisp,v 1.39 1994/12/05 00:00:17 colin Exp $
 
 (in-package :silica)
 
@@ -95,7 +95,7 @@
 
 
 
-;;; Standard 
+;;; Standard
 
 (defclass standard-sheet-input-mixin (sheet-with-event-queue-mixin) ())
 
@@ -154,7 +154,7 @@
 	       child (untransform-region (sheet-transformation child) region)))))
     (declare (dynamic-extent #'repaint-sheet-1))
     (map-over-sheets-overlapping-region #'repaint-sheet-1 sheet region)))
-	     
+
 (defgeneric handle-repaint (sheet region))
 
 
@@ -271,9 +271,9 @@
 	      (return))
 	    (multiple-value-setq (new-x new-y)
 	      (map-sheet-position-to-parent sheet new-x new-y)))))
-      
+
       (let* ((v (port-trace-thing port))
-	     (exitted-a-window 
+	     (exitted-a-window
 	       (and (typep event 'pointer-exit-event)
 		    (not (eq (pointer-boundary-event-kind event) :inferior))))
 	     (entered-from-child
@@ -311,7 +311,7 @@
 			     (when (or (and (not mirrored-sheet-in-trace)
 					    (not (member sheet ancestors-of-mirrored-sheet)))
 				       (not (sheet-enabled-p sheet))
-				       (not (region-contains-position-p 
+				       (not (region-contains-position-p
 					      (sheet-region sheet) new-x new-y)))
 			       (return i))))
 			 0)))
@@ -353,7 +353,7 @@
 		(sheet (aref v (1- (fill-pointer v))))
 		child)
 	    (loop
-	      (unless (typep sheet 'sheet-parent-mixin) 
+	      (unless (typep sheet 'sheet-parent-mixin)
 		(return nil))
 	      (setq child (child-containing-position sheet new-x new-y))
 	      (unless child
@@ -402,7 +402,7 @@
 			:kind ,kind
 			:modifier-state modifiers
 			:pointer pointer)))))
-      ;; If we got an event for some mirrored child, go back to the 
+      ;; If we got an event for some mirrored child, go back to the
       ;; top level sheet.
       (unless (graftp (sheet-parent mirrored-sheet))
 	(do* ((sheet mirrored-sheet)
@@ -417,7 +417,7 @@
 	    (map-sheet-position-to-parent sheet new-x new-y))
 	  (setq sheet parent)))
       (let* ((v (port-trace-thing port))
-	     (exitted-a-window 
+	     (exitted-a-window
 	       (and (typep event 'pointer-exit-event)
 		    (not (eq (pointer-boundary-event-kind event) :inferior))))
 	     (entered-from-child
@@ -442,7 +442,7 @@
 				 (map-sheet-position-to-child (aref v i) new-x new-y)))
 			     (unless (or (and pos (<= i pos))
 					 (and (sheet-enabled-p (aref v i))
-					      (region-contains-position-p 
+					      (region-contains-position-p
 						(sheet-region (aref v i)) new-x new-y)))
 			       (return i))))
 			 0)))
@@ -481,7 +481,7 @@
 		(sheet (aref v (1- (fill-pointer v))))
 		child)
 	    (loop
-	      (unless (typep sheet 'sheet-parent-mixin) 
+	      (unless (typep sheet 'sheet-parent-mixin)
 		(return nil))
 	      (setq child (child-containing-position sheet new-x new-y))
 	      (unless child
@@ -504,12 +504,12 @@
 
 (defmethod distribute-event :before ((port basic-port) (event pointer-button-press-event))
   (let ((pointer (pointer-event-pointer event)))
-    (setf (pointer-button-state pointer) 
+    (setf (pointer-button-state pointer)
       (logior (pointer-button-state pointer) (pointer-event-button event)))))
 
 (defmethod distribute-event :before ((port basic-port) (event pointer-button-release-event))
   (let ((pointer (pointer-event-pointer event)))
-    (setf (pointer-button-state pointer) 
+    (setf (pointer-button-state pointer)
 	  (logandc2 (pointer-button-state pointer) (pointer-event-button event)))))
 
 ;;;
@@ -539,7 +539,7 @@
   (setf (port-keyboard-input-focus port) nil))
 
 (defmethod distribute-event-1 ((port basic-port) (event window-event))
-  (dispatch-event 
+  (dispatch-event
     (window-event-mirrored-sheet event)
     event))
 
@@ -547,11 +547,11 @@
   ;; Generate all the correct enter/exit events.
   (if (port-deep-mirroring port)
       (generate-deeply-mirrored-crossing-events port event)
-      (generate-crossing-events port event)))
+    (generate-crossing-events port event)))
 
 (defmethod distribute-event-1 :around ((port basic-port) (event pointer-event))
   (let ((sheet (port-grabbing-sheet port)))
-    (if sheet 
+    (if sheet
 	(let ((event-sheet (event-sheet event))
 	      (grab-sheet (sheet-mirrored-ancestor sheet)))
 	  ;; If the grabbing sheet is different from the sheet the
@@ -584,13 +584,13 @@
 		      (aref v (1- (fill-pointer v)))))))
     (dispatch-pointer-event-to-sheet port event sheet)))
 
-(defmethod dispatch-pointer-event-to-sheet :before 
+(defmethod dispatch-pointer-event-to-sheet :before
 	   ((port basic-port) (event pointer-button-press-event) sheet)
   (let ((button (pointer-event-button event)))
     (when (and (eq (port-input-focus-selection port) :click-to-select)
 	       (eq button +pointer-left-button+))
       (setf (port-keyboard-input-focus port) sheet))))
-  
+
 (defmethod dispatch-pointer-event-to-sheet ((port basic-port) (event event) sheet)
   (let ((event-type (class-name (class-of event)))
 	(x (pointer-event-native-x event))
@@ -668,18 +668,18 @@
   (handle-event (event-sheet event) event))
 
 (defun local-event-loop (sheet)
-  (loop 
+  (loop
     (process-event-locally sheet (event-read sheet))))
 
-(defun port-event-wait (port waiter 
+(defun port-event-wait (port waiter
 			&key (wait-reason #+Genera si:*whostate-awaiting-user-input*
 					  #-Genera "CLIM Input")
 			     timeout)
   (cond (*multiprocessing-p*
 	 (assert (and port (port-alive-p port)) () "The port is not alive")
-	 (process-wait-with-timeout wait-reason timeout waiter) 
+	 (process-wait-with-timeout wait-reason timeout waiter)
 	 (values))
-	(t 
+	(t
 	 ;; Single process, so run the event processing loop right here
 	 (process-next-event port
 			     :timeout timeout
@@ -708,15 +708,15 @@
        (defmethod initialize-event ((event ,event-class) &key ,@slot-names)
 	 ,@(mapcar #'(lambda (slot)
 		       (if (eq slot 'timestamp)
-			   `(setf (slot-value event ',slot) 
+			   `(setf (slot-value event ',slot)
 			      (or ,slot (atomic-incf *event-timestamp*)))
 			 `(setf (slot-value event ',slot) ,slot)))
 		   slot-names))
        (let ((old (assoc ',event-class *resourced-events*)))
 	 (unless old
-	   (setq *resourced-events* 
+	   (setq *resourced-events*
 	     (append *resourced-events*
-		     (list (list ',event-class ',resource-name 
+		     (list (list ',event-class ',resource-name
 				 ;; Allocates, misses, creates, deallocates
 				 #+meter-events ,@(list 0 0 0 0)))))))
        ;; When an event is in the event resource, we use the timestamp
diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp
index 1b46dd1d..65d9bed0 100644
--- a/silica/gadgets.lisp
+++ b/silica/gadgets.lisp
@@ -1,6 +1,6 @@
 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gadgets.lisp,v 1.59 1994/12/05 00:00:21 colin Exp $
+;; $fiHeader: gadgets.lisp,v 1.60 1995/05/17 19:49:07 colin Exp $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright (c) 1992 by Symbolics, Inc.  All rights reserved."
@@ -18,8 +18,8 @@
      (disarmed-callback :initarg :disarmed-callback :initform nil
 			:reader gadget-disarmed-callback)
      (active :initarg :active :accessor gadget-active-p)
-     (help-callback :initform nil 
-		    :initarg :help-callback 
+     (help-callback :initform nil
+		    :initarg :help-callback
 		    :accessor gadget-help-callback))
   (:default-initargs :active t))
 
@@ -55,25 +55,25 @@
   (unless (gadget-active-p gadget)
     (setf (gadget-active-p gadget) t)
     (note-gadget-activated (gadget-client gadget) gadget)))
- 
+
 (defmethod note-gadget-activated ((client t) (gadget basic-gadget))
   nil)
- 
+
 (defmethod deactivate-gadget ((gadget basic-gadget))
   (when (gadget-active-p gadget)
     (setf (gadget-active-p gadget) nil)
     (note-gadget-deactivated (gadget-client gadget) gadget)))
- 
+
 (defmethod note-gadget-deactivated ((client t) (gadget basic-gadget))
   nil)
 
 
 ;;; Value Gadgets
 
-(defclass value-gadget (basic-gadget) 
+(defclass value-gadget (basic-gadget)
   ((value
     :initarg :value :initform nil)	; no accessor defined - see below
-   (value-changed-callback 
+   (value-changed-callback
     :initarg :value-changed-callback :initform nil
     :reader gadget-value-changed-callback)))
 
@@ -98,7 +98,7 @@
     (value-changed-callback gadget
 			    (gadget-client gadget) (gadget-id gadget) value)))
 
-(defmethod value-changed-callback :around 
+(defmethod value-changed-callback :around
     ((gadget value-gadget) (client t) (id t) value)
   (setf (slot-value gadget 'value) value)
   (let ((callback (gadget-value-changed-callback gadget)))
@@ -115,7 +115,7 @@
 
 (defclass action-gadget (basic-gadget)
     ((activate-callback :initarg :activate-callback :initform nil
-			:reader gadget-activate-callback)))  
+			:reader gadget-activate-callback)))
 
 (defmethod activate-callback :around
     ((gadget action-gadget) (client t) (id t))
@@ -124,7 +124,7 @@
       (invoke-callback-function callback gadget))
     (call-next-method)))
 
-(defmethod activate-callback 
+(defmethod activate-callback
     ((gadget action-gadget) (client t) (id t))
   nil)
 
@@ -137,7 +137,7 @@
 			:reader gadget-focus-in-callback)))
 
 (defmethod focus-out-callback :around
-    ((gadget focus-gadget) (client t) (id t)) 
+    ((gadget focus-gadget) (client t) (id t))
   (let ((callback (gadget-focus-out-callback gadget)))
     (when callback
       (invoke-callback-function callback gadget))
@@ -148,13 +148,13 @@
   nil)
 
 (defmethod focus-in-callback :around
-    ((gadget focus-gadget) (client t) (id t)) 
+    ((gadget focus-gadget) (client t) (id t))
   (let ((callback (gadget-focus-in-callback gadget)))
     (when callback
       (invoke-callback-function callback gadget))
     (call-next-method)))
 
-(defmethod focus-in-callback 
+(defmethod focus-in-callback
     ((gadget focus-gadget) (client t) (id t))
   nil)
 
@@ -217,7 +217,7 @@
 
 ;;; The intent is that the real implementations inherit from these
 
-(defparameter *default-slider-label-text-style* 
+(defparameter *default-slider-label-text-style*
 	      (make-text-style :sans-serif :bold :small))
 (defparameter *default-slider-range-label-text-style*
 	      (make-text-style :sans-serif :bold :very-small))
@@ -229,7 +229,7 @@
 		    :reader slider-drag-callback)
      (decimal-places :initarg :decimal-places
 		     :reader slider-decimal-places)
-     (show-value-p :initarg :show-value-p 
+     (show-value-p :initarg :show-value-p
 		   :accessor gadget-show-value-p)
      (min-label :initarg :min-label)
      (max-label :initarg :max-label)
@@ -238,15 +238,18 @@
      (number-of-quanta :initarg :number-of-quanta)
      (editable-p :initarg :editable-p :accessor gadget-editable-p))
     (:default-initargs :value 0.0
+                       :decimal-places 0
                        :show-value-p nil
 		       :min-label nil
 		       :max-label nil
-		       :range-label-text-style *default-slider-range-label-text-style*
+		       :range-label-text-style
+		       #+allegro nil
+		       #-allegro *default-slider-range-label-text-style*
 		       :number-of-tick-marks 0
 		       :number-of-quanta nil
 		       :editable-p t))
 
-(defmethod initialize-instance :after ((pane slider) 
+(defmethod initialize-instance :after ((pane slider)
 				       &key (decimal-places 0 places-p)
 				       &allow-other-keys)
   (declare (ignore decimal-places))
@@ -288,30 +291,30 @@
 (defmethod (setf scroll-bar-size) :around (size (gadget scroll-bar))
   (assert (and (<= (+ size (gadget-value gadget))
 		   (gadget-max-value gadget))
-	       (> size 0)) 
+	       (> size 0))
       (size)
     "Scroll bar size ~A out of range" size)
   (call-next-method size gadget))
 
-(defmethod (setf gadget-value) :around 
+(defmethod (setf gadget-value) :around
 	   (value (gadget scroll-bar) &key invoke-callback)
   (declare (ignore invoke-callback))
   (assert (and (<= (+ value (scroll-bar-size gadget))
 		   (gadget-max-value gadget))
-	       (>= value (gadget-min-value gadget))) 
+	       (>= value (gadget-min-value gadget)))
       (value)
     "Scroll bar value ~A out of range" value)
   (call-next-method value gadget))
 
 ;;; Push-button
-(defclass push-button 
-	  (action-gadget labelled-gadget-mixin) 
+(defclass push-button
+	  (action-gadget labelled-gadget-mixin)
     ((show-as-default :initform nil :initarg :show-as-default
 		      :accessor push-button-show-as-default)))
 
 
 ;;; Toggle button
-(defclass toggle-button 
+(defclass toggle-button
 	  (value-gadget labelled-gadget-mixin)
     ((indicator-type :initarg :indicator-type :initform :some-of
 		     :type (member :some-of :one-of)
@@ -319,8 +322,8 @@
 
 
 ;;; Menu button
-(defclass menu-button 
-	  (value-gadget labelled-gadget-mixin) 
+(defclass menu-button
+	  (value-gadget labelled-gadget-mixin)
     ((indicator-type :initarg :indicator-type :initform :some-of
 		     :reader gadget-indicator-type)))
 
@@ -343,9 +346,9 @@
 	   (columns :initarg :columns :initform nil :accessor gadget-columns)))
 
 ;;; Radio box [exclusive-choice] .. [inclusive-choice]
-(defclass radio-box 
-	  (value-gadget row-column-gadget-mixin) 
-    ((selections :initform nil 
+(defclass radio-box
+	  (value-gadget row-column-gadget-mixin)
+    ((selections :initform nil
 		 :reader radio-box-selections)
      ;;--- think about this...
      (value :initform nil
@@ -368,7 +371,7 @@
     (assert (and frame framem) ()
       "There must be both a frame and frame manager active")
     (when current-selection
-      (assert (member current-selection choices :test #'equal) 
+      (assert (member current-selection choices :test #'equal)
 	  ()
 	"Radio box current-selection: ~S must be one of choices: ~S"
 	current-selection choices))
@@ -385,7 +388,7 @@
 	  (string
 	   ;; Create a button if the user supplied an abbreviation
 	   (let* ((value (equal current-selection choice))
-		  (button (make-pane 'toggle-button 
+		  (button (make-pane 'toggle-button
 				     :value value
 				     :label choice
 				     :indicator-type :one-of
@@ -397,7 +400,7 @@
 	       (setf (radio-box-current-selection rb) button)))))))
     (setf (slot-value rb 'selections) (nreverse selections))))
 
-(defmethod value-changed-callback :around 
+(defmethod value-changed-callback :around
 	   ((selection basic-gadget) (client radio-box) gadget-id value)
   (declare (ignore gadget-id))
   ;;--- The following comment is wrong.  Perhaps these should be :BEFORE
@@ -406,16 +409,16 @@
   ;; specified a callback function only :AROUNDs ever get executed.
   (when (eq value t)
     (setf (radio-box-current-selection client) selection)
-    (value-changed-callback 
+    (value-changed-callback
      client (gadget-client client) (gadget-id client) selection))
   (call-next-method))
 
 
 ;;; Check-box
 
-(defclass check-box 
-    (value-gadget row-column-gadget-mixin) 
-    ((selections :initform nil 
+(defclass check-box
+    (value-gadget row-column-gadget-mixin)
+    ((selections :initform nil
 		 :reader check-box-selections)
      ;;--- think about this...
      (value :initform nil
@@ -455,7 +458,7 @@
 	  (string
 	   ;; Create a button if the user supplied an abbreviation
 	   (let* ((value (member choice current-selection :test #'equal))
-		  (button (make-pane 'toggle-button 
+		  (button (make-pane 'toggle-button
 				     :value (and value t)
 				     :label choice
 				     :indicator-type :some-of
@@ -467,7 +470,7 @@
 	       (setf (car value) button)))))))
     (setf (slot-value cb 'selections) (nreverse selections))))
 
-(defmethod value-changed-callback :around 
+(defmethod value-changed-callback :around
 	   ((selection basic-gadget) (client check-box) gadget-id value)
   (declare (ignore gadget-id))
   (if (eq value t)
@@ -501,13 +504,13 @@
 	   (macrolet ((radio-box-current-selection (form)
 			(let ((button (gensym)))
 			  `(let ((,button ,form))
-			     (setq ,',current-selection 
+			     (setq ,',current-selection
 			       (append ,',current-selection (list ,button)))
 			     ,button)))
 		      (check-box-current-selection (form)
 			(let ((button (gensym)))
 			  `(let ((,button ,form))
-			     (setq ,',current-selection 
+			     (setq ,',current-selection
 			       (append ,',current-selection (list ,button)))
 			     ,button))))
 	     (let ((,choices (list ,@body)))
@@ -519,12 +522,14 @@
 
 ;;; Text edit
 ;;--- Do we want to specify a binding to commands?
-(defclass text-field 
-	  (value-gadget focus-gadget action-gadget) 
-    ((editable-p :initarg :editable-p :accessor gadget-editable-p))
+(defclass text-field
+	  (value-gadget focus-gadget action-gadget)
+  ((editable-p :initarg :editable-p :accessor gadget-editable-p)
+   (echo-character :initarg :echo-character :initform nil
+		   :reader text-field-echo-character))
   (:default-initargs :editable-p t))
 
-(defclass text-editor (text-field) 
+(defclass text-editor (text-field)
     ((ncolumns :initarg :ncolumns
 	       :accessor gadget-columns)
      (nlines :initarg :nlines
@@ -587,7 +592,7 @@
 	       (max-height (space-requirement-max-height sr))
 	       (desired-width (space-requirement-width sr))
 	       (desired-height (space-requirement-height sr)))
-	  (resize-sheet child 
+	  (resize-sheet child
 			(if (>= max-width +fill+)
 			    (max width desired-width)
 			  (max desired-width max-width))
@@ -607,7 +612,7 @@
 	  (let ((cw (- cright cleft))
 		(ch (- cbottom ctop)))
 	    (let ((x ox) (y oy))
-	      (when (and (< owidth cw) (<= cw width)) 
+	      (when (and (< owidth cw) (<= cw width))
 		(setq x cleft))
 	      (when (and (< oheight ch) (<= ch height))
 		(setq y ctop))
@@ -635,20 +640,20 @@
 
 (defmethod note-space-requirements-changed ((pane viewport) inner)
   (declare (ignore inner))
-  (allocate-space 
-    pane 
+  (allocate-space
+    pane
     (bounding-rectangle-width pane) (bounding-rectangle-height pane)))
 
 ;;--- Work on this
 #+++ignore
 (defmethod note-sheet-region-changed :around ((viewport viewport) &key port-did-it)
   (declare (ignore port-did-it))
-  (multiple-value-bind (changedp 
+  (multiple-value-bind (changedp
 			hscroll-bar hscroll-bar-enabled-p
 			vscroll-bar vscroll-bar-enabled-p)
       (compute-dynamic-scroll-bar-values viewport)
     (if changedp
- 	(update-dynamic-scroll-bars 
+ 	(update-dynamic-scroll-bars
 	  viewport changedp
 	  hscroll-bar hscroll-bar-enabled-p
 	  vscroll-bar vscroll-bar-enabled-p)
@@ -669,7 +674,7 @@
 ;      (let* ((contents (slot-value scroller 'contents))
 ; 	     (c-extent (viewport-contents-extent
 ;			 (pane-viewport contents))))
-; 	(multiple-value-bind (vx vy) 
+; 	(multiple-value-bind (vx vy)
 ;	    (window-viewport-position contents)
 ; 	  (window-set-viewport-position
 ;	    contents
@@ -693,10 +698,10 @@
 ;	 (vscroll-bar (scroller-pane-vertical-scroll-bar scroller))
 ;	 (scroll-bar-policy (scroller-pane-scroll-bar-policy scroller)))
 ;    (if (eq scroll-bar-policy :dynamic)
-;	(multiple-value-bind (vwidth vheight) 
+;	(multiple-value-bind (vwidth vheight)
 ;	    (bounding-rectangle-size scroller)
-;	  (multiple-value-bind (cwidth cheight) 
-;	      (bounding-rectangle-size 
+;	  (multiple-value-bind (cwidth cheight)
+;	      (bounding-rectangle-size
 ;		(viewport-contents-extent (slot-value scroller 'viewport)))
 ;	    (let ((ohenp (sheet-enabled-p hscroll-bar))
 ;		  (ovenp (sheet-enabled-p vscroll-bar))
@@ -738,7 +743,7 @@
 		     :test #'eql
 		     :value-key #'identity
 		     :name-key #'princ-to-string))
- 
+
 
 (defclass list-pane (set-gadget-mixin value-gadget)
     ;;--- Should this be :ONE-OF/:SOME-OF, as radio boxes are?
@@ -746,22 +751,38 @@
 	   :accessor list-pane-mode)
      (visible-items :initarg :visible-items :reader gadget-visible-items))
   (:default-initargs :mode :exclusive :visible-items nil))
- 
+
 (defun compute-list-pane-selected-items (sheet value)
-  (with-accessors ((items set-gadget-items)
-		   (value-key set-gadget-value-key)
+  (with-accessors ((value-key set-gadget-value-key)
 		   (test set-gadget-test)
 		   (mode list-pane-mode)
 		   (name-key set-gadget-name-key)) sheet
-    (ecase mode
-      (:exclusive
-	(let ((x (find value items :test test :key value-key)))
-	  (and x (list (funcall name-key x)))))
-      (:nonexclusive
-	(mapcar name-key
-		(remove-if-not #'(lambda (item)
-				   (member (funcall value-key item) value :test test))
-			       items))))))
+    (let* ((items (set-gadget-items sheet))
+	   (total-items (length items))
+	   (visible-items (or (gadget-visible-items sheet)
+			      ;; what's the best default to assume here
+			      1)))
+      (multiple-value-bind (selected-items m n)
+	  (ecase mode
+	    (:exclusive
+	     (let ((i (position value items :test test :key value-key)))
+	       (and i
+		    (values (list (elt items i)) i i))))
+	    (:nonexclusive
+	     (let (selected-items m n)
+	       (dotimes (i (length items))
+		 (let ((item (elt items i)))
+		   (when (member (funcall value-key item) value :test test)
+		     (push item selected-items)
+		     (setq m (if m (min m i) i)
+			   n (if n (max n i) i)))))
+	       (when selected-items
+		 (values (nreverse selected-items) m n)))))
+	(when selected-items
+	  (values (mapcar name-key selected-items)
+		  (max 0 (- n (1- visible-items)))
+		  (min m (max 0 (- total-items visible-items)))))))))
+
 
 (defun list-pane-selected-item-p (sheet item)
   (with-accessors ((items set-gadget-items)
@@ -777,7 +798,7 @@
 	(member (funcall value-key item) value :test test)))))
 
 
-(defclass option-pane (set-gadget-mixin 
+(defclass option-pane (set-gadget-mixin
 		       labelled-gadget-mixin
 		       value-gadget)
     ;;--- Should this be :ONE-OF/:SOME-OF, as radio boxes are?
@@ -789,11 +810,11 @@
 
 ;; Callbacks on widgets generate these events
 
-(defclass gadget-event (event) 
+(defclass gadget-event (event)
     ((gadget :initarg :gadget :reader event-sheet)))
 
 
-(defclass value-changed-gadget-event (gadget-event) 
+(defclass value-changed-gadget-event (gadget-event)
     ((value :initarg :value :reader event-value)))
 
 (defmethod handle-event ((gadget value-gadget) (event value-changed-gadget-event))
@@ -807,7 +828,7 @@
   (activate-callback gadget (gadget-client gadget) (gadget-id gadget)))
 
 
-(defclass drag-gadget-event (gadget-event) 
+(defclass drag-gadget-event (gadget-event)
     ((value :initarg :value :reader event-value)))
 
 (defmethod handle-event ((gadget value-gadget) (event drag-gadget-event))
@@ -825,6 +846,19 @@
 (defmethod handle-event ((gadget focus-gadget) (event focus-in-gadget-event))
   (focus-in-callback gadget (gadget-client gadget) (gadget-id gadget)))
 
+;; armed/disarmed events
+
+(defclass armed-gadget-event (gadget-event) ())
+
+(defmethod handle-event ((gadget basic-gadget) (event armed-gadget-event))
+  (armed-callback gadget (gadget-client gadget) (gadget-id gadget)))
+
+(defclass disarmed-gadget-event (gadget-event) ())
+
+(defmethod handle-event ((gadget basic-gadget) (event disarmed-gadget-event))
+  (disarmed-callback gadget (gadget-client gadget) (gadget-id gadget)))
+
+
 (defun move-focus-to-gadget (gadget)
   (port-move-focus-to-gadget (port gadget) gadget))
 
diff --git a/silica/port.lisp b/silica/port.lisp
index 21b31e39..cc48d8b7 100644
--- a/silica/port.lisp
+++ b/silica/port.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: port.lisp,v 1.32 1993/09/07 21:46:48 colin Exp $
+;; $fiHeader: port.lisp,v 1.33 1994/12/05 00:00:27 colin Exp $
 
 (in-package :silica)
 
@@ -29,7 +29,7 @@
 (defun find-port (&rest initargs &key (server-path *default-server-path*) &allow-other-keys)
   (declare (dynamic-extent initargs))
   (map-over-ports #'(lambda (port)
-		      (when (port-match port server-path) 
+		      (when (port-match port server-path)
 			(return-from find-port port))))
   (with-keywords-removed (initargs initargs '(:server-path))
     (apply #'make-port :server-path server-path initargs)))
@@ -53,7 +53,7 @@
   (defun reset-ports ()
     ;;--- Should this do more?
     (setq *ports* nil))
-  (push `(:eval reset-ports) excl::*restart-actions*))
+  (push `reset-ports excl::*restart-actions*))
 
 (defun port-match (port server-path)
   (equal (port-server-path port) server-path))
@@ -82,7 +82,7 @@
 (defmethod port-pointer ((port basic-port))
   (with-slots (pointer grafts) port
     (or pointer
-	(setq pointer (make-instance 'standard-pointer 
+	(setq pointer (make-instance 'standard-pointer
 			:graft (find-graft :port port)
 			:port port)))))
 
@@ -135,15 +135,15 @@
   (setq *ports* (delete port *ports*)))
 
 
-(define-event-class port-terminated (window-manager-event) 
+(define-event-class port-terminated (window-manager-event)
   ((condition :initarg :condition :reader port-terminated-condition)))
 
 (defmethod port-terminated ((port basic-port) condition)
-  ;;--- Should mark it as dead 
+  ;;--- Should mark it as dead
   (setq *ports* (delete port *ports*))
   (dolist (graft (port-grafts port))
     (dolist (sheet (sheet-children graft))
-      (queue-event sheet (make-instance 'port-terminated 
+      (queue-event sheet (make-instance 'port-terminated
 			   :condition condition
 			   :sheet sheet)))))
 
@@ -158,7 +158,7 @@
 (defgeneric graft-orientation (graft))
 (defgeneric graft-units (graft))
 
-(defclass standard-graft 
+(defclass standard-graft
 	  (mirrored-sheet-mixin
 	   sheet-multiple-child-mixin
 	   sheet-transformation-mixin
@@ -198,7 +198,7 @@
 		   port)
   (make-instance (port-graft-class port)
     :port port
-    :orientation orientation 
+    :orientation orientation
     :units units))
 
 (defgeneric realize-graft (port graft))
diff --git a/silica/sheet.lisp b/silica/sheet.lisp
index 864900de..46460bd9 100644
--- a/silica/sheet.lisp
+++ b/silica/sheet.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: sheet.lisp,v 1.38 1993/07/27 01:51:13 colin Exp $
+;; $fiHeader: sheet.lisp,v 1.39 1994/12/05 00:00:29 colin Exp $
 
 (in-package :silica)
 
@@ -82,7 +82,7 @@
     ((children :initform nil :accessor sheet-children)))
 
 (defmethod sheet-adopt-child ((sheet sheet-multiple-child-mixin) child)
-  (setf (sheet-children sheet) 
+  (setf (sheet-children sheet)
 	;; Preserve the order in which the sheets were adopted
 	;;--- This may have unwanted effects if the children overlap...
 	(nconc (sheet-children sheet) (list child)))
@@ -215,7 +215,7 @@
 	      (and (sheet-enabled-p child)
 		   (multiple-value-call #'ltrb-overlaps-ltrb-p
 		     (bounding-rectangle* child)
-		     (untransform-rectangle* 
+		     (untransform-rectangle*
 		       (sheet-transformation child) left top right bottom))))
 	  (sheet-children sheet)))))
 
@@ -244,11 +244,11 @@
 	  (when (and (sheet-enabled-p child)
 		     (multiple-value-call #'ltrb-overlaps-ltrb-p
 		       (bounding-rectangle* child)
-		       (untransform-rectangle* 
+		       (untransform-rectangle*
 			 (sheet-transformation child) left top right bottom)))
 	    (funcall function child))))))
 
-;;;; 
+;;;;
 
 (defclass sheet-identity-transformation-mixin () ())
 
@@ -256,7 +256,7 @@
   +identity-transformation+)
 
 (defclass sheet-transformation-mixin ()
-    ((transformation 
+    ((transformation
        :initarg :transformation :initform +identity-transformation+
        :accessor sheet-transformation)
      (cached-device-transformation :initform nil
@@ -312,14 +312,14 @@
 
 (defgeneric note-sheet-transformation-changed (sheet &key port-did-it))
 (defmethod note-sheet-transformation-changed ((sheet basic-sheet) &key port-did-it)
-  (declare (ignore port-did-it)) 
+  (declare (ignore port-did-it))
   nil)
 
 (defgeneric invalidate-cached-regions (sheet))
 
 (defmethod invalidate-cached-regions ((sheet basic-sheet)) nil)
 
-(defmethod invalidate-cached-regions ((sheet sheet-transformation-mixin)) 
+(defmethod invalidate-cached-regions ((sheet sheet-transformation-mixin))
   (let ((region (sheet-cached-device-region sheet)))
     (when region
       (if (eq region +nowhere+)			;it can happen...
@@ -339,7 +339,7 @@
 
 (defmethod invalidate-cached-transformations ((sheet basic-sheet)) nil)
 
-(defmethod invalidate-cached-transformations ((sheet sheet-transformation-mixin)) 
+(defmethod invalidate-cached-transformations ((sheet sheet-transformation-mixin))
   (let ((region (sheet-cached-device-region sheet)))
     (when region
       (if (eq region +nowhere+)			;it can happen...
@@ -351,7 +351,7 @@
   ;;--- In theory if this sheet has a mirror we don't need to do any more
   (unless (sheet-direct-mirror sheet)
     (mapc #'invalidate-cached-transformations (sheet-children sheet))))
- 
+
 ;;--- Check to see if the call to INVALIDATE-CACHED-REGIONS is really necessary.
 ;;--- CER thinks we do because regions depend on transformations.
 (defmethod note-sheet-transformation-changed :before ((sheet basic-sheet) &key port-did-it)
@@ -415,7 +415,7 @@
 
 (defmethod invalidate-cached-regions :before ((sheet sheet-with-medium-mixin))
   (let ((medium (sheet-medium sheet)))
-    (when medium 
+    (when medium
       (invalidate-cached-regions medium))))
 
 (defmethod invalidate-cached-transformations :before ((sheet sheet-with-medium-mixin))
@@ -463,7 +463,7 @@
 (defclass sheet-permanently-enabled-mixin () ()
   (:default-initargs :enabled t))
 
-(defmethod initialize-instance :after ((sheet sheet-permanently-enabled-mixin) 
+(defmethod initialize-instance :after ((sheet sheet-permanently-enabled-mixin)
 				       &key enabled)
   (setf (sheet-enabled-p sheet) enabled))
 
@@ -493,7 +493,7 @@
   (letf-globally (((port-grabbing-sheet port) sheet))
     (call-next-method)))
 
-(defmethod port-invoke-with-pointer-grabbed 
+(defmethod port-invoke-with-pointer-grabbed
 	   ((port basic-port) (sheet basic-sheet) continuation &key)
   (funcall continuation))
 
@@ -505,3 +505,11 @@
   (declare (ignore cursor))
   nil)
 
+(defmethod port-remove-all-pointer-grabs ((port basic-port))
+  nil)
+
+(defmethod port-remove-all-pointer-grabs :after ((port basic-port))
+  (setf (port-grabbing-sheet port) nil))
+
+
+
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 57615adb..905836dc 100644
--- a/test/test-suite.lisp
+++ b/test/test-suite.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: test-suite.lisp,v 1.75 1994/12/05 00:00:46 colin Exp $
+;; $fiHeader: test-suite.lisp,v 1.76 1995/05/17 19:49:18 colin Exp $
 
 (in-package :clim-user)
 
@@ -558,7 +558,7 @@ people, shall not perish from the earth.
 			  (return-from lookup-result (third result))))
 		      (or (equal region1 region2) :none)))))
       (formatting-table (stream :x-spacing "  ")
-	(abbreviated-regions-column-headings regions stream 'region-contains-region-p)
+	(abbreviated-regions-column-headings regions stream 'region-intersects-region-p)
 	(dolist (region1 regions)
 	  (formatting-row (stream)
 	    (formatting-cell (stream :align-x :right)
diff --git a/tk-silica/last.lisp b/tk-silica/last.lisp
index 1308c33c..f26af4a6 100644
--- a/tk-silica/last.lisp
+++ b/tk-silica/last.lisp
@@ -1,7 +1,7 @@
 ;; -*- mode: common-lisp; package: system -*-
 ;;
 ;;				-[Thu Apr 15 18:06:28 1993 by layer]-
-;; 
+;;
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
 ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
 ;;
@@ -20,18 +20,18 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: last.lisp,v 1.5 1993/09/17 19:06:58 cer Exp $
+;; $fiHeader: last.lisp,v 1.6 1994/12/05 00:01:46 colin Exp $
 
 
 (in-package :system)
 
 (defvar system::*devel* nil)
 
-(load-application 
+(load-application
  (load-patches
   "patch"
   (namestring
-   (merge-pathnames "update-clim-2.0"
+   (merge-pathnames ";update-clim;"
 		    excl::*library-pathname*)))
  :devel (locally (declare (special system::*devel*)) system::*devel*))
 
diff --git a/tk-silica/xm-frames.lisp b/tk-silica/xm-frames.lisp
index d551de54..088287e0 100644
--- a/tk-silica/xm-frames.lisp
+++ b/tk-silica/xm-frames.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-frames.lisp,v 1.67 1994/12/05 00:01:53 colin Exp $
+;; $fiHeader: xm-frames.lisp,v 1.68 1995/05/17 19:50:01 colin Exp $
 
 (in-package :xm-silica)
 
@@ -48,16 +48,19 @@
   ;;-- This is because the :resize-width/height are true
   ;;-- ManagedSetChanged allows the widget to be resized.
   ;;-- Conversely querygeoetry will return bogus results otherwise.
-  (frobulate-menubars frame))
+  (frobulate-mirrors frame))
 
 (defmethod note-frame-layout-changed ((frame-manager motif-frame-manager) (frame t))
-  (frobulate-menubars frame))
+  (frobulate-mirrors frame))
 
-(defun frobulate-menubars (frame)
+;; This gets around the problem with gadgets in different layouts
+;; coming up the wrong size when the layout changes (cim 9/28/95)
+
+(defun frobulate-mirrors (frame)
   (flet ((fix-sheet (sheet)
-	   (when (typep sheet 'motif-menu-bar)
-	     (update-mirror-region (port sheet) sheet))))
-    (declare (dynamic-extent #'fix-sheet))
+	   (when (or (typep sheet 'motif-menu-bar)
+		     (typep sheet 'clim-stream-pane))
+	     (invalidate-cached-transformations sheet))))
     (map-over-sheets #'fix-sheet (frame-top-level-sheet frame))))
 
 ;;; Definitions of the individual classes
@@ -165,8 +168,10 @@
 		 (tk::set-values mirror :menu-help-widget button))
 	       (unless flatp
 		 (set-button-mnemonic sheet button (getf options :mnemonic))
-		 (when keystroke
-		   (set-button-accelerator-from-keystroke sheet button keystroke))))
+		 (let ((accelerator-text (getf options :accelerator-text)))
+		   (when (or keystroke accelerator-text)
+		     (set-button-accelerator-from-keystroke
+		      sheet button keystroke accelerator-text)))))
 
 	     (make-command-button (parent menu keystroke item command-table)
 	       (let ((command-name (car (command-menu-item-value item)))
@@ -279,8 +284,10 @@
       (make-menu-for-command-table top-command-table mirror))
     mirror))
 
+;; get rid of get-accelerator-text and clean this function up!
+
 (defmethod set-button-accelerator-from-keystroke
-    ((menubar motif-menu-bar) button keystroke)
+    ((menubar motif-menu-bar) button keystroke accelerator-text)
   (when keystroke
     (let ((modifiers (cdr keystroke)))
       (record-accelerator menubar keystroke)
@@ -289,23 +296,29 @@
 	(dolist (modifier modifiers)
 	  (setq accel-text
 	    (concatenate 'string
-	      (ecase modifier
+	      (case modifier
+		(:shift "Shift+")
 		(:control "Ctrl+")
 		(:meta "Alt+")
 		(:super "Super+")
-		(:hyper "Hyper+"))
+		(:hyper "Hyper+")
+		(t ""))
 	      accel-text))
 	  (setq accel
 	    (concatenate 'string
-	      (ecase modifier
-		(:control "Ctrl")
-		(:meta "Mod1")
-		(:super "Mod2")
-		(:hyper "Mod3"))
+	      (case modifier
+		(:shift "Shift ")
+		(:control "Ctrl ")
+		(:meta "Mod1 ")
+		(:super "Mod2 ")
+		(:hyper "Mod3 ")
+		(t ""))
 	      accel)))
-	(tk::set-values button
-			:accelerator accel
-			:accelerator-text accel-text)))))
+	(tk::set-values button :accelerator accel)
+	(setq accelerator-text (or accelerator-text
+				   accel-text)))))
+  (when accelerator-text
+    (tk::set-values button :accelerator-text accelerator-text)))
 
 (defun display-motif-help (widget framem documentation)
   (frame-manager-notify-user
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index bd7dd65c..1ff4b678 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.87 1994/12/05 00:01:56 colin Exp $
+;; $fiHeader: xm-gadgets.lisp,v 1.88 1995/05/17 19:50:04 colin Exp $
 
 (in-package :xm-silica)
 
@@ -152,6 +152,21 @@
    (allocate-event 'activate-gadget-event
      :gadget sheet)))
 
+
+;;; Motif widgets that support armed/disarmed callbacks
+
+(defclass motif-arm-disarm-pane () ())
+
+(defmethod add-sheet-callbacks :after ((port motif-port) (sheet motif-arm-disarm-pane) (widget t))
+  (tk::add-callback widget
+                    :arm-callback
+                    'queue-armed-event
+                    sheet)
+  (tk::add-callback widget
+                    :disarm-callback
+                    'queue-disarmed-event
+                    sheet))
+
 ;;; Label
 
 (defclass motif-label-pane (label-pane xt-leaf-pane motif-labelled-gadget)
@@ -190,6 +205,7 @@
 
 (defclass motif-push-button (push-button
                              motif-action-pane
+			     motif-arm-disarm-pane
                              motif-labelled-gadget
                              xt-leaf-pane)
           ())
@@ -201,35 +217,6 @@
 						 (sheet motif-push-button))
   'tk::xm-push-button)
 
-(defmethod add-sheet-callbacks
-    ((port motif-port) (sheet t) (widget tk::xm-my-drawing-area))
-  (tk::add-callback widget
-                    :expose-callback
-                    'sheet-mirror-exposed-callback
-                    sheet)
-  (tk::add-callback widget
-		    :input-callback
-		    'sheet-mirror-input-callback
-		    sheet)
-  (tk::add-event-handler widget
-                         '(:enter-window
-                           :leave-window
-                           :pointer-motion-hint
-                           :pointer-motion
-                           :button1-motion
-                           :button2-motion
-                           :button3-motion
-                           :button4-motion
-                           :button5-motion
-                           :button-motion
-                           )
-                         1
-                         'sheet-mirror-event-handler
-                         sheet))
-
-
-;;-- This is identical to the method for label
-
 ;;; How we deal with the default button in bulletin boards...
 ;;;
 ;;; The problem is that as soon as motif sees a default button in a
@@ -255,8 +242,6 @@
 ;;;
 ;;; cim (8/29/94)
 
-
-
 (defun find-bulletin-board (widget)
   (and widget
        (if (typep widget 'tk::xm-bulletin-board)
@@ -290,7 +275,6 @@
       (when bb
 	(tk::set-values bb :default-button widget)))))
 
-
 (defmethod initialize-mirror :after ((port motif-port)
 				     parent
 				     parent-widget
@@ -299,6 +283,33 @@
   (declare (ignore parent parent-widget))
   (tk::set-values widget :default-button widget))
 
+;; drawing area
+
+(defmethod add-sheet-callbacks
+    ((port motif-port) (sheet t) (widget tk::xm-my-drawing-area))
+  (tk::add-callback widget
+                    :expose-callback
+                    'sheet-mirror-exposed-callback
+                    sheet)
+  (tk::add-callback widget
+		    :input-callback
+		    'sheet-mirror-input-callback
+		    sheet)
+  (tk::add-event-handler widget
+                         '(:enter-window
+                           :leave-window
+                           :pointer-motion-hint
+                           :pointer-motion
+                           :button1-motion
+                           :button2-motion
+                           :button3-motion
+                           :button4-motion
+                           :button5-motion
+                           :button-motion
+                           )
+                         1
+                         'sheet-mirror-event-handler
+                         sheet))
 
 
 ;;; range pane mixin
@@ -329,14 +340,13 @@
       (multiple-value-bind
           (smin smax) (gadget-range* gadget)
         (multiple-value-bind
-            (mmin mmax)
-            (tk::get-values mirror :minimum :maximum)
-          (with-no-value-changed-callbacks
-              (tk::set-values mirror
-                              :value
-			      (fix-coordinate
-                                      (compute-symmetric-value
-                                       smin smax nv mmin mmax)))))))))
+            (mmin mmax value)
+            (tk::get-values mirror :minimum :maximum :value)
+	  (let ((nv (fix-coordinate
+		     (compute-symmetric-value smin smax nv mmin mmax))))
+	    (unless (eql value nv)
+	      (with-no-value-changed-callbacks
+		  (tk::set-values mirror :value nv)))))))))
 
 ;;;
 
@@ -376,7 +386,32 @@
   (tk::add-callback widget
                     :drag-callback
                     'queue-drag-event
-                    sheet))
+                    sheet)
+  (tk::add-callback widget
+		    :value-changed-callback
+		    'quantize-slider-value
+		    sheet))
+
+(defun quantize-slider-value (widget sheet)
+  (when (slot-value sheet 'silica::number-of-quanta)
+    (multiple-value-bind (scale-multiple value mmax show-value)
+	(tk::get-values widget :scale-multiple :value :maximum :show-value)
+      (let ((nv (* scale-multiple (round value scale-multiple))))
+	;; this hack is to fix a bug in Motif where setting the value
+	;; of the slider will move the slider to the correct rounded
+	;; position but not the displayed value. This forces the value
+	;; to change so that the second set-values moves both the
+	;; slider and the displayed value (cim 9/19/95)
+	(when (and show-value (eql nv value))
+	  (tk::set-values widget :value (if (eql value mmax)
+					    (1- value)
+					  (1+ value))))
+	(tk::set-values widget :value nv)))))
+
+(defmethod (setf gadget-value) :after
+	   (nv (gadget motif-slider) &key invoke-callback)
+  (declare (ignore nv invoke-callback))
+  (quantize-slider-value (sheet-mirror gadget) gadget))
 
 (defmethod find-widget-class-and-name-for-sheet ((port motif-port)
 						 (parent t)
@@ -394,11 +429,12 @@
       (let ((mmin 0)
             (mmax 1000)
             (decimal-points 0)
-            (decimal-places (slider-decimal-places sheet)))
+            (decimal-places (slider-decimal-places sheet))
+	    (quanta (slot-value sheet 'silica::number-of-quanta)))
         (cond ((and (zerop decimal-places)
                     (typep smin '(signed-byte 32))
                     (typep smax '(signed-byte 32)))
-               (setq mmin smin mmax smax decimal-points 0))
+	       (setq mmin smin mmax smax decimal-points 0))
 	      ;; Real case
               (t
                (setq smin (float smin) smax (float smax))
@@ -407,6 +443,7 @@
                        mmax (fix-coordinate (* scaling smax))
                        decimal-points decimal-places))))
 
+
         (assert (and (typep mmin '(signed-byte 32))
                      (typep mmax '(signed-byte 32))))
 
@@ -415,11 +452,67 @@
 		(list :minimum mmin
 		      :maximum mmax
 		      :decimal-points decimal-points)
+		(and quanta
+		     (list :scale-multiple
+			   (max 1 (floor (- mmax mmin) quanta))))
 		(and value
 		     (list :value (fix-coordinate
 				   (compute-symmetric-value
 				    smin smax value mmin mmax)))))))))
 
+(defmethod realize-mirror :around ((port motif-port) (pane motif-slider))
+  (let* ((mirror (call-next-method))
+	 (scale-orientation (gadget-orientation pane))
+	 (ticks (slot-value pane 'silica::number-of-tick-marks))
+	 (min-label (slot-value pane 'silica::min-label))
+	 (max-label (slot-value pane 'silica::max-label))
+	 (initargs (remove-keywords
+		    (find-widget-resource-initargs-for-sheet port pane)
+		    '(:font-list)))
+	 (font-list (text-style-mapping
+		     port
+		     (or (slot-value pane 'silica::range-label-text-style)
+			 (sheet-text-style port pane))))
+	 (children nil)
+	 (tick-long-dimension (tk::font-height font-list))
+	 (tick-short-dimension 8)
+	 tick-orientation tick-width tick-height
+	 first-label second-label)
+    (case scale-orientation
+      (:vertical
+       (setq tick-orientation :horizontal
+	     tick-width tick-long-dimension
+	     tick-height tick-short-dimension
+	     first-label max-label second-label min-label))
+      (:horizontal
+       (setq tick-orientation :vertical
+	     tick-width tick-short-dimension
+	     tick-height tick-long-dimension
+	     first-label min-label second-label max-label)))
+    (when first-label
+      (push (apply #'make-instance 'tk::xm-label
+		   :parent mirror :managed nil
+		   :label-string first-label
+		   :font-list font-list
+		   initargs)
+	    children))
+    (dotimes (i ticks)
+      (push (apply #'make-instance 'tk::xm-separator
+		   :orientation tick-orientation
+		   :width tick-width :height tick-height
+		   :parent mirror :managed nil
+		   initargs)
+	    children))
+    (when second-label
+      (push (apply #'make-instance 'tk::xm-label
+		   :parent mirror :managed nil
+		   :label-string second-label
+		   :font-list font-list
+		   initargs)
+	    children))
+    (tk::manage-children children)
+    mirror))
+
 (defmethod (setf gadget-show-value-p) :after (nv (sheet motif-slider))
   (when (sheet-direct-mirror sheet)
     (tk::set-values (sheet-direct-mirror sheet) :show-value nv)))
@@ -435,17 +528,17 @@
       (sx sy swidth sheight)
       (tk::widget-best-geometry (sheet-direct-mirror m))
     (declare (ignore sx sy))
-    (let ((fudge 16))
+    (let ((fudge 64))
       (ecase (gadget-orientation m)
         (:vertical
          (make-space-requirement :width swidth
                                  :min-height fudge
-                                 :height (max (* 2 fudge) sheight)
+                                 :height (max fudge sheight)
                                  :max-height +fill+))
         (:horizontal
          (make-space-requirement :height sheight
                                  :min-width fudge
-                                 :width (max (* 2 fudge) swidth)
+                                 :width (max fudge swidth)
                                  :max-width +fill+))))))
 
 ;;; Scroll-Bar
@@ -478,15 +571,17 @@
 
 (defmethod change-scroll-bar-values ((sb motif-scroll-bar) &key
 							   slider-size
-							   value line-increment)
+							   value
+							   line-increment
+							   (page-increment slider-size))
   (let ((mirror (sheet-direct-mirror sb)))
     (when mirror
-      (multiple-value-bind
-	  (real-value real-size line-increment)
-	  (compute-new-scroll-bar-values sb value slider-size line-increment)
+      (multiple-value-bind (value slider-size line-increment page-increment)
+	  (compute-new-scroll-bar-values
+	   sb value slider-size line-increment page-increment)
 	(tk::set-values mirror
-			:increment line-increment :page-increment real-size
-			:slider-size real-size :value real-value)))))
+			:increment line-increment :page-increment page-increment
+			:slider-size slider-size :value value)))))
 
 (defmethod add-sheet-callbacks :after ((port motif-port) (sheet motif-scroll-bar) (widget t))
   (tk::add-callback widget
@@ -635,13 +730,21 @@
 
 ;;;; text field
 
+;; text-fields no longer inherit from motif-value pane because we have
+;; special value handling for password type entry fields. (cim 5/25/95)
+
 (defclass motif-text-field (motif-losing-focus-callback-pane
 			    motif-value-changed-callback-pane
-			    motif-value-pane
                             motif-action-pane
                             text-field
                             xt-leaf-pane)
-          ())
+  ())
+
+(defmethod text-field-echoed-value ((sheet motif-text-field) value)
+  (let ((echo-character (text-field-echo-character sheet)))
+    (if echo-character
+	(make-string (length value) :initial-element echo-character)
+      value)))
 
 (defmethod find-widget-class-and-name-for-sheet ((port motif-port)
 						 (parent t)
@@ -655,7 +758,8 @@
 		   (value gadget-value)) sheet
     (append (and (not editable) '(:cursor-position-visible nil))
 	    `(:editable ,editable)
-	    (and value `(:value ,value)))))
+	    (and value `(:value
+			 ,(text-field-echoed-value sheet value))))))
 
 (defmethod gadget-current-selection ((tf motif-text-field))
   (let ((m (sheet-direct-mirror tf)))
@@ -664,6 +768,44 @@
 	   (and (not (zerop x))
 		(ff:char*-to-string x))))))
 
+(defmethod (setf gadget-value) :after
+    (nv (gadget motif-text-field) &key invoke-callback)
+  (declare (ignore invoke-callback))
+  (let ((m (sheet-direct-mirror gadget))
+	(ev (text-field-echoed-value gadget nv)))
+    (when (and m (not (equal ev
+			     (tk::get-values m :value))))
+      (with-no-value-changed-callbacks
+          (tk::set-values m :value ev)))))
+
+(defmethod add-sheet-callbacks :after
+	   ((port motif-port) (sheet motif-text-field) (widget t))
+  (tk::add-callback widget
+		    :modify-verify-callback
+		    'text-field-modify-verify-callback
+		    sheet))
+
+(defmethod text-field-modify-verify-callback (widget callback-struct sheet)
+  (declare (ignore widget))
+  (unless *dont-invoke-callbacks*
+    (let* ((text-block (tk::xm-text-field-callback-struct-text callback-struct))
+	   (length (tk::xm-text-block-rec-length text-block))
+	   (ptr (tk::xm-text-block-rec-ptr text-block))
+	   (text (if (zerop length)
+		     ""
+		   (ff:char*-to-string ptr)))
+	   (start-pos (tk::xm-text-field-callback-struct-start-pos callback-struct))
+	   (end-pos (tk::xm-text-field-callback-struct-end-pos callback-struct)))
+      (with-slots (silica::value) sheet
+	(setf silica::value
+	  (concatenate
+	      'string
+	    (subseq silica::value 0 start-pos)
+	    text
+	    (subseq silica::value end-pos))))
+      (unless (zerop length)
+	(setf (tk::xm-text-block-rec-ptr text-block)
+	  (ff:string-to-char* (text-field-echoed-value sheet text)))))))
 
 
 ;;; New definitions to support specifying width and height in terms of
@@ -741,19 +883,6 @@
     (* 2 (+ margin highlight shadow))))
 
 
-#+ignore
-(defmethod add-sheet-callbacks :after
-	   ((port motif-port) (sheet motif-text-field) (widget t))
-  (tk::add-callback widget
-		    :modify-verify-callback
-		    'queue-modify-verify-event
-		    sheet))
-
-#+ignore
-(defmethod queue-modify-verify-event (widget doit sheet)
-  (format excl:*initial-terminal-io* "~&~s,~s,~s" widget doit sheet))
-
-
 
 ;;;
 
@@ -850,6 +979,7 @@
 
 (defclass motif-toggle-button (motif-labelled-gadget
                                motif-value-changed-callback-pane
+			       motif-arm-disarm-pane
                                toggle-button
                                xt-leaf-pane)
           ())
@@ -1207,36 +1337,37 @@
                    (mode list-pane-mode)
                    (visible-items gadget-visible-items)
                    (name-key set-gadget-name-key)) sheet
-    (let ((selected-items
-           (compute-list-pane-selected-items sheet value))
-	  (scroll-mode
-	   (let ((p (sheet-parent sheet)))
-	     (and (typep p 'motif-scroller-pane)
-		  (silica::scroller-pane-scroll-bar-policy p)))))
-      `(:list-size-policy
-	#-ignore
-	,(case scroll-mode
-	   (:vertical :variable)
-	   (t :constant))
-	#+ignore ;; this one required for buggy pre motif-1.2.4
-	,(case scroll-mode
-	   ((:horizontal t :both) :constant)
-	   (t :variable))
-	:scroll-bar-display-policy
-	,(case scroll-mode
-	   ((:horizontal :vertical t :both) :static)
-	   (t :as-needed)
-	   :as-needed)
-	,@(and selected-items
-	       `(:selected-item-count ,(length selected-items)
-				      :selected-items ,selected-items))
-	:selection-policy
-	,(ecase mode
-	   (:exclusive :browse-select)
-	   (:nonexclusive :multiple-select))
-	,@(and visible-items `(:visible-item-count ,visible-items))
-	:items ,(mapcar name-key items)
-	:item-count ,(length items)))))
+    (multiple-value-bind (selected-items m n)
+	(compute-list-pane-selected-items sheet value)
+      (let ((scroll-mode
+	     (let ((p (sheet-parent sheet)))
+	       (and (typep p 'motif-scroller-pane)
+		    (silica::scroller-pane-scroll-bar-policy p)))))
+	`(:list-size-policy
+	  #-ignore
+	  ,(case scroll-mode
+	     (:vertical :variable)
+	     (t :constant))
+	  #+ignore ;; this one required for buggy pre motif-1.2.4
+	  ,(case scroll-mode
+	     ((:horizontal t :both) :constant)
+	     (t :variable))
+	  :scroll-bar-display-policy
+	  ,(case scroll-mode
+	     ((:horizontal :vertical t :both) :static)
+	     (t :as-needed)
+	     :as-needed)
+	  ,@(and selected-items
+		 `(:selected-item-count ,(length selected-items)
+		   :selected-items ,selected-items
+		   :top-item-position ,(1+ (min m n))))
+	  :selection-policy
+	  ,(ecase mode
+	     (:exclusive :browse-select)
+	     (:nonexclusive :multiple-select))
+	  ,@(and visible-items `(:visible-item-count ,visible-items))
+	  :items ,(mapcar name-key items)
+	  :item-count ,(length items))))))
 
 (defmethod (setf set-gadget-items) :after (items (gadget motif-list-pane))
   ;;---- What should this do about selected items and the value etc etc
@@ -1286,13 +1417,18 @@
 (defmethod (setf gadget-value) :after
     (nv (l motif-list-pane) &key invoke-callback)
   (declare (ignore invoke-callback))
-  (when (sheet-direct-mirror l)
-    (let ((selected-items
-           (compute-list-pane-selected-items l nv)))
-      (with-no-value-changed-callbacks
-            (tk::set-values (sheet-direct-mirror l)
-                            :selected-item-count (length selected-items)
-                            :selected-items selected-items)))))
+  (let ((mirror (sheet-direct-mirror l)))
+    (when mirror
+      (multiple-value-bind (selected-items m n)
+	  (compute-list-pane-selected-items l nv)
+	(let ((position (tk::get-values mirror :top-item-position)))
+	  (with-no-value-changed-callbacks
+	      (tk::set-values mirror
+			      :top-item-position (if selected-items
+						     (1+ (min n (max m (1- position))))
+						   position)
+			      :selected-item-count (length selected-items)
+			      :selected-items selected-items)))))))
 
 ;;; Option buttons
 
@@ -1546,6 +1682,7 @@
 				  (name :select-file)
 				  directory
 				  pattern
+				  default
 				  background
 				  foreground
 				  text-style
@@ -1579,6 +1716,9 @@
       (when pattern
 	(tk::set-values dialog :pattern pattern))
 
+      (when default
+	(tk::set-values dialog :dir-spec default))
+
       (when directory-list-label
 	(tk::set-values dialog :dir-list-label-string
 			directory-list-label))
@@ -1970,6 +2110,16 @@
   (when (typep m 'xt::xt-root-class)
     (tk::set-values m :font-list (text-style-mapping port text-style))))
 
+(defmethod silica::port-set-pane-background ((port motif-port) pane m (ink color))
+  (when (typep m 'xt::xt-root-class)
+    (with-sheet-medium (medium pane)
+      ;; we save and restore the foreground because xm_change_color
+      ;; will recalculate the foreground as well as the shadow colors
+      ;; and we want the latter but not the former (cim 9/21/95)
+      (let ((fg (tk::get-values m :foreground)))
+	(tk::xm_change_color m (decode-color ink medium))
+	(tk::set-values m :foreground fg)))))
+
 (defmethod find-widget-resource-initargs-for-sheet :around
     ((port motif-port) (sheet t) &key text-style)
   (let ((initargs (call-next-method))
diff --git a/tk-silica/xm-silica.lisp b/tk-silica/xm-silica.lisp
index bbcb45fc..96c0d0ef 100644
--- a/tk-silica/xm-silica.lisp
+++ b/tk-silica/xm-silica.lisp
@@ -1,5 +1,5 @@
 ;; -*- mode: common-lisp; package: xm-silica -*-
-;; 
+;;
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca.  All rights reserved.
 ;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca.  All rights reserved.
 ;;
@@ -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.42 1993/12/07 05:34:27 colin Exp $
+;; $fiHeader: xm-silica.lisp,v 1.43 1994/12/05 00:02:00 colin Exp $
 
 (in-package :xm-silica)
 
@@ -75,7 +75,7 @@
 			       'clim-internals::menu-frame)
 			'(:override-redirect t))))
 	(call-next-method))
-    (values class `(:keyboard-focus-policy 
+    (values class `(:keyboard-focus-policy
 		    ,(ecase (port-input-focus-selection port)
 		       (:click-to-select :explicit)
 		       (:sheet-under-pointer :pointer))
@@ -95,7 +95,7 @@
   (my-drawing-area-query-geometry widget intended desired))
 
 (defun setup-mda ()
-  (tk::initializemydrawingareaquerygeometry 
+  (tk::initializemydrawingareaquerygeometry
    (ff:register-function 'my-drawing-area-query-geometry-stub)))
 
 (setup-mda)
@@ -120,7 +120,7 @@
 
       (when (and (logtest rm x11:cwheight) (logtest rm x11:cwwidth))
 	(return-from my-drawing-area-query-geometry tk::xt-geometry-yes))
-      
+
       (setf (tk::xt-widget-geometry-width desired) (fix-coordinate width)
 	    (tk::xt-widget-geometry-height desired) (fix-coordinate height)
 	    (tk::xt-widget-geometry-request-mode desired) (logior x11:cwwidth x11:cwheight)))
@@ -149,7 +149,7 @@
 	(with-slots (clim-internals::plist) cursor
 	  (setf (getf clim-internals::plist :input-widget) input-widget)
 	  (tk::add-callback input-widget
-			    :input-callback 
+			    :input-callback
 			    'sheet-mirror-input-callback
 			    sheet)
 	  (tk::add-event-handler input-widget
@@ -158,7 +158,15 @@
 				 'sheet-mirror-event-handler
 				 sheet))))))
 
-(defmethod port-note-cursor-change :after 
+(defmethod note-sheet-degrafted :after ((sheet clim-stream-sheet))
+  (let* ((cursor (stream-text-cursor sheet))
+	 (plist (and cursor
+		     (slot-value cursor 'clim-internals::plist)))
+	 (input-widget (getf plist :input-widget)))
+    (when input-widget
+      (tk::destroy-widget input-widget))))
+
+(defmethod port-note-cursor-change :after
 	   ((port motif-port) cursor stream (type (eql 'cursor-active)) old new)
   (declare (ignore stream old))
   (let* ((plist (slot-value cursor 'clim-internals::plist))
diff --git a/tk-silica/xt-gadgets.lisp b/tk-silica/xt-gadgets.lisp
index 7becf1a3..4e5ce012 100644
--- a/tk-silica/xt-gadgets.lisp
+++ b/tk-silica/xt-gadgets.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-gadgets.lisp,v 1.40 1994/12/05 00:02:03 colin Exp $
+;; $fiHeader: xt-gadgets.lisp,v 1.41 1995/05/17 19:50:11 colin Exp $
 
 (in-package :xm-silica)
 
@@ -65,41 +65,30 @@
     (integer (make-device-color palette c))))
 
 (defmethod find-widget-resource-initargs-for-sheet
-    ((port xt-port) (sheet sheet-with-resources-mixin) &key)
-  (let ((background (pane-background sheet))
-	(foreground (pane-foreground sheet)))
+    ((port xt-port) (sheet sheet-with-resources-mixin)
+     &key background foreground)
+  (let ((bg (or background (pane-background sheet) *default-pane-background*))
+	(fg (or foreground (pane-foreground sheet) *default-pane-foreground*)))
     (with-sheet-medium (medium sheet)
       (let ((palette (medium-palette medium)))
-	`(,@(when background
+	`(,@(when bg
 	      (decode-gadget-background medium sheet
-					(ensure-color background palette)))
-	  ,@(when foreground
+					(ensure-color bg palette)))
+	  ,@(when fg
 	      (decode-gadget-foreground medium sheet
-					(ensure-color foreground palette))))))))
+					(ensure-color fg palette))))))))
 
 (defmethod find-widget-resource-initargs-for-sheet
-    ((port xt-port) (sheet t) &key)
+    ((port xt-port) (sheet t) &key background foreground)
   (let* ((resources (get-application-resources port))
-	 (background (or (getf resources :background) *default-pane-background*))
-	 (foreground (or (getf resources :foreground) *default-pane-foreground*))
+	 (bg (or background (getf resources :background) *default-pane-background*))
+	 (fg (or foreground (getf resources :foreground) *default-pane-foreground*))
 	 (palette (port-default-palette port)))
-    `(:background ,(decode-color-in-palette (ensure-color background palette)
+    `(:background ,(decode-color-in-palette (ensure-color bg palette)
 					    palette)
-      :foreground ,(decode-color-in-palette (ensure-color foreground palette)
+      :foreground ,(decode-color-in-palette (ensure-color fg palette)
 					    palette))))
 
-(defmethod find-widget-resource-initargs-for-sheet :around
-    ((port xt-port) (sheet t) &key foreground background)
-  (let ((initargs (call-next-method))
-	(palette (port-default-palette port)))
-    (when foreground
-      (setf (getf initargs :foreground)
-	(decode-color-in-palette (ensure-color foreground palette) palette)))
-    (when background
-      (setf (getf initargs :background)
-	(decode-color-in-palette (ensure-color background palette) palette)))
-    initargs))
-
 (defmethod decode-gadget-background (medium sheet ink)
   (declare (ignore sheet))
   (let ((pixel (decode-color ink medium)))
@@ -231,14 +220,17 @@
     (compute-symmetric-value
      0 1000 value smin smax )))
 
-(defun compute-new-scroll-bar-values (scroll-bar value slider-size line-increment)
+(defun compute-new-scroll-bar-values (scroll-bar value slider-size line-increment
+				      &optional (page-increment slider-size))
   (values
    (and value
 	(convert-scroll-bar-value-out scroll-bar value))
    (and slider-size
 	(max 1 (convert-scroll-bar-value-out scroll-bar slider-size)))
    (and line-increment
-	(max 1 (convert-scroll-bar-value-out scroll-bar line-increment)))))
+	(max 1 (convert-scroll-bar-value-out scroll-bar line-increment)))
+   (and page-increment
+	(max 1 (convert-scroll-bar-value-out scroll-bar page-increment)))))
 
 
 (defun wait-for-callback-invocation (port predicate &optional (whostate "Waiting for callback"))
@@ -339,14 +331,9 @@
   (let ((key (car keystroke)))
     (let ((x (assoc key *funny-accelerator-characters*
 		    :test #'member)))
-      (if x
-	  (values (if olit
-		      (format nil "<~A>"  (second x))
-		      (format nil "<Key>~A"  (second x)))
-		  (format nil "~A" key))
-	(values (if olit
-		    (format nil "<~A>" key)
-		  (format nil "<Key>~A" key))
-		(format nil "~A" key))))))
+      (values (format nil
+		      (if olit "<~A>" "<Key>~A")
+		      (if x (second x) key))
+	      (format nil "~:@(~A~)" key)))))
 
 
diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp
index 1a150b65..8873b3ad 100644
--- a/tk-silica/xt-graphics.lisp
+++ b/tk-silica/xt-graphics.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-graphics.lisp,v 1.85 1994/12/05 00:02:06 colin Exp $
+;; $fiHeader: xt-graphics.lisp,v 1.86 1995/05/17 19:50:15 colin Exp $
 
 (in-package :tk-silica)
 
@@ -72,6 +72,7 @@
 
 (defclass xt-medium (basic-medium)
   ((drawable :initform nil)
+   (palette :initform nil)
    ;; alist of (palette . ink-table) for non-current palettes
    (ink-tables :initform nil)
    (ink-table :initform nil)
@@ -91,6 +92,17 @@
 			sheet
 			(sheet-mirror sheet))))))
 
+(defmethod medium-palette ((medium xt-medium))
+  (with-slots (palette sheet) medium
+    (or palette
+	(setf palette
+	  (let ((frame (pane-frame sheet)))
+	    (if frame
+		(frame-palette frame)
+	      (port-default-palette (port medium))))))))
+
+
+
 ;;; Palette handling
 
 (defclass xt-palette (basic-palette)
@@ -119,12 +131,6 @@
       :white-pixel (x11:xwhitepixel display screen)
       :black-pixel (x11:xblackpixel display screen))))
 
-(defmethod medium-palette ((medium xt-medium))
-  (let ((frame (pane-frame (medium-sheet medium))))
-    (if frame
-	(frame-palette frame)
-      (port-default-palette (port medium)))))
-
 (defmethod update-medium-ink-table ((medium xt-medium))
   (let ((palette (medium-palette medium)))
     (with-slots (ink-table ink-tables) medium
@@ -147,6 +153,8 @@
 				     'silica::sheet-with-medium-mixin)
 			      (sheet-medium sheet))))
 	     (when medium
+	       ;; invalidate the medium's palette cache
+	       (setf (slot-value medium 'palette) nil)
 	       (update-medium-ink-table medium)
 	       (repaint-sheet sheet +everywhere+))))
        (frame-top-level-sheet frame)))))
@@ -349,8 +357,8 @@
 
 (defmethod deallocate-medium :after (port (medium xt-medium))
   (declare (ignore port))
-  (with-slots (drawable) medium
-    (setf drawable nil)))
+  (with-slots (drawable palette) medium
+    (setf drawable nil palette nil)))
 
 (defmethod fetch-medium-drawable (sheet (mirror tk::xt-root-class))
   (declare (ignore sheet))
@@ -369,9 +377,10 @@
 
 (defmethod degraft-medium :after ((medium xt-medium) (port xt-port) sheet)
   (declare (ignore sheet))
-  (with-slots (ink-table ink-tables indirect-inks drawable)
+  (with-slots (ink-table ink-tables indirect-inks drawable palette)
       medium
     (setf drawable nil
+	  palette nil
 	  indirect-inks nil
 	  (medium-sheet medium) nil)
     (dolist (entry ink-tables)
@@ -610,14 +619,46 @@
 (defmethod decode-ink-1 ((ink standard-opacity) (medium xt-medium))
   (decode-ink-opacity ink medium))
 
-(defmethod decode-ink-opacity (opacity (medium xt-medium))
+(defmethod decode-ink-1 ((ink composite-in) (medium xt-medium))
+  (let ((color +foreground-ink+)
+	(opacity nil)
+	(pattern nil))
+    (map nil
+      #'(lambda (ink)
+	  (typecase ink
+	    (opacity (setq opacity ink))
+	    (pattern (setq pattern ink))
+	    (t (setq color ink))))
+      (slot-value ink 'clim-utils::designs))
+    (cond
+     ;; compose-in of patterns we treat as stencils
+     (pattern
+      (multiple-value-bind (pixmap format pixels)
+	  (pixmap-from-pattern pattern medium :bitmap)
+	(declare (ignore format pixels))
+	(let* ((drawable (or (slot-value medium 'drawable)
+			     (tk::display-root-window
+			      (port-display (port (medium-sheet medium))))))
+	       (gc (make-instance 'ink-gcontext :drawable drawable)))
+	  (setf (tk::gcontext-stipple gc) pixmap
+		(tk::gcontext-fill-style gc) :stippled
+		(tk::gcontext-foreground gc) (decode-color color medium)
+		(tk::gcontext-background gc) 0)
+	  gc)))
+     (opacity
+      (decode-ink-opacity opacity medium color))
+     (t
+      (decode-ink-1 color medium)))))
+
+(defmethod decode-ink-opacity (opacity (medium xt-medium)
+			       &optional (color +foreground-ink+))
   (with-slots (sheet drawable)
       medium
     (let* ((port (port sheet))
 	   (display (port-display port))
 	   (drawable (or drawable (tk::display-root-window display)))
 	   (new-gc (make-instance 'ink-gcontext :drawable drawable)))
-      (setf (tk::gcontext-foreground new-gc) (decode-color +foreground-ink+ medium)
+      (setf (tk::gcontext-foreground new-gc) (decode-color color medium)
 	    (tk::gcontext-stipple new-gc) (decode-stipple (opacity-value opacity) port)
 	    (tk::gcontext-fill-style new-gc) :stippled)
       new-gc)))
@@ -893,7 +934,7 @@
 	layer-nplanes
 	(total-nplanes 0))
     (dolist (layer layers)
-      (let ((nplanes (floor (log layer 2))))
+      (let ((nplanes (ceiling (log layer 2))))
 	(push nplanes layer-nplanes)
 	(incf total-nplanes nplanes)))
     (multiple-value-bind (pixels masks)
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index 2473d0fc..39809a97 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.95 1994/12/05 00:02:12 colin Exp $
+;; $fiHeader: xt-silica.lisp,v 1.96 1995/05/17 19:50:21 colin Exp $
 
 (in-package :xm-silica)
 
@@ -196,18 +196,23 @@
        port (make-text-style :stand-in-for-undefined-style :roman 10)))
     (flet ((font->text-style (font family)
 	     (let* ((tokens (disassemble-x-font-name font))
-		    (italic (member (fifth tokens) '("i" "o") :test #'equalp))
-		    (bold (equalp (fourth tokens) "Bold"))
+		    (italic (member (nth 4 tokens) '("i" "o") :test #'equalp))
+		    (bold (equalp (nth 3 tokens) "bold"))
 		    (face (if italic
 			      (if bold '(:bold :italic) :italic)
 			    (if bold :bold :roman)))
-		    (designed-point-size (parse-integer (ninth tokens)))
-		    (designed-y-resolution (parse-integer (nth 10 tokens)))
-		    (point-size (* (float designed-point-size)
-				   (/ designed-y-resolution
-				      screen-pixels-per-inch)))
-		    (size (/ point-size 10)))
-	       (make-text-style family face size))))
+		    (pixel-size (parse-integer (nth 7 tokens)))
+		    (point-size (parse-integer (nth 8 tokens)))
+		    (y-resolution (parse-integer (nth 10 tokens)))
+		    (average-width (parse-integer (nth 12 tokens)))
+		    (corrected-point-size (* (float point-size)
+					     (/ y-resolution
+						screen-pixels-per-inch))))
+	       (unless (and (not *use-scalable-fonts*)
+			    (or (eql pixel-size 0)
+				(eql point-size 0)
+				(eql average-width 0)))
+		 (make-text-style family face (/ corrected-point-size 10))))))
       (dolist (family-stuff *xt-font-families*)
 	(let ((family (car family-stuff)))
 	  (dolist (font-pattern (cdr family-stuff))
@@ -217,9 +222,10 @@
 		(let ((text-style (font->text-style xfont family)))
 		  ;; prefer first font satisfying this text style, so
 		  ;; don't override if we've already defined one.
-		  (unless (text-style-mapping-exists-p
-			   port text-style *standard-character-set* t)
-		    (setf (text-style-mapping port text-style) xfont))))))
+		  (when text-style
+		    (unless (text-style-mapping-exists-p
+			     port text-style *standard-character-set* t)
+		      (setf (text-style-mapping port text-style) xfont)))))))
 	  ;; Now build the logical size alist for the family
 	  ))
       (let (temp)
@@ -1479,6 +1485,22 @@ the geometry of the children. Instead the parent has control. "))
      (allocate-event 'focus-in-gadget-event
 		     :gadget sheet))))
 
+(defmethod queue-armed-event (widget sheet)
+  (declare (ignore widget))
+  (unless *dont-invoke-callbacks*
+    (distribute-event
+     (port sheet)
+     (allocate-event 'armed-gadget-event
+		     :gadget sheet))))
+
+(defmethod queue-disarmed-event (widget sheet)
+  (declare (ignore widget))
+  (unless *dont-invoke-callbacks*
+    (distribute-event
+     (port sheet)
+     (allocate-event 'disarmed-gadget-event
+		     :gadget sheet))))
+
 (defmethod queue-drag-event (widget sheet &optional (value (gadget-value sheet)))
   (declare (ignore widget))
   (distribute-event
@@ -1581,26 +1603,27 @@ the geometry of the children. Instead the parent has control. "))
 					 (or (sheet-pointer-cursor sheet)
 					     :default)))
       (let ((ussp (slot-value sheet 'silica::user-specified-size-p))
-	    (uspp (slot-value sheet 'silica::user-specified-position-p)))
-	(unless (and (eq ussp :unspecified)
-		     (eq uspp :unspecified))
-	  (let ((size-hints (x11::xallocsizehints)))
-	    (tk::with-ref-par ((supplied 0))
-	      (when (zerop
-		     (x11::xgetwmnormalhints display window size-hints supplied))
-		(warn "top-level-sheet had no size hints?!")
-		(return-from enable-mirror))
-	      (let ((flags (x11::xsizehints-flags size-hints)))
-		(if* (and uspp (not (eq uspp :unspecified)))
-		   then (setf flags (logior flags x11::uspositionhint))
-		 elseif (null uspp)
-		   then (setf flags (logandc2 flags x11::uspositionhint)))
-		(if* (and ussp (not (eq ussp :unspecified)))
-		   then (setf flags (logior flags x11::ussizehint))
-		 elseif (null ussp)
-		   then (setf flags (logandc2 flags x11::ussizehint)))
-		(setf (x11::xsizehints-flags size-hints) flags))
-	      (x11::xsetwmnormalhints display window size-hints))))))
+	    (uspp (slot-value sheet 'silica::user-specified-position-p))
+	    (size-hints (x11::xallocsizehints)))
+	(tk::with-ref-par ((supplied 0))
+	  (when (zerop
+		 (x11::xgetwmnormalhints display window size-hints supplied))
+	    (warn "top-level-sheet had no size hints?!")
+	    (return-from enable-mirror))
+	  (let ((flags (x11::xsizehints-flags size-hints)))
+	    (if* (and uspp (not (eq uspp :unspecified)))
+	       then (setf flags (logior flags x11::uspositionhint))
+	     elseif (null uspp)
+	       then (setf flags (logandc2 flags x11::uspositionhint)))
+	    (if* (and ussp (not (eq ussp :unspecified)))
+	       then (setf flags (logior flags x11::ussizehint))
+	     elseif (null ussp)
+	       then (setf flags (logandc2 flags x11::ussizehint)))
+	    ;; always switch off program-specified position hint so
+	    ;; that OpenWindows cascading works
+	    (setf flags (logandc2 flags x11::ppositionhint))
+	    (setf (x11::xsizehints-flags size-hints) flags))
+	  (x11::xsetwmnormalhints display window size-hints))))
     (popup parent)))
 
 ;;; so is this next method ever called???? let's comment it out and
@@ -1742,20 +1765,22 @@ the geometry of the children. Instead the parent has control. "))
 		  (if (eq pixel 0) 0 1))))))
 
 
-	(let* ((drawable (tk::display-root-window
-			  (port-display port)))
+	(let* ((display (port-display port))
+	       (drawable (tk::display-root-window display))
 	       (depth 1)
 	       (pixmap-image (make-instance 'tk::image
-					    :width width
-					    :height height
-					    :data pixmap-data
-					    :depth depth))
+			       :display display
+			       :width width
+			       :height height
+			       :data pixmap-data
+			       :depth depth))
 	       (mask-image (and maskp
 				(make-instance 'tk::image
-					       :width width
-					       :height height
-					       :data mask-data
-					       :depth depth)))
+				  :display display
+				  :width width
+				  :height height
+				  :data mask-data
+				  :depth depth)))
 	       (pixmap
 		(make-instance 'tk::pixmap
 			       :drawable drawable
@@ -1780,7 +1805,7 @@ the geometry of the children. Instead the parent has control. "))
 	    (tk::destroy-image mask-image))
 	  (prog1
 	      (x11:xcreatepixmapcursor
-	       (port-display port)
+	       display
 	       pixmap
 	       (or mask 0)
 	       (multiple-value-bind (red green blue)
@@ -1832,6 +1857,9 @@ the geometry of the children. Instead the parent has control. "))
 	      (funcall continuation))))
       (tk::xt_ungrab_pointer widget 0))))
 
+(defmethod port-remove-all-pointer-grabs ((port xt-port))
+  (x11:xungrabpointer (port-display port) x11:currenttime))
+
 (defun xt-grabbed-event-mask ()
   (tk::encode-event-mask '(:enter-window
 			   :leave-window
diff --git a/tk/callbacks.lisp b/tk/callbacks.lisp
index ddac38bc..0c814f50 100644
--- a/tk/callbacks.lisp
+++ b/tk/callbacks.lisp
@@ -1,7 +1,7 @@
 ;; -*- 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.
 ;;
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: callbacks.lisp,v 1.22 92/12/03 10:29:59 cer Exp $
+;; $fiHeader: callbacks.lisp,v 1.23 1993/07/27 01:52:33 colin Exp $
 
 (in-package :tk)
 
@@ -78,7 +78,7 @@
     (funcall function widget)))
 
 
-(defvar *create-popup-child-proc-function-address* 
+(defvar *create-popup-child-proc-function-address*
     (ff:register-function 'create-popup-child-proc-function))
 
 (defun (setf widget-create-popup-child-proc) (function widget)
@@ -87,7 +87,7 @@
    (widget-callback-data widget))
   (set-values widget :create-popup-child-proc *create-popup-child-proc-function-address*)
   function)
-  
+
 (defun remove-all-callbacks (widget callback-name)
   (xt_remove_all_callbacks widget (convert-callback-name callback-name)))
 
@@ -102,51 +102,50 @@
 	  nil;; malloc cache
 	  type)))
 
-(defparameter *callback-name-alist* 
+(defparameter *callback-name-alist*
     (mapcar #'process-callback-alist-component
 	    '(
 	    ("activateCallback" :activate)
-	    ("armCallback")           
-	    ("disarmCallback")        
-	    ("popupCallback")         
-	    ("popdownCallback")       
-	    ("helpCallback")          
-	    ("decrementCallback")     
-	    ("dragCallback")          
-	    ("incrementCallback")     
-	    ("pageDecrementCallback") 
-	    ("pageIncrementCallback") 
-	    ("toBottomCallback")      
-	    ("toTopCallback")         
-	    ("focusCallback")         
-	    ("losingFocusCallback")   
-	    ("modifyVerifyCallback")  
+	    ("armCallback")
+	    ("disarmCallback")
+	    ("popupCallback")
+	    ("popdownCallback")
+	    ("helpCallback")
+	    ("decrementCallback")
+	    ("dragCallback")
+	    ("incrementCallback")
+	    ("pageDecrementCallback")
+	    ("pageIncrementCallback")
+	    ("toBottomCallback")
+	    ("toTopCallback")
+	    ("focusCallback")
+	    ("losingFocusCallback")
 	    ("modifyVerifyCallback" :modify-verify)
-	    ("valueChangedCallback")  
-	    ("noMatchCallback")       
-	    ("cancelCallback")        
-	    ("applyCallback")         
-	    ("okCallback")            
-	    ("browseSelectionCallback" :single-selection) 
-	    ("singleSelectionCallback" :single-selection) 
-	    ("defaultActionCallback")   
+	    ("valueChangedCallback")
+	    ("noMatchCallback")
+	    ("cancelCallback")
+	    ("applyCallback")
+	    ("okCallback")
+	    ("browseSelectionCallback" :single-selection)
+	    ("singleSelectionCallback" :single-selection)
+	    ("defaultActionCallback")
 	    ("extendedSelectionCallback")
 	    ("multipleSelectionCallback" :multiple-selection)
-	    ("entryCallback")           
-	    ("mapCallback")             
-	    ("unmapCallback")           
-	    ("cascadingCallback")       
-	    ("commandChangedCallback")  
-	    ("commandEnteredCallback")  
-	    ("exposeCallback" drawing-area)          
-	    ("inputCallback" drawing-area)           
-	    ("resizeCallback" drawing-area)          
-	    ("destroyCallback")         
-	    ("gainPrimaryCallback")     
+	    ("entryCallback")
+	    ("mapCallback")
+	    ("unmapCallback")
+	    ("cascadingCallback")
+	    ("commandChangedCallback")
+	    ("commandEnteredCallback")
+	    ("exposeCallback" drawing-area)
+	    ("inputCallback" drawing-area)
+	    ("resizeCallback" drawing-area)
+	    ("destroyCallback")
+	    ("gainPrimaryCallback")
 	    ("losePrimaryCallback")
 
 	    ;; Motif Callbacks
-	      
+
 	    ;; OpenLook Callbacks
 	    ("sliderMoved" slider-moved)
 	    ("select")
@@ -168,7 +167,7 @@
 
 (defmethod spread-callback-data (widget data (type (eql :modify-verify)))
   (declare (ignore widget))
-  (xm-text-field-callback-struct-doit data))
+  data)
 
 (defmethod spread-callback-data (widget call-data (type (eql 'drawing-area)))
   (declare (ignore widget))
diff --git a/tk/ol-init.lisp b/tk/ol-init.lisp
index f29ea953..dd46217e 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.20 1994/12/05 00:01:06 colin Exp $
+;; $fiHeader: ol-init.lisp,v 1.21 1995/05/17 19:49:32 colin Exp $
 
 (in-package :tk)
 
@@ -96,4 +96,4 @@
     (setup-error-handlers)
     (install-ol-error-handlers)
     (fixup-class-entry-points))
-  (push '(:eval reinitialize-toolkit) excl::*restart-actions*))
+  (push 'reinitialize-toolkit excl::*restart-actions*))
diff --git a/tk/resources.lisp b/tk/resources.lisp
index 00af2498..092e3554 100644
--- a/tk/resources.lisp
+++ b/tk/resources.lisp
@@ -1,7 +1,7 @@
 ;; -*- mode: common-lisp; package: tk -*-
 ;;
 ;;				-[Fri Jul 30 16:14:28 1993 by colin]-
-;; 
+;;
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
 ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA  All rights reserved.
 ;;
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: resources.lisp,v 1.50 1993/08/12 16:04:44 cer Exp $
+;; $fiHeader: resources.lisp,v 1.51 1994/12/05 00:01:09 colin Exp $
 
 
 (in-package :tk)
@@ -35,7 +35,7 @@
   `(defmethod convert-resource-in ((parent t) (type (eql ',type)) value)
      ,@body))
 
-  
+
 (defmacro define-enumerated-resource (type elements)
   (if (consp (car elements))
       `(progn
@@ -66,9 +66,9 @@
   (cerror "Try again" "cannot convert-in resource for ~S,~S,~S" class type value)
   (convert-resource-in class type value))
 
-(define-enumerated-resource separator-type (:no-line 
+(define-enumerated-resource separator-type (:no-line
 					    :single-line
-					    :double-line 
+					    :double-line
 					    :single-dashed-line
 					    :double-dashed-line
 					    :shadow-etched-in
@@ -91,14 +91,14 @@
 (define-enumerated-resource delete-response (:destroy :unmap :do-nothing))
 
 (define-enumerated-resource keyboard-focus-policy (:explicit :pointer))
-  
+
 (define-enumerated-resource packing (:no-packing
 				     :tight
 				     :column
 				     :none))
 
-(define-enumerated-resource row-column-type (:work-area 
-					     :menu-bar 
+(define-enumerated-resource row-column-type (:work-area
+					     :menu-bar
 					     :menu-pulldown
 					     :menu-popup
 					     :menu-option))
@@ -109,8 +109,8 @@
 
 (define-enumerated-resource scroll-bar-display-policy (:static :as-needed))
 
-(define-enumerated-resource selection-policy (:single-select 
-					      :multiple-select 
+(define-enumerated-resource selection-policy (:single-select
+					      :multiple-select
 					      :extended-select :browse-select))
 
 
@@ -279,7 +279,7 @@
   (declare (ignore parent))
   (or (second (find value *ol-defines* :key #'first))
       (call-next-method)))
-  
+
 
 
 
@@ -332,7 +332,7 @@
 	    (declare (optimize (safety 0)))
 	    (unless entry
 	      (setf entry (fill-sv-cache parent-class class resources)))
-    
+
 	    (destructuring-bind (arglist length &rest resource-descriptions)
 		entry
 	      (do ((resdess resource-descriptions (cdr resdess))
@@ -396,6 +396,7 @@
     (int nil)
     (short nil)
     (function nil)
+    (top-item-position nil)
     (t t)))
 
 (defmethod resource-type-set-conversion-p (type)
@@ -418,6 +419,7 @@
     (short nil)
     (int nil)
     (function nil)
+    (top-item-position nil)
     (t t)))
 
 (defmethod resource-type-get-memref-type (type)
@@ -447,7 +449,7 @@
 	 (constraint-resource-used nil)
 	 (i 0))
     (dotimes (j len)
-      (setf (xt-arglist-value arglist j) 
+      (setf (xt-arglist-value arglist j)
 	(excl::malloc 8)))	;--- A crock...
     (dolist (r resources)
       (let ((resource (or (find-class-resource class r)
@@ -472,7 +474,7 @@
 	      (note-malloced-object (xt-arglist-value arglist j)))
 	    r)
 	(setf (gethash resources (class-get-values-cache class)) r)))))
-    
+
 (defun get-values (widget &rest resources)
   (declare (optimize (speed 3))
 	   (dynamic-extent resources))
@@ -486,7 +488,7 @@
 	  (declare (optimize (safety 0)))
 	  (unless entry
 	    (setf entry (fill-gv-cache parent-class class resources)))
-    
+
 	  (destructuring-bind (arglist length &rest resource-descriptions)
 	      entry
 	    (xt_get_values widget arglist length)
@@ -608,7 +610,7 @@
 	     (incf *color-counter*)
 	     (color (allocate-color (default-colormap (widget-display parent))
 				    value))))
-			   
+
 (defmethod convert-resource-out ((parent t) (type (eql 'window)) x)
   x)
 
@@ -630,7 +632,7 @@
 (defmethod convert-resource-in ((widget t) (type (eql 'widget-list)) x)
   (let ((r nil))
     (dotimes (i (widget-num-children widget))
-      (push (convert-resource-in 
+      (push (convert-resource-in
 	     widget 'widget (xt-widget-list x i))
 	    r))
     (nreverse r)))
@@ -677,9 +679,9 @@
 
 (defmethod convert-resource-out ((parent t) (typep (eql 'pointer)) value)
   value)
-				 
 
-;;;			 
+
+;;;
 
 (defmethod convert-resource-out ((parent t) (typep (eql 'key-sym)) value)
   (char-int value))
@@ -693,7 +695,7 @@
 (defmethod convert-resource-in ((parent t) (typep (eql 'colormap)) value)
   value)
 
-;; Openlook 
+;; Openlook
 
 (defmethod convert-resource-out ((parent t) (typep (eql 'char)) value)
   (char-int value))
@@ -720,17 +722,17 @@
 
 (define-enumerated-resource list-size-policy (:variable :constant :resize-if-possible))
 
-(define-enumerated-resource shadow-type  ((:etched-in 5) 
-					  (:etched-out 6) 
+(define-enumerated-resource shadow-type  ((:etched-in 5)
+					  (:etched-out 6)
 					  (:in 7)
 					  (:out 8)))
 
-(define-enumerated-resource navigation-type (:none 
+(define-enumerated-resource navigation-type (:none
 					     :tab-group
 					     :sticky-tab-group
 					     :exclusive-tab-group))
 
-(define-enumerated-resource ol-wrap-mode  ((:wrap-off 74) 
+(define-enumerated-resource ol-wrap-mode  ((:wrap-off 74)
 					   (:wrap-any 75)
 					   (:wrap-white-space 76)))
 
@@ -738,7 +740,7 @@
 (defmethod convert-resource-out (parent (type (eql 'xt::translation-table)) value)
   (declare (ignore parent))
   ;;--- Allocate-no-free
-  (xt_parse_translation_table 
+  (xt_parse_translation_table
    (etypecase value
      (string value)
      (null ""))))
@@ -746,7 +748,7 @@
 ;; solaris 2.2 stuff
 
 (defmethod convert-resource-out ((parent  t) (type (eql 'ol-str)) value)
-  (note-malloced-object 
+  (note-malloced-object
    (string-to-char* value)))
 
 (defmethod convert-resource-in ((parent t) (type (eql 'ol-str)) value)
diff --git a/tk/xlib.lisp b/tk/xlib.lisp
index 6c75e398..8baf86cf 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.52 1994/12/05 00:01:14 colin Exp $
+;; $fiHeader: xlib.lisp,v 1.53 1995/05/17 19:49:36 colin Exp $
 
 (in-package :tk)
 
@@ -674,6 +674,7 @@
    (depth :reader image-depth :initarg :depth)
    (format :reader image-format :initform x11:zpixmap :initarg :format)))
 
+;; I don't believe that this should be hard-wired
 (defconstant bitmap-pad 8)
 
 (defmethod initialize-instance :after
@@ -681,10 +682,11 @@
   (declare (optimize (speed 3) (safety 0)))
   (with-slots (display format depth width height) image
     (unless foreign-address
-      (let* ((bits-per-line (* width depth))
+      (let* ((bits-per-pixel (x11:_xgetbitsperpixel display depth))
+	     (bits-per-line (* width bits-per-pixel))
 	     (padded-bits-per-line (* bitmap-pad
 				      (ceiling bits-per-line bitmap-pad)))
-	     (bytes-per-line (/ padded-bits-per-line bitmap-pad))
+	     (bytes-per-line (/ padded-bits-per-line 8))
 	     (v (excl::malloc (* bytes-per-line height)))
 	     (visual (x11:screen-root-visual
 		      (x11:xdefaultscreenofdisplay display)))
diff --git a/tk/xm-defs.lisp b/tk/xm-defs.lisp
index dd2ea58f..97d1b2bf 100644
--- a/tk/xm-defs.lisp
+++ b/tk/xm-defs.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-defs.lisp,v 1.9 1994/12/05 00:01:17 colin Exp $
+;; $fiHeader: xm-defs.lisp,v 1.11 1995/06/21 21:24:19 georgej Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -40,13 +40,24 @@
   (protocol * :char))
 
 (def-c-typedef xm-string :int)
+(def-c-typedef xm-text-position :long)
+
+(def-c-type (xm-text-block-rec :no-defuns) :struct
+	    (ptr * :char)
+	    (length :int)
+	    (format x11:atom))
+
+(def-c-typedef xm-text-block * xm-text-block-rec)
 
 (def-c-type (xm-text-field-callback-struct :no-defuns) :struct
 	    (reason :int)
 	    (event * x11:xevent)
-	    (doit :int)
-	    ;; and more later
-	    )
+	    (doit boolean)
+	    (curr-insert xm-text-position)
+	    (new-insert xm-text-position)
+	    (start-pos xm-text-position)
+	    (end-pos xm-text-position)
+	    (text xm-text-block))
 
 (def-c-type (xm-file-selection-box-callback-struct :no-defuns) :struct
 	    (reason :int)
@@ -74,4 +85,3 @@
 (def-c-type (xm-selected-position-array :no-defuns) 1 :int)
 
 (def-c-type (xm-string-table :no-defuns) 1 * :char)
-
diff --git a/tk/xm-funs.lisp b/tk/xm-funs.lisp
index 18bfd22f..d7be4ff6 100644
--- a/tk/xm-funs.lisp
+++ b/tk/xm-funs.lisp
@@ -1,7 +1,7 @@
 ;; -*- mode: common-lisp; package: tk -*-
 ;;
 ;;				-[Thu Jul 22 17:17:07 1993 by colin]-
-;; 
+;;
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
 ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
 ;;
@@ -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.14 1993/09/17 19:06:51 cer Exp $
+;; $fiHeader: xm-funs.lisp,v 1.15 1994/12/05 00:01:20 colin Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -105,7 +105,7 @@
     :arg-checking nil
     :return-type :void)
 
-(defforeign 'xm_intern_atom 
+(defforeign 'xm_intern_atom
     :entry-point (ff:convert-to-lang "XmInternAtom")
     :call-direct t
     :callback nil
@@ -248,9 +248,24 @@
     :entry-point (ff:convert-to-lang "XmTextGetSelection")
     :return-type :integer)
 
+(ff:defforeign 'xm_scale_set_value
+    :call-direct t
+    :arguments '(foreign-address fixnum)
+    :arg-checking nil
+    :entry-point (ff:convert-to-lang "XmScaleSetValue")
+    :return-type :void)
+
 (ff:defforeign 'xm_get_display
     :call-direct t
     :arguments '(foreign-address)
     :arg-checking nil
     :entry-point (ff:convert-to-lang "XmGetXmDisplay")
     :return-type :integer)
+
+(ff:defforeign 'xm_change_color
+    :call-direct t
+    :arguments '(foreign-address fixnum)
+    :arg-checking nil
+    :entry-point (ff:convert-to-lang "XmChangeColor")
+    :return-type :void)
+
diff --git a/tk/xm-init.lisp b/tk/xm-init.lisp
index 1550217a..80e36fa9 100644
--- a/tk/xm-init.lisp
+++ b/tk/xm-init.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-init.lisp,v 1.12 1994/12/05 00:01:22 colin Exp $
+;; $fiHeader: xm-init.lisp,v 1.14 1995/06/21 21:24:22 georgej Exp $
 
 (in-package :tk)
 
@@ -43,5 +43,5 @@
 
 #+dlfcn
 (unless sys::*toolkit-static*
-  (push '(:eval reinitialize-toolkit) excl::*restart-actions*))
+  (push 'reinitialize-toolkit excl::*restart-actions*))
 
diff --git a/tk/xt-defs.lisp b/tk/xt-defs.lisp
index 80dcfe2e..bcc0d1b8 100644
--- a/tk/xt-defs.lisp
+++ b/tk/xt-defs.lisp
@@ -1,7 +1,7 @@
 ;; -*- 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.
 ;;
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-defs.lisp,v 1.9 1993/07/27 01:54:16 colin Exp $
+;; $fiHeader: xt-defs.lisp,v 1.10 1994/12/05 00:01:26 colin Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -35,9 +35,9 @@
 (def-c-typedef resource-list * :char)
 (def-c-typedef xrm-quark :int)
 (def-c-typedef xrm-quark-list * :int)
-(def-c-typedef boolean :unsigned-long)
+(def-c-typedef boolean :char)
 (def-c-typedef xrm-class  xrm-quark)
-(def-c-typedef xt-enum   :long)
+(def-c-typedef xt-enum   :unsigned-char)
 (def-c-typedef xt-version-type :long)
 (def-c-typedef xt-geometry-mask :unsigned-int)
 (def-c-typedef xt-position :short)
@@ -85,7 +85,7 @@
   )
 
 ;; Horrible internal stuff
-    
+
 (def-c-type (xt-offset-rec :no-defuns) :struct
 	    (next * :char)
 	    (name xrm-quark)
diff --git a/tk/xt-funs.lisp b/tk/xt-funs.lisp
index 5ac4d746..256d3ce8 100644
--- a/tk/xt-funs.lisp
+++ b/tk/xt-funs.lisp
@@ -1,7 +1,7 @@
 ;; -*- mode: common-lisp; package: xt -*-
 ;;
 ;;				-[Thu Nov 10 19:28:13 1994 by smh]-
-;; 
+;;
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
 ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA  All rights reserved.
 ;;
@@ -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.24 1994/11/23 23:29:18 smh Exp $
+;; $fiHeader: xt-funs.lisp,v 1.25 1994/12/05 00:01:29 colin Exp $
 
 
 ;;
@@ -35,7 +35,7 @@
     :arguments '(foreign-address foreign-address foreign-address)
     :arg-checking nil
     :return-type :void)
-    
+
 (defforeign 'xt_get_constraint_resource_list
     :entry-point (ff:convert-to-lang "XtGetConstraintResourceList")
     :call-direct t
@@ -131,7 +131,7 @@
     :arg-checking nil
     :return-type :unsigned-integer)
 
-(defforeign 'xt_app_create_shell 
+(defforeign 'xt_app_create_shell
     :entry-point (ff:convert-to-lang "XtAppCreateShell")
     :call-direct t
     :arguments '(foreign-address foreign-address foreign-address foreign-address
@@ -139,7 +139,7 @@
     :arg-checking nil
     :return-type :unsigned-integer)
 
-;;;; 
+;;;;
 
 (defforeign 'xt_create_widget
     :entry-point (ff:convert-to-lang "XtCreateWidget")
@@ -148,8 +148,8 @@
 		 foreign-address fixnum)
     :arg-checking nil
     :return-type :unsigned-integer)
-    
-    
+
+
 (defforeign 'xt_create_managed_widget
     :entry-point (ff:convert-to-lang "XtCreateManagedWidget")
     :call-direct t
@@ -164,7 +164,7 @@
     :arguments '(foreign-address)
     :arg-checking nil
     :return-type :void)
-    
+
 (defforeign 'xt_is_realized
     :entry-point (ff:convert-to-lang "XtIsRealized")
     :call-direct t
@@ -192,7 +192,7 @@
     :arguments '(foreign-address)
     :arg-checking nil
     :return-type :fixnum)
-    
+
 (defforeign 'xt_unmanage_child
     :entry-point (ff:convert-to-lang "XtUnmanageChild")
     :call-direct t
@@ -221,7 +221,7 @@
     :arguments '(foreign-address foreign-address foreign-address foreign-address fixnum)
     :arg-checking nil
     :return-type :unsigned-integer)
-    
+
 (defforeign 'xt_popup
     :entry-point (ff:convert-to-lang "XtPopup")
     :call-direct t
@@ -235,14 +235,14 @@
     :arguments '(foreign-address)
     :arg-checking nil
     :return-type :void)
-    
+
 (defforeign 'xt_window
     :entry-point (ff:convert-to-lang "XtWindow")
     :call-direct t
     :arguments '(foreign-address)
     :arg-checking nil
     :return-type :unsigned-integer)
-    
+
 (defforeign 'xt_parent
     :entry-point (ff:convert-to-lang "XtParent")
     :call-direct t
@@ -330,7 +330,7 @@
     :arguments '(foreign-address integer fixnum foreign-address foreign-address)
     :arg-checking nil
     :return-type :void)
-    
+
 (defforeign 'xt_build_event_mask
     :entry-point (ff:convert-to-lang "XtBuildEventMask")
     :call-direct t
@@ -344,28 +344,28 @@
     :arguments '(foreign-address foreign-address foreign-address foreign-address)
     :arg-checking nil
     :return-type :void)
-    
+
 (defforeign 'xt_has_callbacks
     :entry-point (ff:convert-to-lang "XtHasCallbacks")
     :call-direct t
     :arguments '(foreign-address foreign-address)
     :arg-checking nil
     :return-type :unsigned-integer)
-    
+
 (defforeign 'xt_remove_all_callbacks
     :entry-point (ff:convert-to-lang "XtRemoveAllCallbacks")
     :call-direct t
     :arguments '(foreign-address foreign-address)
     :arg-checking nil
     :return-type :void)
-    
+
 (defforeign 'xt_set_sensitive
     :entry-point (ff:convert-to-lang "XtSetSensitive")
     :call-direct t
     :arguments '(foreign-address fixnum)
     :arg-checking nil
     :return-type :void)
-    
+
 (defforeign 'xt_grab_pointer
     :entry-point (ff:convert-to-lang "XtGrabPointer")
     :call-direct t
@@ -390,6 +390,15 @@
     :arg-checking nil
     :return-type :fixnum)
 
+(defforeign 'xt_ungrab_button
+    :entry-point (ff:convert-to-lang "XtUngrabButton")
+    :call-direct t
+    :arguments '(foreign-address	; widget
+		 fixnum			; button
+		 fixnum			; modifiers
+		 )
+    :arg-checking nil
+    :return-type :void)
 
 (defforeign 'xt-last-timestamp-processed
     :entry-point (ff:convert-to-lang "XtLastTimestampProcessed")
@@ -407,12 +416,11 @@
     :return-type :unsigned-integer)
 
 (ff:defforeign 'init_clim_gc_cursor_stuff
-    ;;    :call-direct t
-    ;;    :arguments '(fixnum)
-    ;;    :arg-checking nil
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
     :entry-point (ff:convert-to-lang "init_clim_gc_cursor_stuff")
-    ;;    :return-type :unsigned-integer
-    )
+    :return-type :unsigned-integer)
 
 (ff:defforeign 'set_clim_gc_cursor_widget
     :call-direct t
diff --git a/utils/base-designs.lisp b/utils/base-designs.lisp
index dc28bffd..7f2a4003 100644
--- a/utils/base-designs.lisp
+++ b/utils/base-designs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: base-designs.lisp,v 1.8 1993/08/19 20:10:25 smh Exp $
+;; $fiHeader: base-designs.lisp,v 1.9 1994/12/05 00:02:22 colin Exp $
 
 (in-package :clim-utils)
 
@@ -112,15 +112,15 @@
 (defgeneric deallocate-color (color palette))
 
 
-;;; Dynamic Colors 
+;;; Dynamic Colors
 
 (defclass dynamic-color (color)
     ((color :accessor dynamic-color-color :initarg :color)
-     (palettes :type list 
+     (palettes :type list
 	       :initform nil
 	       :accessor dynamic-color-palettes)))
 
-(define-constructor make-dynamic-color dynamic-color (color) 
+(define-constructor make-dynamic-color dynamic-color (color)
   :color color)
 
 (defmethod make-load-form ((color dynamic-color) &optional environment)
@@ -147,12 +147,12 @@
 (defclass layered-color (design)
     ((set :initarg :set :reader layered-color-set)
      (layers :initarg :layers :initform nil :reader layered-color-layers)
-     (dynamic-colors :initform nil))) 
-   
+     (dynamic-colors :initform nil)))
+
 (define-constructor make-layered-color layered-color (set layers)
   :set set :layers layers)
 
-;;; Device Colors 
+;;; Device Colors
 
 (defclass device-color (color)
     ((palette :reader device-color-palette :initarg :palette)
@@ -213,7 +213,7 @@
 ;;; Patterns
 
 (defclass pattern (design)
-  ((array :type (array * (* *)) :initarg :array 
+  ((array :type (array * (* *)) :initarg :array
 	    :reader pattern-array)
    (designs :type vector :initarg :designs
 	    :reader pattern-designs)))
@@ -221,7 +221,7 @@
 (defun make-pattern (array designs)
   #+Genera (declare lt:(side-effects simple reducible))
   (check-type array (array * (* *)))
-  (make-instance 'pattern :array array :designs (coerce designs 'vector)))
+  (make-instance 'pattern :array array :designs (coerce designs 'simple-vector)))
 
 (defmethod make-load-form ((design pattern) &optional environment)
   (declare (ignore environment))
diff --git a/utils/designs.lisp b/utils/designs.lisp
index 7234de25..d53b01ed 100644
--- a/utils/designs.lisp
+++ b/utils/designs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: designs.lisp,v 1.18 1994/12/05 00:02:24 colin Exp $
+;; $fiHeader: designs.lisp,v 1.19 1995/05/17 19:50:33 colin Exp $
 
 (in-package :clim-utils)
 
@@ -115,7 +115,7 @@
 ;;; Color constants
 
 (defmacro define-primary-color (color-name r g b)
-  `(defconstant ,color-name 
+  `(defconstant ,color-name
 		(make-rgb-color-1 (float ,r 0f0) (float ,g 0f0) (float ,b 0f0))))
 
 ;; The primary colors, constant across all platforms
@@ -323,14 +323,19 @@
 	       (palette-full-palette condition)))))
 )	;eval-when
 
-(defvar *use-closest-color* t)
+(defvar *use-closest-color* :warn)
 
 (defmethod palette-full-error ((palette basic-palette) &optional color)
-  (if (and *use-closest-color*
-	   (find-restart 'use-other-color))
-      (invoke-restart 'use-other-color
-	(find-closest-matching-color palette color))
-    (error 'palette-full :palette palette :color color)))
+  (when (and *use-closest-color*
+	     (find-restart 'use-other-color))
+    (let ((closest-match (find-closest-matching-color palette color)))
+      (when closest-match
+	(when (eq *use-closest-color* :warn)
+	  (let ((*error-output* excl:*initial-terminal-io*))
+	    (warn "Failed to allocate color ~A, using ~A"
+		  color closest-match)))
+	(invoke-restart 'use-other-color closest-match))))
+  (error 'palette-full :palette palette :color color))
 
 (defmethod find-closest-matching-color ((palette basic-palette) (desired-color color))
   (let ((best-color nil)
@@ -435,7 +440,7 @@
 			 (rest-set-layers (cdr set-layers))
 			 (rest-dims (cdr dims)))
 		     (if layer
-			 (progn 
+			 (progn
 			   (setf (car dims) layer)
 			   (iterate rest-layers rest-set-layers rest-dims))
 			 (dotimes (i set-layer)
@@ -459,12 +464,12 @@
 	  (setf (gethash layers cache)
 		(make-layered-color set layers))))))
 
-(defmethod (setf layered-color-color) 
+(defmethod (setf layered-color-color)
 	   ((color color) (layered-color layered-color))
   (with-delayed-recoloring
     (dolist (dynamic-color (layered-color-dynamic-colors layered-color))
       (setf (dynamic-color-color dynamic-color) color))))
-  
+
 ;; LAYERED-COLOR-DYNAMIC-COLORS should not be exported to the user.  It
 ;; is important that these dynamics are not drawn with.  Instead, the
 ;; fully specified layered is used.
@@ -474,7 +479,7 @@
 	(setf dynamic-colors
 	      (let ((dynamic-array (layered-color-set-dynamic-array set))
 		    (dynamics nil))
-		(map-over-layered-colors 
+		(map-over-layered-colors
 		  #'(lambda (dimensions)
 		      (push (apply #'aref dynamic-array dimensions) dynamics))
 		  set layers)
@@ -590,7 +595,7 @@
 	     pattern)))
     (declare (dynamic-extent #'make-dash-pattern))
     (etypecase k
-      (null 
+      (null
 	(let ((patterns (make-array n)))
 	  (dotimes (i n)
 	    (setf (aref patterns i) (make-dash-pattern i)))
diff --git a/utils/packages.lisp b/utils/packages.lisp
index 81c9e779..ee336788 100644
--- a/utils/packages.lisp
+++ b/utils/packages.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: packages.lisp,v 1.64 1994/12/05 00:02:30 colin Exp $
+;; $fiHeader: packages.lisp,v 1.65 1995/05/17 19:50:36 colin Exp $
 
 (in-package :common-lisp-user)
 
@@ -3245,6 +3245,7 @@
     add-sheet-callbacks
     all-drawing-options-lambda-list
     allocate-event
+    armed-gadget-event
     basic-pixmap-medium
     bury-mirror
     canvas
@@ -3274,6 +3275,7 @@
     define-graphics-method
     define-text-style-mappings
     define-text-style-mappings-1
+    disarmed-gadget-event
     distribute-event-1
     drag-gadget-event
     draw-gadget-label
@@ -3379,6 +3381,7 @@
     port-mirror->sheet-table
     port-move-frame
     port-resize-frame
+    port-remove-all-pointer-grabs
     port-note-cursor-change
     port-note-frame-adopted
     port-note-gadget-activated
@@ -3435,6 +3438,7 @@
     stream-scan-string-for-writing-1
     string-height
     string-width
+    text-field-echo-character
     text-style-index
     text-style-mapping*
     text-style-scale
diff --git a/xlib/xlib-funs.lisp b/xlib/xlib-funs.lisp
index 269d8329..6ae4ce34 100644
--- a/xlib/xlib-funs.lisp
+++ b/xlib/xlib-funs.lisp
@@ -1,6 +1,6 @@
 ;; -*- mode: common-lisp; package: x11 -*-
 ;;; (c) Copyright  1990 Sun Microsystems, Inc.  All Rights Reserved.
-;; 
+;;
 ;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca.  All rights reserved.
 ;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca.  All rights reserved.
 ;;
@@ -45,7 +45,7 @@
 ;;      OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
 ;;      WITH THE USE OR PERFORMANCE OF THIS OBJECT CODE.
 
-;;; $fiHeader: xlib-funs.lisp,v 1.14 1993/11/18 18:46:00 cer Exp $
+;;; $fiHeader: xlib-funs.lisp,v 1.15 1994/12/05 00:02:47 colin Exp $
 
 (in-package :x11)
 
@@ -58,7 +58,7 @@
    (pixels (:pointer unsigned-long))
    (ncolors unsigned-int))
 
-(def-exported-foreign-function (xalloccolorplanes (:return-type int) (:name "XAllocColorPlanes")) 
+(def-exported-foreign-function (xalloccolorplanes (:return-type int) (:name "XAllocColorPlanes"))
    (dpy (:pointer display))
    (cmap colormap)
    (contig int)
@@ -71,73 +71,73 @@
    (gmask (:pointer unsigned-long))
    (bmask (:pointer unsigned-long)))
 
-(def-exported-foreign-function (xallowevents (:name "XAllowEvents")) 
+(def-exported-foreign-function (xallowevents (:name "XAllowEvents"))
    (dpy (:pointer display))
    (mode int)
    (time :unsigned-32bit))
 
-(def-exported-foreign-function (xautorepeaton (:name "XAutoRepeatOn")) 
+(def-exported-foreign-function (xautorepeaton (:name "XAutoRepeatOn"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xautorepeatoff (:name "XAutoRepeatOff")) 
+(def-exported-foreign-function (xautorepeatoff (:name "XAutoRepeatOff"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xsetwindowbackground (:name "XSetWindowBackground")) 
+(def-exported-foreign-function (xsetwindowbackground (:name "XSetWindowBackground"))
    (dpy (:pointer display))
    (w window)
    (pixel unsigned-long))
 
-(def-exported-foreign-function (xsetwindowborderwidth (:name "XSetWindowBorderWidth")) 
+(def-exported-foreign-function (xsetwindowborderwidth (:name "XSetWindowBorderWidth"))
    (dpy (:pointer display))
    (w window)
    (width unsigned-int))
 
-(def-exported-foreign-function (xbell (:name "XBell")) 
+(def-exported-foreign-function (xbell (:name "XBell"))
    (dpy (:pointer display))
    (percent int))
 
-(def-exported-foreign-function (xsetwindowborder (:name "XSetWindowBorder")) 
+(def-exported-foreign-function (xsetwindowborder (:name "XSetWindowBorder"))
    (dpy (:pointer display))
    (w window)
    (pixel unsigned-long))
 
-(def-exported-foreign-function (xenableaccesscontrol (:name "XEnableAccessControl")) 
+(def-exported-foreign-function (xenableaccesscontrol (:name "XEnableAccessControl"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xdisableaccesscontrol (:name "XDisableAccessControl")) 
+(def-exported-foreign-function (xdisableaccesscontrol (:name "XDisableAccessControl"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xsetaccesscontrol (:name "XSetAccessControl")) 
+(def-exported-foreign-function (xsetaccesscontrol (:name "XSetAccessControl"))
    (dpy (:pointer display))
    (mode int))
 
-(def-exported-foreign-function (xchangeactivepointergrab (:name "XChangeActivePointerGrab")) 
+(def-exported-foreign-function (xchangeactivepointergrab (:name "XChangeActivePointerGrab"))
    (dpy (:pointer display))
    (event-mask unsigned-int)
    (curs cursor)
    (time :unsigned-32bit))
 
-(def-exported-foreign-function (xsetclosedownmode (:name "XSetCloseDownMode")) 
+(def-exported-foreign-function (xsetclosedownmode (:name "XSetCloseDownMode"))
    (dpy (:pointer display))
    (mode int))
 
-(def-exported-foreign-function (xsetwindowcolormap (:name "XSetWindowColormap")) 
+(def-exported-foreign-function (xsetwindowcolormap (:name "XSetWindowColormap"))
    (dpy (:pointer display))
    (w window)
    (colormap colormap))
 
-(def-exported-foreign-function (xchangegc (:name "XChangeGC")) 
+(def-exported-foreign-function (xchangegc (:name "XChangeGC"))
    (dpy (:pointer display))
    (gc gc)
    (valuemask unsigned-long)
    (values (:pointer xgcvalues)))
 
-(def-exported-foreign-function (xchangekeyboardcontrol (:name "XChangeKeyboardControl")) 
+(def-exported-foreign-function (xchangekeyboardcontrol (:name "XChangeKeyboardControl"))
    (dpy (:pointer display))
    (mask unsigned-long)
    (value-list (:pointer xkeyboardcontrol)))
 
-(def-exported-foreign-function (xchangepointercontrol (:name "XChangePointerControl")) 
+(def-exported-foreign-function (xchangepointercontrol (:name "XChangePointerControl"))
    (dpy (:pointer display))
    (do-acc int)
    (do-thresh int)
@@ -145,7 +145,7 @@
    (acc-denominator int)
    (threshold int))
 
-(def-exported-foreign-function (xchangeproperty (:name "XChangeProperty")) 
+(def-exported-foreign-function (xchangeproperty (:name "XChangeProperty"))
    (dpy (:pointer display))
    (w window)
    (property :unsigned-32bit)
@@ -155,80 +155,80 @@
    (data (:pointer unsigned-char))
    (nelements int))
 
-(def-exported-foreign-function (xchangesaveset (:name "XChangeSaveSet")) 
+(def-exported-foreign-function (xchangesaveset (:name "XChangeSaveSet"))
    (dpy (:pointer display))
    (win window)
    (mode int))
 
-(def-exported-foreign-function (xaddtosaveset (:name "XAddToSaveSet")) 
+(def-exported-foreign-function (xaddtosaveset (:name "XAddToSaveSet"))
    (dpy (:pointer display))
    (win window))
 
-(def-exported-foreign-function (xremovefromsaveset (:name "XRemoveFromSaveSet")) 
+(def-exported-foreign-function (xremovefromsaveset (:name "XRemoveFromSaveSet"))
    (dpy (:pointer display))
    (win window))
 
-(def-exported-foreign-function (xchangewindowattributes (:name "XChangeWindowAttributes")) 
+(def-exported-foreign-function (xchangewindowattributes (:name "XChangeWindowAttributes"))
    (dpy (:pointer display))
    (w window)
    (valuemask unsigned-long)
    (attributes (:pointer xsetwindowattributes)))
 
-(def-exported-foreign-function (xresizewindow (:name "XResizeWindow")) 
+(def-exported-foreign-function (xresizewindow (:name "XResizeWindow"))
    (dpy (:pointer display))
    (w window)
    (width unsigned-int)
    (height unsigned-int))
 
-(def-exported-foreign-function (xcheckifevent (:return-type int) (:name "XCheckIfEvent")) 
+(def-exported-foreign-function (xcheckifevent (:return-type int) (:name "XCheckIfEvent"))
    (dpy (:pointer display))
    (event (:pointer xevent))
    (predicate (:pointer :pointer))
    (arg (:pointer char)))
 
-(def-exported-foreign-function (xcheckmaskevent (:return-type int) (:name "XCheckMaskEvent")) 
+(def-exported-foreign-function (xcheckmaskevent (:return-type int) (:name "XCheckMaskEvent"))
    (dpy (:pointer display))
    (mask long)
    (event (:pointer xevent)))
 
-(def-exported-foreign-function (xchecktypedevent (:return-type int) (:name "XCheckTypedEvent")) 
+(def-exported-foreign-function (xchecktypedevent (:return-type int) (:name "XCheckTypedEvent"))
    (dpy (:pointer display))
    (type int)
    (event (:pointer xevent)))
 
-(def-exported-foreign-function (xchecktypedwindowevent (:return-type int) (:name "XCheckTypedWindowEvent")) 
+(def-exported-foreign-function (xchecktypedwindowevent (:return-type int) (:name "XCheckTypedWindowEvent"))
    (dpy (:pointer display))
    (w window)
    (type int)
    (event (:pointer xevent)))
 
-(def-exported-foreign-function (xcheckwindowevent (:return-type int) (:name "XCheckWindowEvent")) 
+(def-exported-foreign-function (xcheckwindowevent (:return-type int) (:name "XCheckWindowEvent"))
    (dpy (:pointer display))
    (w window)
    (mask long)
    (event (:pointer xevent)))
 
-(def-exported-foreign-function (xcirculatesubwindows (:name "XCirculateSubwindows")) 
+(def-exported-foreign-function (xcirculatesubwindows (:name "XCirculateSubwindows"))
    (dpy (:pointer display))
    (w window)
    (direction int))
 
-(def-exported-foreign-function (xcirculatesubwindowsdown (:name "XCirculateSubwindowsDown")) 
+(def-exported-foreign-function (xcirculatesubwindowsdown (:name "XCirculateSubwindowsDown"))
    (dpy (:pointer display))
    (w window))
 
-(def-exported-foreign-function (xcirculatesubwindowsup (:name "XCirculateSubwindowsUp")) 
+(def-exported-foreign-function (xcirculatesubwindowsup (:name "XCirculateSubwindowsUp"))
    (dpy (:pointer display))
    (w window))
 
-(def-exported-foreign-function (xclosedisplay (:name "XCloseDisplay")) 
+(def-exported-foreign-function (xclosedisplay (:name "XCloseDisplay"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xclearwindow (:name "XClearWindow")) 
+(def-exported-foreign-function (xclearwindow (:name "XClearWindow"))
    (dpy (:pointer display))
    (w window))
 
-(def-exported-foreign-function (xcleararea (:name "XClearArea")) 
+(def-exported-foreign-function (xcleararea (:name "XClearArea"))
    (dpy (:pointer display))
    (w window)
    (x int)
@@ -245,7 +245,7 @@
    (width unsigned-int)
    (height unsigned-int))
 
-(def-exported-foreign-function (xconvertselection (:name "XConvertSelection")) 
+(def-exported-foreign-function (xconvertselection (:name "XConvertSelection"))
    (dpy (:pointer display))
    (selection :unsigned-32bit)
    (target :unsigned-32bit)
@@ -253,7 +253,7 @@
    (requestor window)
    (time :unsigned-32bit))
 
-(def-exported-foreign-function (xcopyarea (:name "XCopyArea")) 
+(def-exported-foreign-function (xcopyarea (:name "XCopyArea"))
    (dpy (:pointer display))
    (src-drawable drawable)
    (dst-drawable drawable)
@@ -265,17 +265,17 @@
    (dst-x int)
    (dst-y int))
 
-(def-exported-foreign-function (xcopycolormapandfree (:name "XCopyColormapAndFree")) 
+(def-exported-foreign-function (xcopycolormapandfree (:name "XCopyColormapAndFree"))
    (dpy (:pointer display))
    (src-cmap colormap))
 
-(def-exported-foreign-function (xcopygc (:name "XCopyGC")) 
+(def-exported-foreign-function (xcopygc (:name "XCopyGC"))
    (dpy (:pointer display))
    (mask unsigned-long)
    (srcgc gc)
    (destgc gc))
 
-(def-exported-foreign-function (xcopyplane (:name "XCopyPlane")) 
+(def-exported-foreign-function (xcopyplane (:name "XCopyPlane"))
    (dpy (:pointer display))
    (src-drawable drawable)
    (dst-drawable drawable)
@@ -288,13 +288,13 @@
    (dst-y int)
    (bit-plane unsigned-long))
 
-(def-exported-foreign-function (xcreatecolormap (:return-type colormap) (:name "XCreateColormap")) 
+(def-exported-foreign-function (xcreatecolormap (:return-type colormap) (:name "XCreateColormap"))
    (dpy (:pointer display))
    (w window)
    (visual (:pointer visual))
    (alloc int))
 
-(def-exported-foreign-function (xcreatepixmapcursor (:return-type cursor) (:name "XCreatePixmapCursor")) 
+(def-exported-foreign-function (xcreatepixmapcursor (:return-type cursor) (:name "XCreatePixmapCursor"))
    (dpy (:pointer display))
    (source pixmap)
    (mask pixmap)
@@ -303,16 +303,16 @@
    (x unsigned-int)
    (y unsigned-int))
 
-(def-exported-foreign-function (xcreategc (:return-type gc) (:name "XCreateGC")) 
+(def-exported-foreign-function (xcreategc (:return-type gc) (:name "XCreateGC"))
    (dpy (:pointer display))
    (d drawable)
    (valuemask unsigned-long)
    (values (:pointer xgcvalues)))
 
-(def-exported-foreign-function (xgcontextfromgc (:return-type gcontext) (:name "XGContextFromGC")) 
+(def-exported-foreign-function (xgcontextfromgc (:return-type gcontext) (:name "XGContextFromGC"))
    (gc gc))
 
-(def-exported-foreign-function (xcreateglyphcursor (:return-type cursor) (:name "XCreateGlyphCursor")) 
+(def-exported-foreign-function (xcreateglyphcursor (:return-type cursor) (:name "XCreateGlyphCursor"))
    (dpy (:pointer display))
    (source-font font)
    (mask-font font)
@@ -321,14 +321,14 @@
    (foreground (:pointer xcolor))
    (background (:pointer xcolor)))
 
-(def-exported-foreign-function (xcreatepixmap (:return-type pixmap) (:name "XCreatePixmap")) 
+(def-exported-foreign-function (xcreatepixmap (:return-type pixmap) (:name "XCreatePixmap"))
    (dpy (:pointer display))
    (d drawable)
    (width unsigned-int)
    (height unsigned-int)
    (depth unsigned-int))
 
-(def-exported-foreign-function (xcreatesimplewindow (:return-type window) (:name "XCreateSimpleWindow")) 
+(def-exported-foreign-function (xcreatesimplewindow (:return-type window) (:name "XCreateSimpleWindow"))
    (dpy (:pointer display))
    (parent window)
    (x int)
@@ -339,39 +339,39 @@
    (border unsigned-long)
    (background unsigned-long))
 
-(def-exported-foreign-function (xcreatefontcursor (:return-type cursor) (:name "XCreateFontCursor")) 
+(def-exported-foreign-function (xcreatefontcursor (:return-type cursor) (:name "XCreateFontCursor"))
    (dpy (:pointer display))
    (which unsigned-int))
 
-(def-exported-foreign-function (xdefinecursor (:name "XDefineCursor")) 
+(def-exported-foreign-function (xdefinecursor (:name "XDefineCursor"))
    (dpy (:pointer display))
    (w window)
    (cursor cursor))
 
-(def-exported-foreign-function (xdeleteproperty (:name "XDeleteProperty")) 
+(def-exported-foreign-function (xdeleteproperty (:name "XDeleteProperty"))
    (dpy (:pointer display))
    (window window)
    (property :unsigned-32bit))
 
-(def-exported-foreign-function (xdestroysubwindows (:name "XDestroySubwindows")) 
+(def-exported-foreign-function (xdestroysubwindows (:name "XDestroySubwindows"))
    (dpy (:pointer display))
    (win window))
 
-(def-exported-foreign-function (xdestroywindow (:name "XDestroyWindow")) 
+(def-exported-foreign-function (xdestroywindow (:name "XDestroyWindow"))
    (dpy (:pointer display))
    (w window))
 
-(def-exported-foreign-function (xdisplayname (:return-type (:pointer char)) (:name "XDisplayName")) 
+(def-exported-foreign-function (xdisplayname (:return-type (:pointer char)) (:name "XDisplayName"))
    (display (:pointer char)))
 
 
-(def-exported-foreign-function (xgeterrortext (:name "XGetErrorText")) 
+(def-exported-foreign-function (xgeterrortext (:name "XGetErrorText"))
    (dpy (:pointer display))
    (code int)
    (buffer (:pointer char))
-   (nbytes int))  
+   (nbytes int))
 
-(def-exported-foreign-function (xgeterrordatabasetext (:name "XGetErrorDatabaseText")) 
+(def-exported-foreign-function (xgeterrordatabasetext (:name "XGetErrorDatabaseText"))
    (name (:pointer char))
    (type (:pointer char))
    (defaultp (:pointer char))
@@ -379,33 +379,33 @@
    (buffer (:pointer char))
    (nbytes int))
 
-(def-exported-foreign-function (xseterrorhandler (:name "XSetErrorHandler")) 
+(def-exported-foreign-function (xseterrorhandler (:name "XSetErrorHandler"))
    (handler callback-function-addr))
 
-(def-exported-foreign-function (xsetioerrorhandler (:name "XSetIOErrorHandler")) 
+(def-exported-foreign-function (xsetioerrorhandler (:name "XSetIOErrorHandler"))
    (handler callback-function-addr))
 
-(def-exported-foreign-function (xactivatescreensaver (:name "XActivateScreenSaver")) 
+(def-exported-foreign-function (xactivatescreensaver (:name "XActivateScreenSaver"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xresetscreensaver (:name "XResetScreenSaver")) 
+(def-exported-foreign-function (xresetscreensaver (:name "XResetScreenSaver"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xforcescreensaver (:return-type int) (:name "XForceScreenSaver")) 
+(def-exported-foreign-function (xforcescreensaver (:return-type int) (:name "XForceScreenSaver"))
    (dpy (:pointer display))
    (mode int))
 
-(def-exported-foreign-function (xfetchname (:return-type int) (:name "XFetchName")) 
+(def-exported-foreign-function (xfetchname (:return-type int) (:name "XFetchName"))
    (dpy (:pointer display))
    (w window)
    (name (:pointer (:pointer char))))
 
-(def-exported-foreign-function (xgeticonname (:return-type int) (:name "XGetIconName")) 
+(def-exported-foreign-function (xgeticonname (:return-type int) (:name "XGetIconName"))
    (dpy (:pointer display))
    (w window)
    (icon-name (:pointer (:pointer char))))
 
-(def-exported-foreign-function (xfillarc (:name "XFillArc")) 
+(def-exported-foreign-function (xfillarc (:name "XFillArc"))
    (dpy (:pointer display))
    (d drawable)
    (gc gc)
@@ -416,14 +416,14 @@
    (angle1 int)
    (angle2 int))
 
-(def-exported-foreign-function (xfillarcs (:name "XFillArcs")) 
+(def-exported-foreign-function (xfillarcs (:name "XFillArcs"))
    (dpy (:pointer display))
    (d drawable)
    (gc gc)
    (arcs (:pointer xarc))
    (n-arcs int))
 
-(def-exported-foreign-function (xfillpolygon (:name "XFillPolygon")) 
+(def-exported-foreign-function (xfillpolygon (:name "XFillPolygon"))
    (dpy (:pointer display))
    (d drawable)
    (gc gc)
@@ -432,7 +432,7 @@
    (shape int)
    (mode int))
 
-(def-exported-foreign-function (xfillrectangle (:name "XFillRectangle")) 
+(def-exported-foreign-function (xfillrectangle (:name "XFillRectangle"))
    (dpy (:pointer display))
    (d drawable)
    (gc gc)
@@ -441,7 +441,7 @@
    (width unsigned-int)
    (height unsigned-int))
 
-(def-exported-foreign-function (xfillrectangles (:name "XFillRectangles")) 
+(def-exported-foreign-function (xfillrectangles (:name "XFillRectangles"))
    (dpy (:pointer display))
    (d drawable)
    (gc gc)
@@ -451,111 +451,111 @@
 (def-exported-foreign-function (xflush (:name "XFlush"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xloadqueryfont (:return-type (:pointer xfontstruct)) (:name "XLoadQueryFont")) 
+(def-exported-foreign-function (xloadqueryfont (:return-type (:pointer xfontstruct)) (:name "XLoadQueryFont"))
    (dpy (:pointer display))
    (name (:pointer char)))
 
-(def-exported-foreign-function (xfreefont (:name "XFreeFont")) 
+(def-exported-foreign-function (xfreefont (:name "XFreeFont"))
    (dpy (:pointer display))
    (fs (:pointer xfontstruct)))
 
-(def-exported-foreign-function (xqueryfont (:return-type (:pointer xfontstruct)) (:name "XQueryFont")) 
+(def-exported-foreign-function (xqueryfont (:return-type (:pointer xfontstruct)) (:name "XQueryFont"))
    (dpy (:pointer display))
    (fid font))
 
-(def-exported-foreign-function (xlistfontswithinfo (:return-type (:pointer (:pointer char))) (:name "XListFontsWithInfo")) 
+(def-exported-foreign-function (xlistfontswithinfo (:return-type (:pointer (:pointer char))) (:name "XListFontsWithInfo"))
    (dpy (:pointer display))
    (pattern (:pointer char))
    (maxnames int)
    (actualcount (:pointer int))
    (info (:pointer (:pointer xfontstruct))))
 
-(def-exported-foreign-function (xfreefontinfo (:name "XFreeFontInfo")) 
+(def-exported-foreign-function (xfreefontinfo (:name "XFreeFontInfo"))
    (names (:pointer (:pointer char)))
    (info (:pointer xfontstruct))
    (actualcount int))
 
-(def-exported-foreign-function (xlistfonts (:return-type (:pointer (:pointer char))) (:name "XListFonts")) 
+(def-exported-foreign-function (xlistfonts (:return-type (:pointer (:pointer char))) (:name "XListFonts"))
    (dpy (:pointer display))
    (pattern (:pointer char))
    (maxnames int)
    (actualcount (:pointer int)))
 
-(def-exported-foreign-function (xfreefontnames (:name "XFreeFontNames")) 
+(def-exported-foreign-function (xfreefontnames (:name "XFreeFontNames"))
    (list (:pointer (:pointer char))))
 
-(def-exported-foreign-function (xfreecolormap (:name "XFreeColormap")) 
+(def-exported-foreign-function (xfreecolormap (:name "XFreeColormap"))
    (dpy (:pointer display))
    (cmap colormap))
 
-(def-exported-foreign-function (xfreecolors (:name "XFreeColors")) 
+(def-exported-foreign-function (xfreecolors (:name "XFreeColors"))
    (dpy (:pointer display))
    (cmap colormap)
    (pixels (:pointer unsigned-long))
    (npixels int)
    (planes unsigned-long))
 
-(def-exported-foreign-function (xfreecursor (:name "XFreeCursor")) 
+(def-exported-foreign-function (xfreecursor (:name "XFreeCursor"))
    (dpy (:pointer display))
    (cursor cursor))
 
-(def-exported-foreign-function (xfreegc (:name "XFreeGC")) 
+(def-exported-foreign-function (xfreegc (:name "XFreeGC"))
    (dpy (:pointer display))
    (gc gc))
 
-(def-exported-foreign-function (xfreepixmap (:name "XFreePixmap")) 
+(def-exported-foreign-function (xfreepixmap (:name "XFreePixmap"))
    (dpy (:pointer display))
    (pixmap pixmap))
 
-(def-exported-foreign-function (xsetarcmode (:name "XSetArcMode")) 
+(def-exported-foreign-function (xsetarcmode (:name "XSetArcMode"))
    (dpy (:pointer display))
    (gc gc)
    (arc-mode int))
 
-(def-exported-foreign-function (xsetfillrule (:name "XSetFillRule")) 
+(def-exported-foreign-function (xsetfillrule (:name "XSetFillRule"))
    (dpy (:pointer display))
    (gc gc)
    (fill-rule int))
 
-(def-exported-foreign-function (xsetfillstyle (:name "XSetFillStyle")) 
+(def-exported-foreign-function (xsetfillstyle (:name "XSetFillStyle"))
    (dpy (:pointer display))
    (gc gc)
    (fill-style int))
 
-(def-exported-foreign-function (xsetgraphicsexposures (:name "XSetGraphicsExposures")) 
+(def-exported-foreign-function (xsetgraphicsexposures (:name "XSetGraphicsExposures"))
    (dpy (:pointer display))
    (gc gc)
    (graphics-exposures int))
 
-(def-exported-foreign-function (xsetsubwindowmode (:name "XSetSubwindowMode")) 
+(def-exported-foreign-function (xsetsubwindowmode (:name "XSetSubwindowMode"))
    (dpy (:pointer display))
    (gc gc)
    (subwindow-mode int))
 
-(def-exported-foreign-function (xgetatomname (:return-type (:pointer char)) (:name "XGetAtomName")) 
+(def-exported-foreign-function (xgetatomname (:return-type (:pointer char)) (:name "XGetAtomName"))
    (dpy (:pointer display))
    (atom :unsigned-32bit))
 
-(def-exported-foreign-function (xallocnamedcolor (:return-type int) (:name "XAllocNamedColor")) 
+(def-exported-foreign-function (xallocnamedcolor (:return-type int) (:name "XAllocNamedColor"))
    (dpy (:pointer display))
    (cmap colormap)
    (colorname (:pointer char))
    (hard-def (:pointer xcolor))
    (exact-def (:pointer xcolor)))
 
-(def-exported-foreign-function (xgetfontpath (:return-type (:pointer (:pointer char))) (:name "XGetFontPath")) 
+(def-exported-foreign-function (xgetfontpath (:return-type (:pointer (:pointer char))) (:name "XGetFontPath"))
    (dpy (:pointer display))
    (npaths (:pointer int)))
 
-(def-exported-foreign-function (xfreefontpath (:name "XFreeFontPath")) 
+(def-exported-foreign-function (xfreefontpath (:name "XFreeFontPath"))
    (list (:pointer (:pointer char))))
 
-(def-exported-foreign-function (xgetfontproperty (:return-type int) (:name "XGetFontProperty")) 
+(def-exported-foreign-function (xgetfontproperty (:return-type int) (:name "XGetFontProperty"))
    (fs (:pointer xfontstruct))
    (name :unsigned-32bit)
    (valueptr (:pointer unsigned-long)))
 
-(def-exported-foreign-function (xgetgeometry (:return-type int) (:name "XGetGeometry")) 
+(def-exported-foreign-function (xgetgeometry (:return-type int) (:name "XGetGeometry"))
    (dpy (:pointer display))
    (d drawable)
    (root (:pointer window))
@@ -566,17 +566,17 @@
    (borderwidth (:pointer unsigned-int))
    (depth (:pointer unsigned-int)))
 
-(def-exported-foreign-function (xalloccolor (:return-type int) (:name "XAllocColor")) 
+(def-exported-foreign-function (xalloccolor (:return-type int) (:name "XAllocColor"))
    (dpy (:pointer display))
    (cmap colormap)
    (def (:pointer xcolor)))
 
-(def-exported-foreign-function (xgetinputfocus (:name "XGetInputFocus")) 
+(def-exported-foreign-function (xgetinputfocus (:name "XGetInputFocus"))
    (dpy (:pointer display))
    (focus (:pointer window))
    (revert-to (:pointer int)))
 
-(def-exported-foreign-function (xgetimage (:return-type (:pointer ximage)) (:name "XGetImage")) 
+(def-exported-foreign-function (xgetimage (:return-type (:pointer ximage)) (:name "XGetImage"))
    (dpy (:pointer display))
    (d drawable)
    (x int)
@@ -586,7 +586,7 @@
    (plane-mask unsigned-long)
    (format int))
 
-(def-exported-foreign-function (xgetsubimage (:return-type (:pointer ximage)) (:name "XGetSubImage")) 
+(def-exported-foreign-function (xgetsubimage (:return-type (:pointer ximage)) (:name "XGetSubImage"))
    (dpy (:pointer display))
    (d drawable)
    (x int)
@@ -599,35 +599,35 @@
    (dest-x int)
    (dest-y int))
 
-(def-exported-foreign-function (xgetkeyboardcontrol (:name "XGetKeyboardControl")) 
+(def-exported-foreign-function (xgetkeyboardcontrol (:name "XGetKeyboardControl"))
    (dpy (:pointer display))
    (state (:pointer xkeyboardstate)))
 
-(def-exported-foreign-function (xgetmotionevents (:return-type (:pointer xtimecoord)) (:name "XGetMotionEvents")) 
+(def-exported-foreign-function (xgetmotionevents (:return-type (:pointer xtimecoord)) (:name "XGetMotionEvents"))
    (dpy (:pointer display))
    (start :unsigned-32bit)
    (stop :unsigned-32bit)
    (w window)
    (nevents (:pointer int)))
 
-(def-exported-foreign-function (xgetpointercontrol (:name "XGetPointerControl")) 
+(def-exported-foreign-function (xgetpointercontrol (:name "XGetPointerControl"))
    (dpy (:pointer display))
    (accel-numer (:pointer int))
    (accel-denom (:pointer int))
    (threshold (:pointer int)))
 
-(def-exported-foreign-function (xgetpointermapping (:return-type int) (:name "XGetPointerMapping")) 
+(def-exported-foreign-function (xgetpointermapping (:return-type int) (:name "XGetPointerMapping"))
    (dpy (:pointer display))
    (map (:pointer unsigned-char))
    (nmaps int))
 
-(def-exported-foreign-function (xgetkeyboardmapping (:return-type (:pointer keysym)) (:name "XGetKeyboardMapping")) 
+(def-exported-foreign-function (xgetkeyboardmapping (:return-type (:pointer keysym)) (:name "XGetKeyboardMapping"))
    (dpy (:pointer display))
    (first-keycode :character) ;; (first-keycode keycode)
    (count int)
    (keysyms-per-keycode (:pointer int)))
 
-(def-exported-foreign-function (xgetwindowproperty (:return-type int) (:name "XGetWindowProperty")) 
+(def-exported-foreign-function (xgetwindowproperty (:return-type int) (:name "XGetWindowProperty"))
    (dpy (:pointer display))
    (w window)
    (property :unsigned-32bit)
@@ -641,23 +641,23 @@
    (bytesafter (:pointer unsigned-long))
    (prop (:pointer (:pointer unsigned-char))))
 
-(def-exported-foreign-function (xgetselectionowner (:return-type window) (:name "XGetSelectionOwner")) 
+(def-exported-foreign-function (xgetselectionowner (:return-type window) (:name "XGetSelectionOwner"))
    (dpy (:pointer display))
    (selection :unsigned-32bit))
 
-(def-exported-foreign-function (xgetscreensaver (:name "XGetScreenSaver")) 
+(def-exported-foreign-function (xgetscreensaver (:name "XGetScreenSaver"))
    (dpy (:pointer display))
    (timeout (:pointer int))
    (interval (:pointer int))
    (prefer-blanking (:pointer int))
    (allow-exp (:pointer int)))
 
-(def-exported-foreign-function (xgetwindowattributes (:return-type int) (:name "XGetWindowAttributes")) 
+(def-exported-foreign-function (xgetwindowattributes (:return-type int) (:name "XGetWindowAttributes"))
    (dpy (:pointer display))
    (w window)
    (att (:pointer xwindowattributes)))
 
-(def-exported-foreign-function (xgrabbutton (:name "XGrabButton")) 
+(def-exported-foreign-function (xgrabbutton (:name "XGrabButton"))
    (dpy (:pointer display))
    (modifiers unsigned-int)
    (button unsigned-int)
@@ -669,7 +669,7 @@
    (confine-to window)
    (curs cursor))
 
-(def-exported-foreign-function (xgrabkey (:name "XGrabKey")) 
+(def-exported-foreign-function (xgrabkey (:name "XGrabKey"))
    (dpy (:pointer display))
    (key int)
    (modifiers unsigned-int)
@@ -678,7 +678,7 @@
    (pointer-mode int)
    (keyboard-mode int))
 
-(def-exported-foreign-function (xgrabkeyboard (:return-type int) (:name "XGrabKeyboard")) 
+(def-exported-foreign-function (xgrabkeyboard (:return-type int) (:name "XGrabKeyboard"))
    (dpy (:pointer display))
    (window window)
    (ownerevents int)
@@ -686,7 +686,7 @@
    (keyboardmode int)
    (time :unsigned-32bit))
 
-(def-exported-foreign-function (xgrabpointer (:return-type int) (:name "XGrabPointer")) 
+(def-exported-foreign-function (xgrabpointer (:return-type int) (:name "XGrabPointer"))
    (dpy (:pointer display))
    (grab-window window)
    (owner-events int)
@@ -697,119 +697,119 @@
    (curs cursor)
    (time :unsigned-32bit))
 
-(def-exported-foreign-function (xgrabserver (:name "XGrabServer")) 
+(def-exported-foreign-function (xgrabserver (:name "XGrabServer"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xaddhost (:name "XAddHost")) 
+(def-exported-foreign-function (xaddhost (:name "XAddHost"))
    (dpy (:pointer display))
    (host (:pointer xhostaddress)))
 
-(def-exported-foreign-function (xremovehost (:name "XRemoveHost")) 
+(def-exported-foreign-function (xremovehost (:name "XRemoveHost"))
    (dpy (:pointer display))
    (host (:pointer xhostaddress)))
 
-(def-exported-foreign-function (xaddhosts (:name "XAddHosts")) 
+(def-exported-foreign-function (xaddhosts (:name "XAddHosts"))
    (dpy (:pointer display))
    (hosts (:pointer xhostaddress))
    (n int))
 
-(def-exported-foreign-function (xremovehosts (:name "XRemoveHosts")) 
+(def-exported-foreign-function (xremovehosts (:name "XRemoveHosts"))
    (dpy (:pointer display))
    (hosts (:pointer xhostaddress))
    (n int))
 
-(def-exported-foreign-function (xifevent (:name "XIfEvent")) 
+(def-exported-foreign-function (xifevent (:name "XIfEvent"))
    (dpy (:pointer display))
    (event (:pointer xevent))
    (predicate (:pointer :pointer))
    (arg (:pointer char)))
 
-(def-exported-foreign-function (xinitextension (:return-type (:pointer xextcodes)) (:name "XInitExtension")) 
+(def-exported-foreign-function (xinitextension (:return-type (:pointer xextcodes)) (:name "XInitExtension"))
    (dpy (:pointer display))
    (name (:pointer char)))
 
-(def-exported-foreign-function (xaddextension (:return-type (:pointer xextcodes)) (:name "XAddExtension")) 
+(def-exported-foreign-function (xaddextension (:return-type (:pointer xextcodes)) (:name "XAddExtension"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xeheadofextensionlist (:return-type (:pointer (:pointer xextdata))) (:name "XEHeadOfExtensionList")) 
+(def-exported-foreign-function (xeheadofextensionlist (:return-type (:pointer (:pointer xextdata))) (:name "XEHeadOfExtensionList"))
    (object xedataobject))
 
-(def-exported-foreign-function (xfindonextensionlist (:return-type (:pointer xextdata)) (:name "XFindOnExtensionList")) 
+(def-exported-foreign-function (xfindonextensionlist (:return-type (:pointer xextdata)) (:name "XFindOnExtensionList"))
    (structure (:pointer (:pointer xextdata)))
    (number int))
 
-(def-exported-foreign-function (xesetcreategc (:return-type (:pointer :pointer)) (:name "XESetCreateGC")) 
+(def-exported-foreign-function (xesetcreategc (:return-type (:pointer :pointer)) (:name "XESetCreateGC"))
    (dpy (:pointer display))
    (extension int)
    (proc (:pointer :pointer)))
 
-(def-exported-foreign-function (xesetcopygc (:return-type (:pointer :pointer)) (:name "XESetCopyGC")) 
+(def-exported-foreign-function (xesetcopygc (:return-type (:pointer :pointer)) (:name "XESetCopyGC"))
    (dpy (:pointer display))
    (extension int)
    (proc (:pointer :pointer)))
 
-(def-exported-foreign-function (xesetflushgc (:return-type (:pointer :pointer)) (:name "XESetFlushGC")) 
+(def-exported-foreign-function (xesetflushgc (:return-type (:pointer :pointer)) (:name "XESetFlushGC"))
    (dpy (:pointer display))
    (extension int)
    (proc (:pointer :pointer)))
 
-(def-exported-foreign-function (xesetfreegc (:return-type (:pointer :pointer)) (:name "XESetFreeGC")) 
+(def-exported-foreign-function (xesetfreegc (:return-type (:pointer :pointer)) (:name "XESetFreeGC"))
    (dpy (:pointer display))
    (extension int)
    (proc (:pointer :pointer)))
 
-(def-exported-foreign-function (xesetcreatefont (:return-type (:pointer :pointer)) (:name "XESetCreateFont")) 
+(def-exported-foreign-function (xesetcreatefont (:return-type (:pointer :pointer)) (:name "XESetCreateFont"))
    (dpy (:pointer display))
    (extension int)
    (proc (:pointer :pointer)))
 
-(def-exported-foreign-function (xesetfreefont (:return-type (:pointer :pointer)) (:name "XESetFreeFont")) 
+(def-exported-foreign-function (xesetfreefont (:return-type (:pointer :pointer)) (:name "XESetFreeFont"))
    (dpy (:pointer display))
    (extension int)
    (proc (:pointer :pointer)))
 
-(def-exported-foreign-function (xesetclosedisplay (:return-type (:pointer :pointer)) (:name "XESetCloseDisplay")) 
+(def-exported-foreign-function (xesetclosedisplay (:return-type (:pointer :pointer)) (:name "XESetCloseDisplay"))
    (dpy (:pointer display))
    (extension int)
    (proc (:pointer :pointer)))
 
-(def-exported-foreign-function (xesetwiretoevent (:return-type (:pointer :pointer)) (:name "XESetWireToEvent")) 
+(def-exported-foreign-function (xesetwiretoevent (:return-type (:pointer :pointer)) (:name "XESetWireToEvent"))
    (dpy (:pointer display))
    (proc (:pointer :pointer))
    (event-number int))
 
-(def-exported-foreign-function (xeseteventtowire (:return-type (:pointer :pointer)) (:name "XESetEventToWire")) 
+(def-exported-foreign-function (xeseteventtowire (:return-type (:pointer :pointer)) (:name "XESetEventToWire"))
    (dpy (:pointer display))
    (proc (:pointer :pointer))
    (event-number int))
 
-(def-exported-foreign-function (xeseterror (:return-type (:pointer :pointer)) (:name "XESetError")) 
+(def-exported-foreign-function (xeseterror (:return-type (:pointer :pointer)) (:name "XESetError"))
    (dpy (:pointer display))
    (extension int)
    (proc (:pointer :pointer)))
 
-(def-exported-foreign-function (xeseterrorstring (:return-type (:pointer :pointer)) (:name "XESetErrorString")) 
+(def-exported-foreign-function (xeseterrorstring (:return-type (:pointer :pointer)) (:name "XESetErrorString"))
    (dpy (:pointer display))
    (extension int)
    (proc (:pointer :pointer)))
 
-(def-exported-foreign-function (xinstallcolormap (:name "XInstallColormap")) 
+(def-exported-foreign-function (xinstallcolormap (:name "XInstallColormap"))
    (dpy (:pointer display))
    (cmap colormap))
 
-(def-exported-foreign-function (xinternatom (:return-type :unsigned-32bit) (:name "XInternAtom")) 
+(def-exported-foreign-function (xinternatom (:return-type :unsigned-32bit) (:name "XInternAtom"))
    (dpy (:pointer display))
    (name (:pointer char))
    (onlyifexists int))
 
-(def-exported-foreign-function (xrefreshkeyboardmapping (:name "XRefreshKeyboardMapping")) 
+(def-exported-foreign-function (xrefreshkeyboardmapping (:name "XRefreshKeyboardMapping"))
    (event (:pointer xmappingevent)))
 
 #+ignore
-(def-exported-foreign-function (xusekeymap (:return-type int) (:name "XUseKeymap")) 
+(def-exported-foreign-function (xusekeymap (:return-type int) (:name "XUseKeymap"))
    (filename (:pointer char)))
 
-(def-exported-foreign-function (xrebindkeysym (:name "XRebindKeysym")) 
+(def-exported-foreign-function (xrebindkeysym (:name "XRebindKeysym"))
    (dpy (:pointer display))
    (keysym keysym)
    (mlist (:pointer keysym))
@@ -817,217 +817,217 @@
    (str (:pointer unsigned-char))
    (nbytes int))
 
-(def-exported-foreign-function (xkillclient (:name "XKillClient")) 
+(def-exported-foreign-function (xkillclient (:name "XKillClient"))
    (dpy (:pointer display))
    (resource xid))
 
-(def-exported-foreign-function (xlisthosts (:return-type (:pointer xhostaddress)) (:name "XListHosts")) 
+(def-exported-foreign-function (xlisthosts (:return-type (:pointer xhostaddress)) (:name "XListHosts"))
    (dpy (:pointer display))
    (nhosts (:pointer int))
    (enabled (:pointer int)))
 
-(def-exported-foreign-function (xlistinstalledcolormaps (:return-type (:pointer colormap)) (:name "XListInstalledColormaps")) 
+(def-exported-foreign-function (xlistinstalledcolormaps (:return-type (:pointer colormap)) (:name "XListInstalledColormaps"))
    (dpy (:pointer display))
    (win window)
    (n (:pointer int)))
 
-(def-exported-foreign-function (xlistproperties (:return-type (:pointer atom)) (:name "XListProperties")) 
+(def-exported-foreign-function (xlistproperties (:return-type (:pointer atom)) (:name "XListProperties"))
    (dpy (:pointer display))
    (window window)
    (n-props (:pointer int)))
 
-(def-exported-foreign-function (xlistextensions (:return-type (:pointer (:pointer char))) (:name "XListExtensions")) 
+(def-exported-foreign-function (xlistextensions (:return-type (:pointer (:pointer char))) (:name "XListExtensions"))
    (dpy (:pointer display))
    (nextensions (:pointer int)))
 
-(def-exported-foreign-function (xfreeextensionlist (:name "XFreeExtensionList")) 
+(def-exported-foreign-function (xfreeextensionlist (:name "XFreeExtensionList"))
    (list (:pointer (:pointer char))))
 
-(def-exported-foreign-function (xloadfont (:return-type font) (:name "XLoadFont")) 
+(def-exported-foreign-function (xloadfont (:return-type font) (:name "XLoadFont"))
    (dpy (:pointer display))
    (name (:pointer char)))
 
-(def-exported-foreign-function (xlookupcolor (:return-type int) (:name "XLookupColor")) 
+(def-exported-foreign-function (xlookupcolor (:return-type int) (:name "XLookupColor"))
    (dpy (:pointer display))
    (cmap colormap)
    (spec (:pointer char))
    (def (:pointer xcolor))
    (scr (:pointer xcolor)))
 
-(def-exported-foreign-function (xlowerwindow (:name "XLowerWindow")) 
+(def-exported-foreign-function (xlowerwindow (:name "XLowerWindow"))
    (dpy (:pointer display))
    (w window))
 
-(def-exported-foreign-function (xconnectionnumber (:return-type int) (:name "XConnectionNumber")) 
+(def-exported-foreign-function (xconnectionnumber (:return-type int) (:name "XConnectionNumber"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xrootwindow (:return-type window) (:name "XRootWindow")) 
+(def-exported-foreign-function (xrootwindow (:return-type window) (:name "XRootWindow"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xdefaultscreen (:return-type int) (:name "XDefaultScreen")) 
+(def-exported-foreign-function (xdefaultscreen (:return-type int) (:name "XDefaultScreen"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xdefaultrootwindow (:return-type window) (:name "XDefaultRootWindow")) 
+(def-exported-foreign-function (xdefaultrootwindow (:return-type window) (:name "XDefaultRootWindow"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xdefaultvisual (:return-type (:pointer visual)) (:name "XDefaultVisual")) 
+(def-exported-foreign-function (xdefaultvisual (:return-type (:pointer visual)) (:name "XDefaultVisual"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xdefaultgc (:return-type gc) (:name "XDefaultGC")) 
+(def-exported-foreign-function (xdefaultgc (:return-type gc) (:name "XDefaultGC"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xblackpixel (:return-type unsigned-long) (:name "XBlackPixel")) 
+(def-exported-foreign-function (xblackpixel (:return-type unsigned-long) (:name "XBlackPixel"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xwhitepixel (:return-type unsigned-long) (:name "XWhitePixel")) 
+(def-exported-foreign-function (xwhitepixel (:return-type unsigned-long) (:name "XWhitePixel"))
    (dpy (:pointer display))
    (scr int))
 
 (def-exported-foreign-function (xallplanes (:return-type unsigned-long) (:name "XAllPlanes")) )
 
-(def-exported-foreign-function (xqlength (:return-type int) (:name "XQLength")) 
+(def-exported-foreign-function (xqlength (:return-type int) (:name "XQLength"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xdisplaywidth (:return-type int) (:name "XDisplayWidth")) 
+(def-exported-foreign-function (xdisplaywidth (:return-type int) (:name "XDisplayWidth"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xdisplayheight (:return-type int) (:name "XDisplayHeight")) 
+(def-exported-foreign-function (xdisplayheight (:return-type int) (:name "XDisplayHeight"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xdisplaywidthmm (:return-type int) (:name "XDisplayWidthMM")) 
+(def-exported-foreign-function (xdisplaywidthmm (:return-type int) (:name "XDisplayWidthMM"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xdisplayheightmm (:return-type int) (:name "XDisplayHeightMM")) 
+(def-exported-foreign-function (xdisplayheightmm (:return-type int) (:name "XDisplayHeightMM"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xdisplayplanes (:return-type int) (:name "XDisplayPlanes")) 
+(def-exported-foreign-function (xdisplayplanes (:return-type int) (:name "XDisplayPlanes"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xdisplaycells (:return-type int) (:name "XDisplayCells")) 
+(def-exported-foreign-function (xdisplaycells (:return-type int) (:name "XDisplayCells"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xscreencount (:return-type int) (:name "XScreenCount")) 
+(def-exported-foreign-function (xscreencount (:return-type int) (:name "XScreenCount"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xservervendor (:return-type (:pointer char)) (:name "XServerVendor")) 
+(def-exported-foreign-function (xservervendor (:return-type (:pointer char)) (:name "XServerVendor"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xprotocolversion (:return-type int) (:name "XProtocolVersion")) 
+(def-exported-foreign-function (xprotocolversion (:return-type int) (:name "XProtocolVersion"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xprotocolrevision (:return-type int) (:name "XProtocolRevision")) 
+(def-exported-foreign-function (xprotocolrevision (:return-type int) (:name "XProtocolRevision"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xvendorrelease (:return-type int) (:name "XVendorRelease")) 
+(def-exported-foreign-function (xvendorrelease (:return-type int) (:name "XVendorRelease"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xdisplaystring (:return-type (:pointer char)) (:name "XDisplayString")) 
+(def-exported-foreign-function (xdisplaystring (:return-type (:pointer char)) (:name "XDisplayString"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xdefaultdepth (:return-type int) (:name "XDefaultDepth")) 
+(def-exported-foreign-function (xdefaultdepth (:return-type int) (:name "XDefaultDepth"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xdefaultcolormap (:return-type colormap) (:name "XDefaultColormap")) 
+(def-exported-foreign-function (xdefaultcolormap (:return-type colormap) (:name "XDefaultColormap"))
    (dp (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xbitmapunit (:return-type int) (:name "XBitmapUnit")) 
+(def-exported-foreign-function (xbitmapunit (:return-type int) (:name "XBitmapUnit"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xbitmapbitorder (:return-type int) (:name "XBitmapBitOrder")) 
+(def-exported-foreign-function (xbitmapbitorder (:return-type int) (:name "XBitmapBitOrder"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xbitmappad (:return-type int) (:name "XBitmapPad")) 
+(def-exported-foreign-function (xbitmappad (:return-type int) (:name "XBitmapPad"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (ximagebyteorder (:return-type int) (:name "XImageByteOrder")) 
+(def-exported-foreign-function (ximagebyteorder (:return-type int) (:name "XImageByteOrder"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xnextrequest (:return-type unsigned-long) (:name "XNextRequest")) 
+(def-exported-foreign-function (xnextrequest (:return-type unsigned-long) (:name "XNextRequest"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xlastknownrequestprocessed (:return-type unsigned-long) (:name "XLastKnownRequestProcessed")) 
+(def-exported-foreign-function (xlastknownrequestprocessed (:return-type unsigned-long) (:name "XLastKnownRequestProcessed"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xscreenofdisplay (:return-type (:pointer screen)) (:name "XScreenOfDisplay")) 
+(def-exported-foreign-function (xscreenofdisplay (:return-type (:pointer screen)) (:name "XScreenOfDisplay"))
    (dpy (:pointer display))
    (scr int))
 
-(def-exported-foreign-function (xdefaultscreenofdisplay (:return-type (:pointer screen)) (:name "XDefaultScreenOfDisplay")) 
+(def-exported-foreign-function (xdefaultscreenofdisplay (:return-type (:pointer screen)) (:name "XDefaultScreenOfDisplay"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xdisplayofscreen (:return-type (:pointer display)) (:name "XDisplayOfScreen")) 
+(def-exported-foreign-function (xdisplayofscreen (:return-type (:pointer display)) (:name "XDisplayOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xrootwindowofscreen (:return-type window) (:name "XRootWindowOfScreen")) 
+(def-exported-foreign-function (xrootwindowofscreen (:return-type window) (:name "XRootWindowOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xblackpixelofscreen (:return-type unsigned-long) (:name "XBlackPixelOfScreen")) 
+(def-exported-foreign-function (xblackpixelofscreen (:return-type unsigned-long) (:name "XBlackPixelOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xwhitepixelofscreen (:return-type unsigned-long) (:name "XWhitePixelOfScreen")) 
+(def-exported-foreign-function (xwhitepixelofscreen (:return-type unsigned-long) (:name "XWhitePixelOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xdefaultcolormapofscreen (:return-type colormap) (:name "XDefaultColormapOfScreen")) 
+(def-exported-foreign-function (xdefaultcolormapofscreen (:return-type colormap) (:name "XDefaultColormapOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xdefaultdepthofscreen (:return-type int) (:name "XDefaultDepthOfScreen")) 
+(def-exported-foreign-function (xdefaultdepthofscreen (:return-type int) (:name "XDefaultDepthOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xdefaultgcofscreen (:return-type gc) (:name "XDefaultGCOfScreen")) 
+(def-exported-foreign-function (xdefaultgcofscreen (:return-type gc) (:name "XDefaultGCOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xdefaultvisualofscreen (:return-type (:pointer visual)) (:name "XDefaultVisualOfScreen")) 
+(def-exported-foreign-function (xdefaultvisualofscreen (:return-type (:pointer visual)) (:name "XDefaultVisualOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xwidthofscreen (:return-type int) (:name "XWidthOfScreen")) 
+(def-exported-foreign-function (xwidthofscreen (:return-type int) (:name "XWidthOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xheightofscreen (:return-type int) (:name "XHeightOfScreen")) 
+(def-exported-foreign-function (xheightofscreen (:return-type int) (:name "XHeightOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xwidthmmofscreen (:return-type int) (:name "XWidthMMOfScreen")) 
+(def-exported-foreign-function (xwidthmmofscreen (:return-type int) (:name "XWidthMMOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xheightmmofscreen (:return-type int) (:name "XHeightMMOfScreen")) 
+(def-exported-foreign-function (xheightmmofscreen (:return-type int) (:name "XHeightMMOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xplanesofscreen (:return-type int) (:name "XPlanesOfScreen")) 
+(def-exported-foreign-function (xplanesofscreen (:return-type int) (:name "XPlanesOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xcellsofscreen (:return-type int) (:name "XCellsOfScreen")) 
+(def-exported-foreign-function (xcellsofscreen (:return-type int) (:name "XCellsOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xmincmapsofscreen (:return-type int) (:name "XMinCmapsOfScreen")) 
+(def-exported-foreign-function (xmincmapsofscreen (:return-type int) (:name "XMinCmapsOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xmaxcmapsofscreen (:return-type int) (:name "XMaxCmapsOfScreen")) 
+(def-exported-foreign-function (xmaxcmapsofscreen (:return-type int) (:name "XMaxCmapsOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xdoessaveunders (:return-type int) (:name "XDoesSaveUnders")) 
+(def-exported-foreign-function (xdoessaveunders (:return-type int) (:name "XDoesSaveUnders"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xdoesbackingstore (:return-type int) (:name "XDoesBackingStore")) 
+(def-exported-foreign-function (xdoesbackingstore (:return-type int) (:name "XDoesBackingStore"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xeventmaskofscreen (:return-type long) (:name "XEventMaskOfScreen")) 
+(def-exported-foreign-function (xeventmaskofscreen (:return-type long) (:name "XEventMaskOfScreen"))
    (s (:pointer screen)))
 
-(def-exported-foreign-function (xnoop (:name "XNoOp")) 
+(def-exported-foreign-function (xnoop (:name "XNoOp"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (XParseColor (:return-type int) 
+(def-exported-foreign-function (XParseColor (:return-type int)
 					    (:name "XParseColor"))
   (display (:pointer Display))
   (colormap Colormap)
@@ -1042,108 +1042,108 @@
   (width-return (:pointer unsigned-int))
   (height-return (:pointer unsigned-int)))
 
-(def-exported-foreign-function (xmapraised (:name "XMapRaised")) 
+(def-exported-foreign-function (xmapraised (:name "XMapRaised"))
    (dpy (:pointer display))
    (w window))
 
-(def-exported-foreign-function (xmapsubwindows (:name "XMapSubwindows")) 
+(def-exported-foreign-function (xmapsubwindows (:name "XMapSubwindows"))
    (dpy (:pointer display))
    (win window))
 
-(def-exported-foreign-function (xmapwindow (:name "XMapWindow")) 
+(def-exported-foreign-function (xmapwindow (:name "XMapWindow"))
    (dpy (:pointer display))
    (win window))
 
-(def-exported-foreign-function (xmaskevent (:name "XMaskEvent")) 
+(def-exported-foreign-function (xmaskevent (:name "XMaskEvent"))
    (dpy (:pointer display))
    (mask long)
    (event (:pointer xevent)))
 
-(def-exported-foreign-function (xmaxrequestsize (:return-type long) (:name "XMaxRequestSize")) 
+(def-exported-foreign-function (xmaxrequestsize (:return-type long) (:name "XMaxRequestSize"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xresourcemanagerstring (:return-type (:pointer char)) (:name "XResourceManagerString")) 
+(def-exported-foreign-function (xresourcemanagerstring (:return-type (:pointer char)) (:name "XResourceManagerString"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xdisplaymotionbuffersize (:return-type unsigned-long) (:name "XDisplayMotionBufferSize")) 
+(def-exported-foreign-function (xdisplaymotionbuffersize (:return-type unsigned-long) (:name "XDisplayMotionBufferSize"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xdisplaykeycodes (:name "XDisplayKeycodes")) 
+(def-exported-foreign-function (xdisplaykeycodes (:name "XDisplayKeycodes"))
    (dpy (:pointer display))
    (min-keycode-return (:pointer int))
    (max-keycode-return (:pointer int)))
 
-(def-exported-foreign-function (xvisualidfromvisual (:return-type visualid) (:name "XVisualIDFromVisual")) 
+(def-exported-foreign-function (xvisualidfromvisual (:return-type visualid) (:name "XVisualIDFromVisual"))
    (visual (:pointer visual)))
 
-(def-exported-foreign-function (xgetmodifiermapping (:return-type (:pointer xmodifierkeymap)) (:name "XGetModifierMapping")) 
+(def-exported-foreign-function (xgetmodifiermapping (:return-type (:pointer xmodifierkeymap)) (:name "XGetModifierMapping"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xsetmodifiermapping (:return-type int) (:name "XSetModifierMapping")) 
+(def-exported-foreign-function (xsetmodifiermapping (:return-type int) (:name "XSetModifierMapping"))
    (dpy (:pointer display))
    (modifier-map (:pointer xmodifierkeymap)))
 
-(def-exported-foreign-function (xnewmodifiermap (:return-type (:pointer xmodifierkeymap)) (:name "XNewModifiermap")) 
+(def-exported-foreign-function (xnewmodifiermap (:return-type (:pointer xmodifierkeymap)) (:name "XNewModifiermap"))
    (keyspermodifier int))
 
-(def-exported-foreign-function (xfreemodifiermap (:name "XFreeModifiermap")) 
+(def-exported-foreign-function (xfreemodifiermap (:name "XFreeModifiermap"))
    (map (:pointer xmodifierkeymap)))
 
-(def-exported-foreign-function (xinsertmodifiermapentry (:return-type (:pointer xmodifierkeymap)) (:name "XInsertModifiermapEntry")) 
+(def-exported-foreign-function (xinsertmodifiermapentry (:return-type (:pointer xmodifierkeymap)) (:name "XInsertModifiermapEntry"))
    (map (:pointer xmodifierkeymap))
    (keysym :character) ;; (keysym keycode)
    (modifier int))
 
-(def-exported-foreign-function (xdeletemodifiermapentry (:return-type (:pointer xmodifierkeymap)) (:name "XDeleteModifiermapEntry")) 
+(def-exported-foreign-function (xdeletemodifiermapentry (:return-type (:pointer xmodifierkeymap)) (:name "XDeleteModifiermapEntry"))
    (map (:pointer xmodifierkeymap))
    (keysym :character) ;; (keysym keycode)
    (modifier int))
 
-(def-exported-foreign-function (xmovewindow (:name "XMoveWindow")) 
+(def-exported-foreign-function (xmovewindow (:name "XMoveWindow"))
    (dpy (:pointer display))
    (w window)
    (x int)
    (y int))
 
-(def-exported-foreign-function (xnextevent (:name "XNextEvent")) 
+(def-exported-foreign-function (xnextevent (:name "XNextEvent"))
    (dpy (:pointer display))
    (event (:pointer xevent)))
 
-(def-exported-foreign-function (xopendisplay (:return-type (:pointer display)) (:name "XOpenDisplay")) 
+(def-exported-foreign-function (xopendisplay (:return-type (:pointer display)) (:name "XOpenDisplay"))
    (display (:pointer char)))
 
-(def-exported-foreign-function (xpeekevent (:name "XPeekEvent")) 
+(def-exported-foreign-function (xpeekevent (:name "XPeekEvent"))
    (dpy (:pointer display))
    (event (:pointer xevent)))
 
-(def-exported-foreign-function (xpeekifevent (:name "XPeekIfEvent")) 
+(def-exported-foreign-function (xpeekifevent (:name "XPeekIfEvent"))
    (dpy (:pointer display))
    (event (:pointer xevent))
    (predicate (:pointer :pointer))
    (arg (:pointer char)))
 
-(def-exported-foreign-function (xeventsqueued (:return-type int) (:name "XEventsQueued")) 
+(def-exported-foreign-function (xeventsqueued (:return-type int) (:name "XEventsQueued"))
    (dpy (:pointer display))
    (mode int))
 
-(def-exported-foreign-function (xpending (:return-type fixnum-int) (:name "XPending")) 
+(def-exported-foreign-function (xpending (:return-type fixnum-int) (:name "XPending"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xsetwindowbackgroundpixmap (:name "XSetWindowBackgroundPixmap")) 
+(def-exported-foreign-function (xsetwindowbackgroundpixmap (:name "XSetWindowBackgroundPixmap"))
    (dpy (:pointer display))
    (w window)
    (pixmap pixmap))
 
-(def-exported-foreign-function (xsetwindowborderpixmap (:name "XSetWindowBorderPixmap")) 
+(def-exported-foreign-function (xsetwindowborderpixmap (:name "XSetWindowBorderPixmap"))
    (dpy (:pointer display))
    (w window)
    (pixmap pixmap))
 
-(def-exported-foreign-function (xputbackevent (:name "XPutBackEvent")) 
+(def-exported-foreign-function (xputbackevent (:name "XPutBackEvent"))
    (dpy (:pointer display))
    (event (:pointer xevent)))
 
-(def-exported-foreign-function (xputimage (:name "XPutImage")) 
+(def-exported-foreign-function (xputimage (:name "XPutImage"))
    (dpy (:pointer display))
    (d drawable)
    (gc gc)
@@ -1155,7 +1155,7 @@
    (req-xoffset int)
    (req-yoffset int))
 
-(def-exported-foreign-function (xquerybestsize (:return-type int) (:name "XQueryBestSize")) 
+(def-exported-foreign-function (xquerybestsize (:return-type int) (:name "XQueryBestSize"))
    (dpy (:pointer display))
    (class int)
    (drawable drawable)
@@ -1164,18 +1164,18 @@
    (ret-width (:pointer unsigned-int))
    (ret-height (:pointer unsigned-int)))
 
-(def-exported-foreign-function (xquerycolor (:name "XQueryColor")) 
+(def-exported-foreign-function (xquerycolor (:name "XQueryColor"))
    (dpy (:pointer display))
    (cmap colormap)
    (def (:pointer xcolor)))
 
-(def-exported-foreign-function (xquerycolors (:name "XQueryColors")) 
+(def-exported-foreign-function (xquerycolors (:name "XQueryColors"))
    (dpy (:pointer display))
    (cmap colormap)
    (defs (:pointer xcolor))
    (ncolors int))
 
-(def-exported-foreign-function (xquerybestcursor (:return-type int) (:name "XQueryBestCursor")) 
+(def-exported-foreign-function (xquerybestcursor (:return-type int) (:name "XQueryBestCursor"))
    (dpy (:pointer display))
    (drawable drawable)
    (width unsigned-int)
@@ -1183,18 +1183,18 @@
    (ret-width (:pointer unsigned-int))
    (ret-height (:pointer unsigned-int)))
 
-(def-exported-foreign-function (xqueryextension (:return-type int) (:name "XQueryExtension")) 
+(def-exported-foreign-function (xqueryextension (:return-type int) (:name "XQueryExtension"))
    (dpy (:pointer display))
    (name (:pointer char))
    (major-opcode (:pointer int))
    (first-event (:pointer int))
    (first-error (:pointer int)))
 
-(def-exported-foreign-function (xquerykeymap (:name "XQueryKeymap")) 
+(def-exported-foreign-function (xquerykeymap (:name "XQueryKeymap"))
    (dpy (:pointer display))
    (keys (:array char (32))))
 
-(def-exported-foreign-function (xquerypointer (:return-type int) (:name "XQueryPointer")) 
+(def-exported-foreign-function (xquerypointer (:return-type int) (:name "XQueryPointer"))
    (dpy (:pointer display))
    (w window)
    (root (:pointer window))
@@ -1205,7 +1205,7 @@
    (win-y (:pointer int))
    (mask (:pointer unsigned-int)))
 
-(def-exported-foreign-function (xquerybeststipple (:return-type int) (:name "XQueryBestStipple")) 
+(def-exported-foreign-function (xquerybeststipple (:return-type int) (:name "XQueryBestStipple"))
    (dpy (:pointer display))
    (drawable drawable)
    (width unsigned-int)
@@ -1213,7 +1213,7 @@
    (ret-width (:pointer unsigned-int))
    (ret-height (:pointer unsigned-int)))
 
-(def-exported-foreign-function (xquerytextextents16 (:name "XQueryTextExtents16")) 
+(def-exported-foreign-function (xquerytextextents16 (:name "XQueryTextExtents16"))
    (dpy (:pointer display))
    (fid font)
    (string (:pointer xchar2b))
@@ -1223,7 +1223,7 @@
    (font-descent (:pointer int))
    (overall (:pointer xcharstruct)))
 
-(def-exported-foreign-function (xquerytextextents (:name "XQueryTextExtents")) 
+(def-exported-foreign-function (xquerytextextents (:name "XQueryTextExtents"))
    (dpy (:pointer display))
    (fid font)
    (string (:pointer char))
@@ -1233,7 +1233,7 @@
    (font-descent (:pointer int))
    (overall (:pointer xcharstruct)))
 
-(def-exported-foreign-function (xquerybesttile (:return-type int) (:name "XQueryBestTile")) 
+(def-exported-foreign-function (xquerybesttile (:return-type int) (:name "XQueryBestTile"))
    (dpy (:pointer display))
    (drawable drawable)
    (width unsigned-int)
@@ -1241,7 +1241,7 @@
    (ret-width (:pointer unsigned-int))
    (ret-height (:pointer unsigned-int)))
 
-(def-exported-foreign-function (xquerytree (:return-type int) (:name "XQueryTree")) 
+(def-exported-foreign-function (xquerytree (:return-type int) (:name "XQueryTree"))
    (dpy (:pointer display))
    (w window)
    (root (:pointer window))
@@ -1249,35 +1249,35 @@
    (children (:pointer (:pointer window)))
    (nchildren (:pointer unsigned-int)))
 
-(def-exported-foreign-function (xraisewindow (:name "XRaiseWindow")) 
+(def-exported-foreign-function (xraisewindow (:name "XRaiseWindow"))
    (dpy (:pointer display))
    (w window))
 
-(def-exported-foreign-function (xrecolorcursor (:name "XRecolorCursor")) 
+(def-exported-foreign-function (xrecolorcursor (:name "XRecolorCursor"))
    (dpy (:pointer display))
    (cursor cursor)
    (foreground (:pointer xcolor))
    (background (:pointer xcolor)))
 
-(def-exported-foreign-function (xconfigurewindow (:name "XConfigureWindow")) 
+(def-exported-foreign-function (xconfigurewindow (:name "XConfigureWindow"))
    (dpy (:pointer display))
    (w window)
    (mask unsigned-int)
    (changes (:pointer xwindowchanges)))
 
-(def-exported-foreign-function (xreparentwindow (:name "XReparentWindow")) 
+(def-exported-foreign-function (xreparentwindow (:name "XReparentWindow"))
    (dpy (:pointer display))
    (w window)
    (p window)
    (x int)
    (y int))
 
-(def-exported-foreign-function (xrestackwindows (:name "XRestackWindows")) 
+(def-exported-foreign-function (xrestackwindows (:name "XRestackWindows"))
    (dpy (:pointer display))
    (windows (:pointer window))
    (n int))
 
-(def-exported-foreign-function (xrotatewindowproperties (:name "XRotateWindowProperties")) 
+(def-exported-foreign-function (xrotatewindowproperties (:name "XRotateWindowProperties"))
    (dpy (:pointer display))
    (w window)
    (properties (:pointer atom))
@@ -1289,19 +1289,19 @@
    (w window)
    (mask long))
 
-(def-exported-foreign-function (xsendevent (:return-type int) (:name "XSendEvent")) 
+(def-exported-foreign-function (xsendevent (:return-type int) (:name "XSendEvent"))
    (dpy (:pointer display))
    (w window)
    (propagate int)
    (event-mask long)
    (event (:pointer xevent)))
 
-(def-exported-foreign-function (xsetbackground (:name "XSetBackground")) 
+(def-exported-foreign-function (xsetbackground (:name "XSetBackground"))
    (dpy (:pointer display))
    (gc gc)
    (background unsigned-long))
 
-(def-exported-foreign-function (xsetcliprectangles (:name "XSetClipRectangles")) 
+(def-exported-foreign-function (xsetcliprectangles (:name "XSetClipRectangles"))
    (dpy (:pointer display))
    (gc gc)
    (clip-x-origin int)
@@ -1310,57 +1310,57 @@
    (n int)
    (ordering int))
 
-(def-exported-foreign-function (xsetclipmask (:name "XSetClipMask")) 
+(def-exported-foreign-function (xsetclipmask (:name "XSetClipMask"))
    (dpy (:pointer display))
    (gc gc)
    (mask pixmap))
 
-(def-exported-foreign-function (xsetcliporigin (:name "XSetClipOrigin")) 
+(def-exported-foreign-function (xsetcliporigin (:name "XSetClipOrigin"))
    (dpy (:pointer display))
    (gc gc)
    (xorig int)
    (yorig int))
 
-(def-exported-foreign-function (xsetdashes (:name "XSetDashes")) 
+(def-exported-foreign-function (xsetdashes (:name "XSetDashes"))
    (dpy (:pointer display))
    (gc gc)
    (dash-offset int)
    (list (:pointer char))
    (n int))
 
-(def-exported-foreign-function (xsetfontpath (:name "XSetFontPath")) 
+(def-exported-foreign-function (xsetfontpath (:name "XSetFontPath"))
    (dpy (:pointer display))
    (directories (:pointer (:pointer char)))
    (ndirs int))
 
-(def-exported-foreign-function (xsetfont (:name "XSetFont")) 
+(def-exported-foreign-function (xsetfont (:name "XSetFont"))
    (dpy (:pointer display))
    (gc gc)
    (font font))
 
-(def-exported-foreign-function (xsetforeground (:name "XSetForeground")) 
+(def-exported-foreign-function (xsetforeground (:name "XSetForeground"))
    (dpy (:pointer display))
    (gc gc)
    (foreground unsigned-long))
 
-(def-exported-foreign-function (xsetfunction (:name "XSetFunction")) 
+(def-exported-foreign-function (xsetfunction (:name "XSetFunction"))
    (dpy (:pointer display))
    (gc gc)
    (function int))
 
-(def-exported-foreign-function (xsetcommand (:name "XSetCommand")) 
+(def-exported-foreign-function (xsetcommand (:name "XSetCommand"))
    (dpy (:pointer display))
    (w window)
    (argv (:pointer (:pointer char)))
    (argc int))
 
-(def-exported-foreign-function (xsetinputfocus (:name "XSetInputFocus")) 
+(def-exported-foreign-function (xsetinputfocus (:name "XSetInputFocus"))
    (dpy (:pointer display))
    (focus window)
    (revert-to int)
    (time :unsigned-32bit))
 
-(def-exported-foreign-function (xsetlineattributes (:name "XSetLineAttributes")) 
+(def-exported-foreign-function (xsetlineattributes (:name "XSetLineAttributes"))
    (dpy (:pointer display))
    (gc gc)
    (linewidth unsigned-int)
@@ -1368,37 +1368,37 @@
    (capstyle int)
    (joinstyle int))
 
-(def-exported-foreign-function (xsetplanemask (:name "XSetPlaneMask")) 
+(def-exported-foreign-function (xsetplanemask (:name "XSetPlaneMask"))
    (dpy (:pointer display))
    (gc gc)
    (planemask unsigned-long))
 
-(def-exported-foreign-function (xsetpointermapping (:return-type int) (:name "XSetPointerMapping")) 
+(def-exported-foreign-function (xsetpointermapping (:return-type int) (:name "XSetPointerMapping"))
    (dpy (:pointer display))
    (map (:pointer unsigned-char))
    (nmaps int))
 
-(def-exported-foreign-function (xchangekeyboardmapping (:name "XChangeKeyboardMapping")) 
+(def-exported-foreign-function (xchangekeyboardmapping (:name "XChangeKeyboardMapping"))
    (dpy (:pointer display))
    (first-keycode int)
    (keysyms-per-keycode int)
    (keysyms (:pointer keysym))
    (nkeycodes int))
 
-(def-exported-foreign-function (xsetselectionowner (:name "XSetSelectionOwner")) 
+(def-exported-foreign-function (xsetselectionowner (:name "XSetSelectionOwner"))
    (dpy (:pointer display))
    (selection :unsigned-32bit)
    (owner window)
    (time :unsigned-32bit))
 
-(def-exported-foreign-function (xsetscreensaver (:name "XSetScreenSaver")) 
+(def-exported-foreign-function (xsetscreensaver (:name "XSetScreenSaver"))
    (dpy (:pointer display))
    (timeout int)
    (interval int)
    (prefer-blank int)
    (allow-exp int))
 
-(def-exported-foreign-function (xsetstate (:name "XSetState")) 
+(def-exported-foreign-function (xsetstate (:name "XSetState"))
    (dpy (:pointer display))
    (gc gc)
    (function int)
@@ -1406,69 +1406,69 @@
    (foreground unsigned-long)
    (background unsigned-long))
 
-(def-exported-foreign-function (xsetstipple (:name "XSetStipple")) 
+(def-exported-foreign-function (xsetstipple (:name "XSetStipple"))
    (dpy (:pointer display))
    (gc gc)
    (stipple pixmap))
 
-(def-exported-foreign-function (xsettsorigin (:name "XSetTSOrigin")) 
+(def-exported-foreign-function (xsettsorigin (:name "XSetTSOrigin"))
    (dpy (:pointer display))
    (gc gc)
    (x int)
    (y int))
 
-(def-exported-foreign-function (xsettile (:name "XSetTile")) 
+(def-exported-foreign-function (xsettile (:name "XSetTile"))
    (dpy (:pointer display))
    (gc gc)
    (tile pixmap))
 
-(def-exported-foreign-function (xstorecolor (:name "XStoreColor")) 
+(def-exported-foreign-function (xstorecolor (:name "XStoreColor"))
    (dpy (:pointer display))
    (cmap colormap)
    (def (:pointer xcolor)))
 
-(def-exported-foreign-function (xstorecolors (:name "XStoreColors")) 
+(def-exported-foreign-function (xstorecolors (:name "XStoreColors"))
    (dpy (:pointer display))
    (cmap colormap)
    (defs (:pointer xcolor))
    (ncolors int))
 
-(def-exported-foreign-function (xstorenamedcolor (:name "XStoreNamedColor")) 
+(def-exported-foreign-function (xstorenamedcolor (:name "XStoreNamedColor"))
    (dpy (:pointer display))
    (cmap colormap)
    (name (:pointer char))
    (pixel unsigned-long)
    (flags int))
 
-(def-exported-foreign-function (xstorename (:name "XStoreName")) 
+(def-exported-foreign-function (xstorename (:name "XStoreName"))
    (dpy (:pointer display))
    (w window)
    (name (:pointer char)))
 
-(def-exported-foreign-function (xseticonname (:name "XSetIconName")) 
+(def-exported-foreign-function (xseticonname (:name "XSetIconName"))
    (dpy (:pointer display))
    (w window)
    (icon-name (:pointer char)))
 
-(def-exported-foreign-function (xstringtokeysym (:return-type keysym) (:name "XStringToKeysym")) 
+(def-exported-foreign-function (xstringtokeysym (:return-type keysym) (:name "XStringToKeysym"))
    (s (:pointer char)))
 
-(def-exported-foreign-function (xkeysymtostring (:return-type (:pointer char)) (:name "XKeysymToString")) 
+(def-exported-foreign-function (xkeysymtostring (:return-type (:pointer char)) (:name "XKeysymToString"))
    (ks keysym))
 
-(def-exported-foreign-function (xsync (:name "XSync")) 
+(def-exported-foreign-function (xsync (:name "XSync"))
    (dpy (:pointer display))
    (discard int))
 
-(def-exported-foreign-function (xsynchronize (:return-type (:pointer :pointer)) (:name "XSynchronize")) 
+(def-exported-foreign-function (xsynchronize (:return-type (:pointer :pointer)) (:name "XSynchronize"))
    (dpy (:pointer display))
    (onoff int))
 
-(def-exported-foreign-function (xsetafterfunction (:return-type (:pointer :pointer)) (:name "XSetAfterFunction")) 
+(def-exported-foreign-function (xsetafterfunction (:return-type (:pointer :pointer)) (:name "XSetAfterFunction"))
    (dpy (:pointer display))
    (func (:pointer :pointer)))
 
-(def-exported-foreign-function (xtextextents (:name "XTextExtents")) 
+(def-exported-foreign-function (xtextextents (:name "XTextExtents"))
    (fontstruct (:pointer xfontstruct))
    (string (:pointer char))
    (nchars int)
@@ -1477,12 +1477,12 @@
    (font-descent (:pointer int))
    (overall (:pointer xcharstruct)))
 
-(def-exported-foreign-function (xtextwidth (:return-type int) (:name "XTextWidth")) 
+(def-exported-foreign-function (xtextwidth (:return-type int) (:name "XTextWidth"))
    (fontstruct (:pointer xfontstruct))
    (string (:pointer char))
    (count int))
 
-(def-exported-foreign-function (xtextextents16 (:name "XTextExtents16")) 
+(def-exported-foreign-function (xtextextents16 (:name "XTextExtents16"))
    (fontstruct (:pointer xfontstruct))
    (string (:pointer xchar2b))
    (nchars int)
@@ -1491,12 +1491,12 @@
    (font-descent (:pointer int))
    (overall (:pointer xcharstruct)))
 
-(def-exported-foreign-function (xtextwidth16 (:return-type int) (:name "XTextWidth16")) 
+(def-exported-foreign-function (xtextwidth16 (:return-type int) (:name "XTextWidth16"))
    (fontstruct (:pointer xfontstruct))
    (string (:pointer xchar2b))
    (count int))
 
-(def-exported-foreign-function (xtranslatecoordinates (:return-type int) (:name "XTranslateCoordinates")) 
+(def-exported-foreign-function (xtranslatecoordinates (:return-type int) (:name "XTranslateCoordinates"))
    (dpy (:pointer display))
    (src-win window)
    (dest-win window)
@@ -1506,50 +1506,50 @@
    (dst-y (:pointer int))
    (child (:pointer window)))
 
-(def-exported-foreign-function (xundefinecursor (:name "XUndefineCursor")) 
+(def-exported-foreign-function (xundefinecursor (:name "XUndefineCursor"))
    (dpy (:pointer display))
    (w window))
 
-(def-exported-foreign-function (xungrabbutton (:name "XUngrabButton")) 
+(def-exported-foreign-function (xungrabbutton (:name "XUngrabButton"))
    (dpy (:pointer display))
    (button unsigned-int)
    (modifiers unsigned-int)
    (grab-window window))
 
-(def-exported-foreign-function (xungrabkeyboard (:name "XUngrabKeyboard")) 
+(def-exported-foreign-function (xungrabkeyboard (:name "XUngrabKeyboard"))
    (dpy (:pointer display))
    (time :unsigned-32bit))
 
-(def-exported-foreign-function (xungrabkey (:name "XUngrabKey")) 
+(def-exported-foreign-function (xungrabkey (:name "XUngrabKey"))
    (dpy (:pointer display))
    (key int)
    (modifiers unsigned-int)
    (grab-window window))
 
-(def-exported-foreign-function (xungrabpointer (:name "XUngrabPointer")) 
+(def-exported-foreign-function (xungrabpointer (:name "XUngrabPointer"))
    (dpy (:pointer display))
    (time :unsigned-32bit))
 
-(def-exported-foreign-function (xungrabserver (:name "XUngrabServer")) 
+(def-exported-foreign-function (xungrabserver (:name "XUngrabServer"))
    (dpy (:pointer display)))
 
-(def-exported-foreign-function (xuninstallcolormap (:name "XUninstallColormap")) 
+(def-exported-foreign-function (xuninstallcolormap (:name "XUninstallColormap"))
    (dpy (:pointer display))
    (cmap colormap))
 
-(def-exported-foreign-function (xunloadfont (:name "XUnloadFont")) 
+(def-exported-foreign-function (xunloadfont (:name "XUnloadFont"))
    (dpy (:pointer display))
    (font font))
 
-(def-exported-foreign-function (xunmapsubwindows (:name "XUnmapSubwindows")) 
+(def-exported-foreign-function (xunmapsubwindows (:name "XUnmapSubwindows"))
    (dpy (:pointer display))
    (win window))
 
-(def-exported-foreign-function (xunmapwindow (:name "XUnmapWindow")) 
+(def-exported-foreign-function (xunmapwindow (:name "XUnmapWindow"))
    (dpy (:pointer display))
    (w window))
 
-(def-exported-foreign-function (xwarppointer (:name "XWarpPointer")) 
+(def-exported-foreign-function (xwarppointer (:name "XWarpPointer"))
    (dpy (:pointer display))
    (src-win window)
    (dest-win window)
@@ -1560,13 +1560,13 @@
    (dest-x int)
    (dest-y int))
 
-(def-exported-foreign-function (xwindowevent (:name "XWindowEvent")) 
+(def-exported-foreign-function (xwindowevent (:name "XWindowEvent"))
    (dpy (:pointer display))
    (w window)
    (mask long)
    (event (:pointer xevent)))
 
-(def-exported-foreign-function (xcreatewindow (:return-type window) (:name "XCreateWindow")) 
+(def-exported-foreign-function (xcreatewindow (:return-type window) (:name "XCreateWindow"))
    (dpy (:pointer display))
    (parent window)
    (x int)
@@ -1580,7 +1580,7 @@
    (valuemask unsigned-long)
    (attributes (:pointer xsetwindowattributes)))
 
-(def-exported-foreign-function (xfree (:name "XFree")) 
+(def-exported-foreign-function (xfree (:name "XFree"))
    (data (:pointer char)))
 
 
@@ -1645,15 +1645,15 @@
 
 ;;; Xlib Output Functions
 ;;;
-;;; All of the following functions have been modified - the type of int coordinate 
+;;; All of the following functions have been modified - the type of int coordinate
 ;;; arguments have been changed to fixnum-int, the type of drawable arguments
 ;;; have been changed to fixnum-drawable, the type of int and unsigned-int dimensions
-;;; (length, npoints etc) arguments have been changed to fixnum-int or fixnum-unsigned-int, 
-;;; and the :return-type option has been omitted (to avoid consing up an integer 
-;;; return value).  A function that draws a single character, XDrawChar function has 
+;;; (length, npoints etc) arguments have been changed to fixnum-int or fixnum-unsigned-int,
+;;; and the :return-type option has been omitted (to avoid consing up an integer
+;;; return value).  A function that draws a single character, XDrawChar function has
 ;;; been added.
 
-(def-exported-foreign-function (xdrawarc (:name "XDrawArc")) 
+(def-exported-foreign-function (xdrawarc (:name "XDrawArc"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
@@ -1664,14 +1664,14 @@
    (angle1 fixnum-int)
    (angle2 fixnum-int))
 
-(def-exported-foreign-function (xdrawarcs (:name "XDrawArcs")) 
+(def-exported-foreign-function (xdrawarcs (:name "XDrawArcs"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
    (arcs (:pointer xarc))
-   (n-arcs fixnum-int)) 
+   (n-arcs fixnum-int))
 
-(def-exported-foreign-function (xdrawline (:name "XDrawLine")) 
+(def-exported-foreign-function (xdrawline (:name "XDrawLine"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
@@ -1680,80 +1680,80 @@
    (x2 fixnum-int)
    (y2 fixnum-int))
 
-(def-exported-foreign-function (xdrawlines (:name "XDrawLines")) 
+(def-exported-foreign-function (xdrawlines (:name "XDrawLines"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
    (points (:pointer xpoint))
-   (npoints fixnum-int) 
-   (mode fixnum-int))   
+   (npoints fixnum-int)
+   (mode fixnum-int))
 
-(def-exported-foreign-function (xdrawpoint (:name "XDrawPoint")) 
+(def-exported-foreign-function (xdrawpoint (:name "XDrawPoint"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
    (x fixnum-int)
    (y fixnum-int))
 
-(def-exported-foreign-function (xdrawpoints (:name "XDrawPoints")) 
+(def-exported-foreign-function (xdrawpoints (:name "XDrawPoints"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
    (points (:pointer xpoint))
-   (n-points fixnum-int) 
-   (mode fixnum-int))    
+   (n-points fixnum-int)
+   (mode fixnum-int))
 
-(def-exported-foreign-function (xdrawrectangle (:name "XDrawRectangle")) 
+(def-exported-foreign-function (xdrawrectangle (:name "XDrawRectangle"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
    (x fixnum-int)
    (y fixnum-int)
-   (width fixnum-unsigned-int)     
-   (height fixnum-unsigned-int))   
+   (width fixnum-unsigned-int)
+   (height fixnum-unsigned-int))
 
-(def-exported-foreign-function (xdrawrectangles (:name "XDrawRectangles")) 
+(def-exported-foreign-function (xdrawrectangles (:name "XDrawRectangles"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
    (rects (:pointer xrectangle))
    (n-rects fixnum-int)) ;; was int
 
-(def-exported-foreign-function (xdrawsegments (:name "XDrawSegments")) 
+(def-exported-foreign-function (xdrawsegments (:name "XDrawSegments"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
    (segments (:pointer xsegment))
-   (nsegments fixnum-int)) 
+   (nsegments fixnum-int))
 
-(def-exported-foreign-function (xdrawimagestring (:name "XDrawImageString")) 
+(def-exported-foreign-function (xdrawimagestring (:name "XDrawImageString"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
    (x fixnum-int)
    (y fixnum-int)
    (string (:pointer char))
-   (length fixnum-int)) 
+   (length fixnum-int))
 
-(def-exported-foreign-function (xdrawimagestring16 (:name "XDrawImageString16")) 
+(def-exported-foreign-function (xdrawimagestring16 (:name "XDrawImageString16"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
    (x fixnum-int)
    (y fixnum-int)
    (string (:pointer xchar2b))
-   (length fixnum-int)) 
+   (length fixnum-int))
 
-(def-exported-foreign-function (xdrawtext (:name "XDrawText")) 
+(def-exported-foreign-function (xdrawtext (:name "XDrawText"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
    (x fixnum-int)
    (y fixnum-int)
    (items (:pointer xtextitem))
-   (nitems fixnum-int)) 
+   (nitems fixnum-int))
 
-(def-exported-foreign-function (xdrawtext16 (:name "XDrawText16")) 
+(def-exported-foreign-function (xdrawtext16 (:name "XDrawText16"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
@@ -1762,7 +1762,7 @@
    (items (:pointer xtextitem16))
    (nitems fixnum-int))
 
-(def-exported-foreign-function (xdrawstring (:name "XDrawString")) 
+(def-exported-foreign-function (xdrawstring (:name "XDrawString"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
@@ -1771,7 +1771,7 @@
    (string (:pointer char))
    (length fixnum-int))
 
-(def-exported-foreign-function (xdrawstring16 (:name "XDrawString16")) 
+(def-exported-foreign-function (xdrawstring16 (:name "XDrawString16"))
    (dpy (:pointer display))
    (d fixnum-drawable)
    (gc gc)
@@ -1800,8 +1800,8 @@
    (start fixnum-int)
    (end fixnum-int))
 
-(def-exported-foreign-function 
-  (xpermalloc (:return-type (:pointer char)) 
+(def-exported-foreign-function
+  (xpermalloc (:return-type (:pointer char))
 	      (:name "Xpermalloc"))
   (size unsigned-int))
 
@@ -1942,10 +1942,10 @@
   (argc (:pointer int))
   (argv (:pointer (:pointer char))))
 
-(def-exported-foreign-function (xallocwmhints 
+(def-exported-foreign-function (xallocwmhints
 				(:name "XAllocWMHints")
 				(:return-type (:pointer xwmhints))))
-  
+
 (def-exported-foreign-function (xsetwmhints (:name "XSetWMHints"))
   (display (:pointer display))
   (window window)
@@ -1959,7 +1959,7 @@
 (def-exported-foreign-function (xallocsizehints
 				(:name "XAllocSizeHints")
 				(:return-type (:pointer xsizehints))))
-  
+
 (def-exported-foreign-function (xsetwmnormalhints (:return-type void)
 						  (:name "XSetWMNormalHints"))
   (display (:pointer display))
@@ -2000,7 +2000,7 @@
   (keysym-return (:pointer keysym))
   (status-in-out (:pointer xcomposestatus)))
 
-(def-exported-foreign-function (xiconifywindow (:return-type int) (:name "XIconifyWindow")) 
+(def-exported-foreign-function (xiconifywindow (:return-type int) (:name "XIconifyWindow"))
   (dpy (:pointer display))
   (win window)
   (scr int))
@@ -2015,6 +2015,11 @@
     (vinfo-return (:pointer visual-info)))
 
 
-(def-exported-foreign-function (_xflushgccache (:name "_XFlushGCCache")) 
+(def-exported-foreign-function (_xflushgccache (:name "_XFlushGCCache"))
    (dpy (:pointer display))
-   (gc gc))
+  (gc gc))
+
+(def-exported-foreign-function (_xgetbitsperpixel (:return-type int)
+						  (:name "_XGetBitsPerPixel"))
+    (dpy (:pointer display))
+  (depth int))
-- 
GitLab