From b1df6f1b35cfef766fb643b00a8f2569847c04f1 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Tue, 11 Aug 1992 15:18:38 +0000
Subject: [PATCH] This is CLX R5.01

---
 clx/CHANGES         | 338 ++--------------------------
 clx/attributes.lisp |  48 ++--
 clx/buffer.lisp     |  21 +-
 clx/bufmac.lisp     |  12 +-
 clx/clx.lisp        |  98 ++++----
 clx/cmudep.lisp     |  19 ++
 clx/defsystem.lisp  |  28 ++-
 clx/depdefs.lisp    |  24 +-
 clx/dependent.lisp  | 537 +++++++++++++++++++++++++++++++-------------
 clx/display.lisp    | 109 ++++++---
 clx/doc.lisp        | 473 +++++++++++++++++++-------------------
 clx/fonts.lisp      |  29 ++-
 clx/gcontext.lisp   |  30 +--
 clx/generalock.lisp |  10 +
 clx/graphics.lisp   |   2 +-
 clx/image.lisp      |  44 ++--
 clx/input.lisp      |  51 +++--
 clx/macros.lisp     |  39 ++--
 clx/manager.lisp    | 108 ++++-----
 clx/package.lisp    |   5 +-
 clx/requests.lisp   |  98 ++++----
 clx/resource.lisp   |  32 +--
 clx/text.lisp       |  39 ++--
 clx/translate.lisp  |  46 ++--
 24 files changed, 1147 insertions(+), 1093 deletions(-)
 create mode 100644 clx/cmudep.lisp

diff --git a/clx/CHANGES b/clx/CHANGES
index e6468aeb7..36bbe0da8 100644
--- a/clx/CHANGES
+++ b/clx/CHANGES
@@ -1,330 +1,40 @@
-R5 changes: (see below for details)
+Details of changes since R5:
 
-o Numerous bug fixes
+Changes in CLX 5.01:
 
-o Continued gradual conversion towards ANSI Common Lisp
+Support for MIT-MAGIC-COOKIE-1 authorization has been added.
 
-o Performance improvements to image code
+All VALUES declarations have been changed to CLX-VALUES declarations.
+VALUES is a CL type name and cannot be used as a declaration name.
 
-o Multiprocess locking and error reporting made more robust
+All ARRAY-REGISTER declarations have been removed as Genera no longer
+needs them.
 
-o Event queue consing reduced
+Many type declarations have been corrected or tightened up now that some
+Lisps look at them.
 
-o ICCCM support
+Print functions have been defined for bitmap and pixmap formats.
 
-Details of changes since R4:
+The DISPLAY-PLIST slot will be initialized to NIL.
 
-R4.1 changes:
+When debugging, don't optimize SPEED in the buffer macros.
 
-o Fix reported bugs and to include the vendor-specific
-  bug-fixing and performance-improving patches that I recently received.
+Make the CARD8<->CHAR and the window manager code work for sparse
+character sets (where some codes do not have corresponding characters).
 
-o Code compiled with the R4 CLX will work with the R4.1X CLX, but code
-  compiled with the R4.1X CLX will NOT work with the R4 CLX.  I made an effort
-  to ensure backward binary compatibility with R4 CLX so that old code doesn't
-  have to be recompiled to still work.  It does have to be recompiled to fix
-  an event-queue bug, since the fix involved a change to the event-loop macro.
+The default gcontext extension set and copy functions will take the
+correct number of arguments.
 
-R4.2 changes:
+PUT-IMAGE will now work for 24-bit images.
 
-o Atoms and visuals are now correctly maintained in a separate namespace from 
-  windows, pixmaps, cursors, fonts, gcontexts, and colormaps.
+The buffer accessors for MEMBER8, etc., will use the standard mechanisms
+for reporting type errors.
 
-o I have made an attempt to make socket code work for kcl and ibcl.  I have
-  akcl here, but not kcl and ibcl, so it's only guesswork that kcl and ibcl 
-  works.
+Typographical errors in SET-WM-PROPERTIES, SET-STANDARD-COLORMAP, and
+POINTER-CONTROL have been fixed.
 
-o compile-clx and load-clx do more pathname merging to work around problems
-  in some lisp implementations. *default-pathname-defaults* is never bound 
-  anymore.
+Symbolics systems will do lazy macroexpansion in the buffer macros.
 
-o Some ansi common lisp stuff.  If you have :ansi-common-lisp on *features*,
-  CLX will:
-
-  - Use the common-lisp package instead of the lisp package.
-
-  - Use the common lisp condition system, being careful not to stomp on 
-    define-condition and type-error.
-
-  - Use declaim instead of proclaim.
-
-  - Use the dynamic-extent declaration for rest args and closures.
-
-  - Use print-unreadable-object.
-
-o Code compiled with the R4 and R4.1 CLX will work with the R4.2 CLX, provided
-  you don't have :ansi-common-lisp on your features list.  Code compiled with 
-  the R4.2 CLX will NOT work with the R4 CLX.
-
-R4.3 changes:
-
-o Changed the ansi-common-lisp feature to clx-ansi-common-lisp.
-
-o A new package.l file has been introduced.  All the package operations that
-  were in the other files have been moved to package.l.  Because of this, 
-  the compile-clx and load-clx functions which are defined in the defsystem.l
-  file have been moved to the user package from the xlib package, since the xlib 
-  package isn't defined when the defsystem.l file is loaded.
-
-o excldefsys.l has been merged into defsystem.l.  You don't have to rename
-  excldefsys.l to defsystem.l anymore.
-
-o User-specified-size/position-p hints are now set correctly.
-  These hints were being ignored if the size-hints structure did not
-  define the corresponding geometry slots. But ICCCM declares these
-  slots to be obsolete.
-
-o (setf wm-command) has been changed to use PRIN1 inside the ANSI Common Lisp
-  form WITH-STANDARD-IO-SYNTAX (or the equivalent defined in dependent.l), with
-  elements of command separated by NULL characters.  This enables 
-    (with-standard-io-syntax (mapcar #'read-from-string (wm-command window)))
-  to recover a lisp command.
-
-o A typo in X-TYPE-ERROR has been fixed.
-
-o The WITH-GCONTEXT macro has been changed so that if you supply nil for a
-  property value, WITH-GCONTEXT is will leave the property unchanged.  It used
-  to always change the property without regard for whether the supplied value
-  was nil.  This change to how the macro expands, so user code has to be 
-  recompiled for the change to take effect.
-
-o Since ANSI Common Lisp doesn't have CHAR-BIT, the implementation of
-  DEFAULT-KEYSYM-TRANSLATE is now implementation dependent in ANSI Common Lisp
-  implementations, with the default doing nothing to character objects.  In
-  non-ANSI Common Lisps and lispms, it still uses CHAR-BIT. The definition of
-  DEFAULT-KEYSYM-TRANSLATE has been moved to dependent.l.
-
-o The image putting, getting, and copying code has been sped up a bit for lispm, 
-  lcl3.0, and excl.
-
-o The lcl3.0 io code has been sped up a bit by using read-array instead of
-  fast-read-byte.
-
-o READ-RESOURCES now handles any lines that start with # and don't start with
-  #include as comments.
-
-R4.4 changes:
-
-o Fixed typo in DEFAULT-KEYSYM-TRANSLATE.
-
-o In events, CurrentTime (encoded as 0 in the protocol) decodes to NIL instead 
-  of 0.
-
-o NIL now translates to and from the atom-id of 0.
-
-o A new variable *OUTPUT-BUFFER-SIZE* has been introduced, with value 8192.
-  Now, instead of the buffer creating code always creating output buffers of 
-  length 8192 bytes, they create output buffers of length *OUTPUT-BUFFER-SIZE* 
-  bytes.
-
-o GCONTEXT-CACHE-P, COLORMAP-PLIST and CURSOR-PLIST have been exported.
-
-o If CREATE-GCONTEXT is given a rect-seq as a clip-mask, then a
-  SetClipRectangles request must be sent to initialize the clip-mask.  The logic
-  to do this is located in FORCE-GCONTEXT-CHANGES-INTERNAL, but this wasn't
-  being called because create-gcontext always forces local/server-state
-  timestamps equal.  Same problem for dash lists.  CREATE-GCONTEXT has been
-  fixed so that in these cases it makes the timestamps unequal so that
-  FORCE-GCONTEXT-CHANGES-INTERNAL is called.
-
-o ANGLEP type check sped up for excl.  Arc drawing should be lots faster.
-
-o RATIONAL type definition for kcl now takes the correct optional args.
-
-o (SETF FONT-PATH) changed to return the value
-
-o Fixed typo in the hex parsing in READ-BITMAP-FILE
-
-o Made READ-RESOURCES more robust about weird resource files.
-
-o New variable *DEF-CLX-CLASS-USE-DEFCLASS*, which controls whether DEF-CLX-CLASS
-  uses DEFCLASS.  If it is a list, it is interpreted by DEF-CLX-CLASS to be a list
-  of type names for which DEFCLASS should be used.  If it is not a list, DEFCLASS
-  is always used.  IF it is NIL, DEFCLASS is never used, since NIL is the empty
-  list.  By default, it's T in Genera, NIL otherwise.
-
-o Fixed typo in DEFINE-CONDITION for #-(or lispm clx-ansi-common-lisp excl lcl3.0).
-
-o Fixed typo in MERGE-RESOURCES 
-
-o In Lucid lisp, the functions aref-card8, aref-int8, aset-card8, aset-int8,
-  aref-card16, aref-int16, aref-card32, aref-int32, aref-card29, aset-card16,
-  aset-int16, aset-card32, aset-int32, and aset-card29 Have been fixed so that
-  they can be used inline with the development compiler.
-
-o The default value of the BYTE-LSB-FIRST-P argument to CREATE-IMAGE has been
-  changed from always T to T on LSBFirst machines and NIL on MSBFirst machines.
-
-o The order of the color values returned by ALLOC-COLOR when a color name is supplied
-  as an argument is fixed so that the screen color correctly is returned as the second 
-  value and the exact color is correctly returned as the third value.  The order was 
-  backwards.
-
-o The internal WITH-BUFFER-INPUT and WITH-BUFFER-OUTPUT macros have been
-  changed to wrap macrolet around body only when necessary.  This simplifies the
-  compiler's job for non lisp machines.
-
-o All uses of DEFINE-CONDITION have been changed to include a slots argument,
-  even if that argument is NIL -- the argument is not optional.
-
-o DEFINE-CONDITION is no longer exported from the XLIB package.
-
-o New functionality has been added to make-pixmap and make-window.  They may
-  now take a :PIXMAP or :WINDOW argument (respectively).  If non-NIL (default is
-  nil), they will use that argument as the pixmap or window object to be set.
-  Otherwise they will create a new pixmap/window object.  This whole schmeel is
-  necessary because creation of window and pixmap objects in CLX doesn't go
-  through the CLOS initialize-instance mechanism.
-
-o The DESCRIBE-WINDOW debug utility has been fixed to not use strange
-  lisp machine format codes.
-
-o Numerous Allegro specific changes in support of Allegro CL version 4.0.
-
-R4.5 changes:
-
-o Fixed READ-VECTOR-CARD8 and WRITE-VECTOR-CARD8 to work with arbitrary vectors.
-
-o Changed COMPILE-CLX and LOAD-CLX to use the verbose mode of COMPILE-FILE and LOAD.
-
-o Added a conditional for HPUX to COMPILE-CLX.
-
-o Changed DISPLAY-CONNECT to save the default colormap ID in the ID database.
-
-o Added new keyword arguments :PROGRAM-SPECIFIED-POSITION-P and :PROGRAM-SPECIFIED-SIZE-P
-  to SET-WM-PROPERTIES and corresponsing slots in the WM-SIZE-HINTS structure.
-  These control the appropriate flags in the size hints.  The old way of controlling these
-  flags, with the :X, :Y, :WIDTH, and :HEIGHT arguments, is now obsolete due to changes
-  in the ICCCM.
-
-o Removed bogus declarations from the SETF expander for WM-NAME.
-
-o Defined a proper SETF function for CUT-BUFFER when in ANSI Lisp.
-
-o Fix the encoding of the revert-to argument to SET-INPUT-FOCUS.
-
-o Fix a fencepost error in STORE-COLORS.
-
-o Fix TEXT-EXTENTS and TEXT-WIDTH to handle font changes properly.
-
-o Fix TEXT-EXTENTS-LOCAL to handle negative ascents and descents properly.
-
-o Fix DRAW-IMAGE-GLYPHS to not try to write more than 255 glyphs.
-
-o Added conditionalizations for Minima, a new operating system under development at Symbolics.
-
-o Some gratuitous changes in the Symbolics-specific code.
-
-o Removed *EVENT-LOOP-VERSION* and support for pre-R4.1 compiled code.
-
-o In Lucid, fixed HOLDING-LOCK to clean up on timeout.
-
-o Gcontexts and fonts without associated displays now print correctly.
-
-Requests that send "strings" of two byte font indices can *not* assume that
-the two byte objects are being written on two byte boundaries.  The simplest
-fix was just to modify the write-*-card16 functions to use a new macro that
-writes one half of the object at a time.  The only undesirable affect of
-this is that CLIENT-MESSAGE and CHANGE-PROPERTY are slightly slower for
-card16 data than they were before.
-    NEW macro
-	-- write-card16-by-bytes			bufmac.l
-    CHANGED functions:
-	-- write-list-card16				buffer.l
-	-- write-list-card16-with-transform		""
-	-- write-simple-array-card16			""
-	-- write-simple-array-card16-with-transform	""
-	-- write-vector-card16				""
-	-- write-vector-card16-with-transform		""
-
-Print functions changed to use write-string instead of princ where
-possible.  This allows for much cleaner printing when *print-circle* is
-true -- princ is required to use *print-circle*, even for strings!
-Write-string is, of course, not so burdened.
-	-- print-color					clx.l
-	-- print-display				""
-	-- print-drawable				""
-	-- print-visual-info				""
-	-- print-colormap				""
-	-- print-cursor					""
-	-- print-gcontext				""
-	-- print-screen					""
-	-- print-font					""
-	-- print-resource-database			resource.l
-	-- print-image					image.l
-
-Changes to display tracing: In a multiprocessing system is it very helpful
-to know what process wrote or read certain requests.  Thus I have modified
-the format of the trace-history list.  It is now an alist of: ((id .
-more-info) .  byte-vector).  (more-info is a list returned by the
-trace-more-info function).  Also added the ability to suspend and resume
-tracing without destroying the trace history.  Renamed 'display-trace' to
-'show-trace' to avoid confusion.  (Having both 'trace-display and
-'display-trace wasn't such a hot idea).
-	-- lots-o-stuff					debug/trace.l
-
-Image-glyph functions had a different argument order than non-image glyph
-functions.  Image-glyph functions changed to be compatible with others.
-Declarations in draw-glyphs* functions were wrong.
-	-- draw-image-glyphs				text.l
-	-- draw-image-glyphs8				text.l
-	-- draw-image-glyphs16				text.l
-	-- draw-glyphs8					text.l
-	-- draw-glyphs16				text.l
-
-Quote #.'ed arrays to accomodate CLTL1 lisps
-	-- empty-data constants				image.l
-
-Set-input-focus fix wasn't finished
-	-- set-input-focus				requests.l
-
-Standardized strange integer type specifier in keysym macro
-	-- keysym					translate.l
-
-===============================================================================
-Franz specific changes, applicable to Allegro and Extended Common Lisps:
-(note that all these changes are #+excl or #+allegro, so if you're not
- using our product these changes are "commented" out)
------------------------------------------------------------------------
-Atom-cache hash table type changed to #'equal.  Resource-id-map has table
-type changed to #'equal.
-    NEW macro
-	-- atom-cache-map-test				depdefs.l
-    CHANGED def-clx-class
-	-- display					clx.l
-    CHANGED macro
-	-- resource-id-map-test				depdefs.l
-
-Don't bother to import require, provide, since we're using the CLTL1
-package.  Also put the requires and provides inside eval-when to make the
-compiler happy.  Don't redefine typep, instead push our customizations onto
-the typep handling list.
-	-- toplevel forms				excldep.l
-
-Old code removed from file
-	-- removed some cmacros				exclcmac.l
-
-Allegro >=4.0 now does support with-standard-io-syntax and
-print-unreadable-object.
-	-- with-standard-io-syntax{,-function}		dependent.l
-	-- print-unreadable-object{,-function}		depdefs.l
-
-Conditionalizations in Makefile cleaned up.
-	-- 						exclMakefile
-
-Descriptive comment added to holding-lock
-	-- holding-lock					dependent.l
-
-Added typep transformers for all CLX types.
-	--						excldep.cl
-
-R5.0 changes:
-
-o Changed occurrances STRING-CHAR to BASE-CHAR.
-
-o Fixed some type declarations to use type NULL instead of NIL.
-
-o Various fixes to vendor-specific code.
-
-o Detect attempts to use images an incorrect depth.
+A variety of changes for Symbolics Minima systems have been made.
 
+Some system-dependent code has been added for CMU Common Lisp.
diff --git a/clx/attributes.lisp b/clx/attributes.lisp
index 43d298c41..5eb1035d6 100644
--- a/clx/attributes.lisp
+++ b/clx/attributes.lisp
@@ -320,19 +320,19 @@
 
 (defun window-visual (window)
   (declare (type window window))
-  (declare (values resource-id))
+  (declare (clx-values resource-id))
   (with-attributes (window :sizes 32)
     (resource-id-get 8)))
 
 (defun window-visual-info (window)
   (declare (type window window))
-  (declare (values visual-info))
+  (declare (clx-values visual-info))
   (with-attributes (window :sizes 32)
     (visual-info (window-display window) (resource-id-get 8))))
 
 (defun window-class (window)
   (declare (type window window))
-  (declare (values (member :input-output :input-only)))
+  (declare (clx-values (member :input-output :input-only)))
   (with-attributes (window :sizes 16)
     (member16-get 12 :copy :input-output :input-only)))
 
@@ -371,7 +371,7 @@
 (defun window-bit-gravity (window)
   ;; setf'able
   (declare (type window window))
-  (declare (values bit-gravity))
+  (declare (clx-values bit-gravity))
   (with-attributes (window :sizes 8)
     (member8-vector-get 14 *bit-gravity-vector*)))
 
@@ -385,7 +385,7 @@
 (defun window-gravity (window)
   ;; setf'able
   (declare (type window window))
-  (declare (values win-gravity))
+  (declare (clx-values win-gravity))
   (with-attributes (window :sizes 8)
     (member8-vector-get 15 *win-gravity-vector*)))
 
@@ -399,7 +399,7 @@
 (defun window-backing-store (window)
   ;; setf'able
   (declare (type window window))
-  (declare (values (member :not-useful :when-mapped :always)))
+  (declare (clx-values (member :not-useful :when-mapped :always)))
   (with-attributes (window :sizes 8)
     (member8-get 1 :not-useful :when-mapped :always)))
 
@@ -413,7 +413,7 @@
 (defun window-backing-planes (window)
   ;; setf'able
   (declare (type window window))
-  (declare (values pixel))
+  (declare (clx-values pixel))
   (with-attributes (window :sizes 32)
     (card32-get 16)))
 
@@ -426,7 +426,7 @@
 (defun window-backing-pixel (window)
   ;; setf'able
   (declare (type window window))
-  (declare (values pixel))
+  (declare (clx-values pixel))
   (with-attributes (window :sizes 32)
     (card32-get 20)))
 
@@ -439,7 +439,7 @@
 (defun window-save-under (window)
   ;; setf'able
   (declare (type window window))
-  (declare (values (member :off :on)))
+  (declare (clx-values (member :off :on)))
   (with-attributes (window :sizes 8)
     (member8-get 24 :off :on)))
 
@@ -452,7 +452,7 @@
 (defun window-override-redirect (window)
   ;; setf'able
   (declare (type window window))
-  (declare (values (member :off :on)))
+  (declare (clx-values (member :off :on)))
   (with-attributes (window :sizes 8)
     (member8-get 27 :off :on)))
 
@@ -465,7 +465,7 @@
 (defun window-event-mask (window)
   ;; setf'able
   (declare (type window window))
-  (declare (values mask32))
+  (declare (clx-values mask32))
   (with-attributes (window :sizes 32)
     (card32-get 36)))
 
@@ -479,7 +479,7 @@
 (defun window-do-not-propagate-mask (window)
   ;; setf'able
   (declare (type window window))
-  (declare (values mask32))
+  (declare (clx-values mask32))
   (with-attributes (window :sizes 32)
     (card32-get 40)))
 
@@ -492,7 +492,7 @@
 
 (defun window-colormap (window)
   (declare (type window window))
-  (declare (values (or null colormap)))
+  (declare (clx-values (or null colormap)))
   (with-attributes (window :sizes 32)
     (let ((id (resource-id-get 28)))
       (if (zerop id) nil
@@ -507,7 +507,7 @@
 
 (defun window-cursor (window)
   (declare (type window window))
-  (declare (values cursor))
+  (declare (clx-values cursor))
   window
   (error "~S can only be set" 'window-cursor))
 
@@ -520,19 +520,19 @@
 
 (defun window-colormap-installed-p (window)
   (declare (type window window))
-  (declare (values boolean))
+  (declare (clx-values boolean))
   (with-attributes (window :sizes 8)
     (boolean-get 25)))
 
 (defun window-all-event-masks (window)
   (declare (type window window))
-  (declare (values mask32))
+  (declare (clx-values mask32))
   (with-attributes (window :sizes 32)
     (card32-get 32)))
 
 (defun window-map-state (window)
   (declare (type window window))
-  (declare (values (member :unmapped :unviewable :viewable)))
+  (declare (clx-values (member :unmapped :unviewable :viewable)))
   (with-attributes (window :sizes 8)
     (member8-get 26 :unmapped :unviewable :viewable)))
 
@@ -543,14 +543,14 @@
 
 (defun drawable-root (drawable)
   (declare (type drawable drawable))
-  (declare (values window))
+  (declare (clx-values window))
   (with-geometry (drawable :sizes 32)
     (window-get 8 (drawable-display drawable))))
 
 (defun drawable-x (drawable)
   ;; setf'able
   (declare (type drawable drawable))
-  (declare (values int16))
+  (declare (clx-values int16))
   (with-geometry (drawable :sizes 16)
     (int16-get 12)))
 
@@ -563,7 +563,7 @@
 (defun drawable-y (drawable)
   ;; setf'able
   (declare (type drawable drawable))
-  (declare (values int16))
+  (declare (clx-values int16))
   (with-geometry (drawable :sizes 16)
     (int16-get 14)))
 
@@ -577,7 +577,7 @@
   ;; setf'able
   ;; Inside width, excluding border.
   (declare (type drawable drawable))
-  (declare (values card16))
+  (declare (clx-values card16))
   (with-geometry (drawable :sizes 16)
     (card16-get 16)))
 
@@ -591,7 +591,7 @@
   ;; setf'able
   ;; Inside height, excluding border.
   (declare (type drawable drawable))
-  (declare (values card16))
+  (declare (clx-values card16))
   (with-geometry (drawable :sizes 16)
     (card16-get 18)))
 
@@ -603,14 +603,14 @@
 
 (defun drawable-depth (drawable)
   (declare (type drawable drawable))
-  (declare (values card8))
+  (declare (clx-values card8))
   (with-geometry (drawable :sizes 8)
     (card8-get 1)))
 
 (defun drawable-border-width (drawable)
   ;; setf'able
   (declare (type drawable drawable))
-  (declare (values integer))
+  (declare (clx-values integer))
   (with-geometry (drawable :sizes 16)
     (card16-get 20)))
 
diff --git a/clx/buffer.lisp b/clx/buffer.lisp
index bc1b12a00..113867dce 100644
--- a/clx/buffer.lisp
+++ b/clx/buffer.lisp
@@ -173,21 +173,17 @@
 		    (buffer-lbuf (reply-ibuf32 %reply-buffer))))))
        (declare (type array-index buffer-boffset))
        #-clx-overlapping-arrays
-       (declare (type buffer-bytes buffer-bbuf)
-		(array-register buffer-bbuf))
+       (declare (type buffer-bytes buffer-bbuf))
        #+clx-overlapping-arrays
        ,@(append
 	   (when (member 8 sizes)
-	     '((declare (type buffer-bytes buffer-bbuf)
-			(array-register buffer-bbuf))))
+	     '((declare (type buffer-bytes buffer-bbuf))))
 	   (when (member 16 sizes)
 	     '((declare (type array-index buffer-woffset))
-	       (declare (type buffer-words buffer-wbuf)
-			(array-register buffer-wbuf))))
+	       (declare (type buffer-words buffer-wbuf))))
 	   (when (member 32 sizes)
 	     '((declare (type array-index buffer-loffset))
-	       (declare (type buffer-longs buffer-lbuf)
-			(array-register buffer-lbuf)))))
+	       (declare (type buffer-longs buffer-lbuf)))))
        buffer-boffset
        #-clx-overlapping-arrays
        buffer-bbuf
@@ -419,7 +415,7 @@
 	   (type vector vector)
 	   (type array-index start end)
 	   (type (or null number) timeout))
-  (declare (values eof-p))
+  (declare (clx-values eof-p))
   (when (buffer-dead buffer)
     (x-error 'closed-display :display buffer))
   (unless (= start end)
@@ -437,7 +433,7 @@
   ;; Returns :TIMEOUT when timeout exceeded
   (declare (type buffer buffer)
 	   (type (or null number) timeout))
-  (declare (values timeout))
+  (declare (clx-values timeout))
   (when (buffer-dead buffer)
     (x-error 'closed-display :display buffer))
   (let ((result
@@ -452,7 +448,7 @@
   ;; Returns T if there is input available for the buffer. This should never
   ;; block, so it can be called from the scheduler.
   (declare (type buffer buffer))
-  (declare (values input-available))
+  (declare (clx-values input-available))
   (or (not (null (buffer-dead buffer)))
       (wrap-buf-input (buffer)
 	(funcall (buffer-listen-function buffer) buffer))))
@@ -1623,8 +1619,7 @@
 	   (type array-index boffset)
 	   (type (or null (simple-bit-vector 256)) data))
   (let ((result (or data (make-array 256 :element-type 'bit :initial-element 0))))
-    (declare (type (simple-bit-vector 256) result)
-	     (array-register result))
+    (declare (type (simple-bit-vector 256) result))
     (do ((i (index+ boffset 1) (index+ i 1)) ;; Skip first byte
 	 (j 8 (index+ j 8)))
 	((index>= j 256))
diff --git a/clx/bufmac.lisp b/clx/bufmac.lisp
index 00df94462..1e002b824 100644
--- a/clx/bufmac.lisp
+++ b/clx/bufmac.lisp
@@ -120,21 +120,17 @@
 		    (buffer-lbuf (buffer-obuf32 %buffer))))))
        (declare (type array-index buffer-boffset))
        #-clx-overlapping-arrays
-       (declare (type buffer-bytes buffer-bbuf)
-		(array-register buffer-bbuf))
+       (declare (type buffer-bytes buffer-bbuf))
        #+clx-overlapping-arrays
        ,@(append
 	   (when (member 8  sizes)
-	     '((declare (type buffer-bytes buffer-bbuf)
-			(array-register buffer-bbuf))))
+	     '((declare (type buffer-bytes buffer-bbuf))))
 	   (when (member 16 sizes)
 	     '((declare (type array-index buffer-woffset))
-	       (declare (type buffer-words buffer-wbuf)
-			(array-register buffer-wbuf))))
+	       (declare (type buffer-words buffer-wbuf))))
 	   (when (member 32 sizes)
 	     '((declare (type array-index buffer-loffset))
-	       (declare (type buffer-longs buffer-lbuf)
-			(array-register buffer-lbuf)))))
+	       (declare (type buffer-longs buffer-lbuf)))))
        buffer-boffset
        #-clx-overlapping-arrays
        buffer-bbuf
diff --git a/clx/clx.lisp b/clx/clx.lisp
index 157d7bdc9..ab8734923 100644
--- a/clx/clx.lisp
+++ b/clx/clx.lisp
@@ -83,7 +83,7 @@
 (pushnew :clx *features*)
 (pushnew :xlib *features*)
 
-(defparameter *version* "MIT R5.0")
+(defparameter *version* "MIT R5.01")
 (pushnew :clx-mit-r4 *features*)
 (pushnew :clx-mit-r5 *features*)
 
@@ -92,9 +92,6 @@
 
 (defparameter *x-tcp-port* 6000) ;; add display number
 
-; Note: various perversions of the CL type system are used below.
-; Examples: (list elt-type) (sequence elt-type)
-
 ;; Note: if you have read the Version 11 protocol document or C Xlib manual, most of
 ;; the relationships should be fairly obvious.  We have no intention of writing yet
 ;; another moby document for this interface.
@@ -124,22 +121,22 @@
 ;  ;; cache-p true.
 ;  (declare (type display display)
 ;	   (type integer resource-id)
-;	   (values <mumble>)))
+;	   (clx-values <mumble>)))
 
 ;(defun <mumble>-display (<mumble>)
 ;  (declare (type <mumble> <mumble>)
-;	   (values display)))
+;	   (clx-values display)))
 
 ;(defun <mumble>-id (<mumble>)
 ;  (declare (type <mumble> <mumble>)
-;	   (values integer)))
+;	   (clx-values integer)))
 
 ;(defun <mumble>-equal (<mumble>-1 <mumble>-2)
 ;  (declare (type <mumble> <mumble>-1 <mumble>-2)))
 
 ;(defun <mumble>-p (<mumble>-1 <mumble>-2)
 ;  (declare (type <mumble> <mumble>-1 <mumble>-2)
-;	   (values boolean)))
+;	   (clx-values boolean)))
 
 (deftype boolean () '(or null (not null)))
 
@@ -161,7 +158,7 @@
 
 (deftype card4 () '(unsigned-byte 4))
 
-#-(or clx-ansi-common-lisp cmu)
+#-clx-ansi-common-lisp
 (deftype real (&optional (min '*) (max '*))
   (labels ((convert (limit floatp)
 	     (typecase limit
@@ -171,7 +168,7 @@
     `(or (float ,(convert min t) ,(convert max t))
 	 (rational ,(convert min nil) ,(convert max nil)))))
 
-#-(or clx-ansi-common-lisp cmu)
+#-clx-ansi-common-lisp
 (deftype base-char ()
   'string-char)
 
@@ -220,24 +217,42 @@
 
 (defun make-color (&key (red 1.0) (green 1.0) (blue 1.0) &allow-other-keys)
   (declare (type rgb-val red green blue))
-  (declare (values color))
+  (declare (clx-values color))
   (make-color-internal red green blue))
 
 (defun color-rgb (color)
   (declare (type color color))
-  (declare (values red green blue))
+  (declare (clx-values red green blue))
   (values (color-red color) (color-green color) (color-blue color)))
 
-(def-clx-class (bitmap-format (:copier nil))
+(def-clx-class (bitmap-format (:copier nil) (:print-function print-bitmap-format))
   (unit 8 :type (member 8 16 32))
   (pad 8 :type (member 8 16 32))
   (lsb-first-p nil :type boolean))
 
-(def-clx-class (pixmap-format (:copier nil))
+(defun print-bitmap-format (bitmap-format stream depth)
+  (declare (type bitmap-format bitmap-format)
+	   (ignore depth))
+  (print-unreadable-object (bitmap-format stream :type t)
+    (format stream "unit ~D pad ~D ~:[M~;L~]SB first"
+	    (bitmap-format-unit bitmap-format)
+	    (bitmap-format-pad bitmap-format)
+	    (bitmap-format-lsb-first-p bitmap-format))))
+
+(def-clx-class (pixmap-format (:copier nil) (:print-function print-pixmap-format))
   (depth 0 :type image-depth)
   (bits-per-pixel 8 :type (member 1 4 8 16 24 32))
   (scanline-pad 8 :type (member 8 16 32)))
 
+(defun print-pixmap-format (pixmap-format stream depth)
+  (declare (type pixmap-format pixmap-format)
+	   (ignore depth))
+  (print-unreadable-object (pixmap-format stream :type t)
+    (format stream "depth ~D bits-per-pixel ~D scanline-pad ~D"
+	    (pixmap-format-depth pixmap-format)
+	    (pixmap-format-bits-per-pixel pixmap-format)
+	    (pixmap-format-scanline-pad pixmap-format))))
+
 (defparameter *atom-cache-size* 200)
 (defparameter *resource-id-map-size* 500)
 
@@ -302,7 +317,7 @@
   (event-extensions '#() :type vector)		; Vector mapping X event-codes to event keys
   (performance-info)				; Hook for gathering performance info
   (trace-history)				; Hook for debug trace
-  (plist)					; hook for extension to hang data
+  (plist nil :type list)			; hook for extension to hang data
   ;; These slots are used to manage multi-process input.
   (input-in-progress nil)			; Some process reading from the stream.
 						; Updated with CONDITIONAL-STORE.
@@ -492,6 +507,9 @@
   (declare (ignore key-type-and-name datum-type-and-name))
   'list)
 
+(deftype clx-list (&optional element-type) (declare (ignore element-type)) 'list)
+(deftype clx-sequence (&optional element-type) (declare (ignore element-type)) 'sequence)
+
 ; A sequence, containing zero or more repetitions of the given elements,
 ; with the elements expressed as (type name).
 
@@ -546,7 +564,7 @@
 	   :focus-change :property-change :colormap-change :keymap-state))
 
 (deftype event-mask ()
-  '(or mask32 list)) ;; (OR integer (LIST event-mask-class))
+  '(or mask32 (clx-list event-mask-class)))
 
 (defconstant *pointer-event-mask-vector*
 	     '#(%error %error :button-press :button-release
@@ -561,7 +579,7 @@
 	   :button-5-motion :button-motion :keymap-state))
 
 (deftype pointer-event-mask ()
-  '(or mask32 list)) ;;  '(or integer (list pointer-event-mask-class)))
+  '(or mask32 (clx-list pointer-event-mask-class)))
 
 (defconstant *device-event-mask-vector*
 	     '#(:key-press :key-release :button-press :button-release :pointer-motion
@@ -574,7 +592,7 @@
 	   :button-5-motion :button-motion))
 
 (deftype device-event-mask ()
-  '(or mask32 list)) ;;  '(or integer (list device-event-mask-class)))
+  '(or mask32 (clx-list device-event-mask-class)))
 
 (defconstant *state-mask-vector*
 	     '#(:shift :lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5
@@ -584,7 +602,7 @@
   '(member :shift :lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5))
 
 (deftype modifier-mask ()
-  '(or (member :any) mask16 list)) ;;  '(or (member :any) integer (list modifier-key)))
+  '(or (member :any) mask16 (clx-list modifier-key)))
 
 (deftype state-mask-key ()
   '(or modifier-key (member :button-1 :button-2 :button-3 :button-4 :button-5)))
@@ -638,7 +656,7 @@
   (height 0 :type card16)
   (width-in-millimeters 0 :type card16)
   (height-in-millimeters 0 :type card16)
-  (depths nil :type (alist (image-depth depth) ((list visual-info) visuals)))
+  (depths nil :type (alist (image-depth depth) ((clx-list visual-info) visuals)))
   (root-depth 1 :type image-depth)
   (root-visual-info nil :type (or null visual-info))
   (default-colormap nil :type (or null colormap))
@@ -672,7 +690,7 @@
 
 (defun screen-root-visual (screen)
   (declare (type screen screen)
-	   (values resource-id))
+	   (clx-values resource-id))
   (visual-info-id (screen-root-visual-info screen)))
 
 ;; The list contains alternating keywords and integers.
@@ -751,7 +769,7 @@
 
 ;(defun font-<name> (font)
 ;  (declare (type font font)
-;	   (values <type>)))
+;	   (clx-values <type>)))
 
 (macrolet ((make-font-info-accessors (useless-name &body fields)
 	     `(within-definition (,useless-name make-font-info-accessors)
@@ -763,7 +781,7 @@
 			       (accessor (xintern 'font-info- n)))
 			  `(defun ,name (font)
 			     (declare (type font font))
-			     (declare (values ,type))
+			     (declare (clx-values ,type))
 			     (,accessor (font-font-info font)))))
 		    fields))))
   (make-font-info-accessors ignore
@@ -785,7 +803,7 @@
 (defun font-property (font name)
   (declare (type font font)
 	   (type keyword name))
-  (declare (values (or null int32)))
+  (declare (clx-values (or null int32)))
   (getf (font-properties font) name))
 
 (macrolet ((make-mumble-equal (type)
@@ -821,7 +839,7 @@
   ;; Returns NIL when KEY-LIST is not a list or mask.
   (declare (type (simple-array keyword (*)) key-vector)
 	   (type (or mask32 list) key-list))
-  (declare (values (or mask32 null)))
+  (declare (clx-values (or mask32 null)))
   (typecase key-list
     (mask32 key-list)
     (list (let ((mask 0))
@@ -834,7 +852,7 @@
 (defun decode-mask (key-vector mask)
   (declare (type (simple-array keyword (*)) key-vector)
 	   (type mask32 mask))
-  (declare (values list))
+  (declare (clx-values list))
   (do ((m mask (ash m -1))
        (bit 0 (1+ bit))
        (len (length key-vector))
@@ -848,57 +866,57 @@
 
 (defun encode-event-mask (event-mask)
   (declare (type event-mask event-mask))
-  (declare (values mask32))
+  (declare (clx-values mask32))
   (or (encode-mask *event-mask-vector* event-mask 'event-mask-class)
       (x-type-error event-mask 'event-mask)))
 
 (defun make-event-mask (&rest keys)
   ;; This is only defined for core events.
   ;; Useful for constructing event-mask, pointer-event-mask, device-event-mask.
-  (declare (type list keys)) ;; (list event-mask-class)
-  (declare (values mask32))
+  (declare (type (clx-list event-mask-class) keys))
+  (declare (clx-values mask32))
   (encode-mask *event-mask-vector* keys 'event-mask-class))
 
 (defun make-event-keys (event-mask)
   ;; This is only defined for core events.
   (declare (type mask32 event-mask))
-  (declare (values (list event-mask-class)))
+  (declare (clx-values (clx-list event-mask-class)))
   (decode-mask *event-mask-vector* event-mask))
 
 (defun encode-device-event-mask (device-event-mask)
   (declare (type device-event-mask device-event-mask))
-  (declare (values mask32))
+  (declare (clx-values mask32))
   (or (encode-mask *device-event-mask-vector* device-event-mask
 		   'device-event-mask-class)
       (x-type-error device-event-mask 'device-event-mask)))
 
 (defun encode-modifier-mask (modifier-mask)
-  (declare (type modifier-mask modifier-mask)) ;; (list state-mask-key)
-  (declare (values mask16))
+  (declare (type modifier-mask modifier-mask))
+  (declare (clx-values mask16))
   (or (encode-mask *state-mask-vector* modifier-mask 'modifier-key)
       (and (eq modifier-mask :any) #x8000)
       (x-type-error modifier-mask 'modifier-mask)))
 
 (defun encode-state-mask (state-mask)
-  (declare (type (or mask16 list) state-mask)) ;; (list state-mask-key)
-  (declare (values mask16))
+  (declare (type (or mask16 (clx-list state-mask-key)) state-mask))
+  (declare (clx-values mask16))
   (or (encode-mask *state-mask-vector* state-mask 'state-mask-key)
-      (x-type-error state-mask '(or mask16 (list state-mask-key)))))
+      (x-type-error state-mask '(or mask16 (clx-list state-mask-key)))))
 
 (defun make-state-mask (&rest keys)
   ;; Useful for constructing modifier-mask, state-mask.
-  (declare (type list keys)) ;; (list state-mask-key)
-  (declare (values mask16))
+  (declare (type (clx-list state-mask-key) keys))
+  (declare (clx-values mask16))
   (encode-mask *state-mask-vector* keys 'state-mask-key))
 
 (defun make-state-keys (state-mask)
   (declare (type mask16 state-mask))
-  (declare (values (list state-mask-key)))
+  (declare (clx-values (clx-list state-mask-key)))
   (decode-mask *state-mask-vector* state-mask))
 
 (defun encode-pointer-event-mask (pointer-event-mask)
   (declare (type pointer-event-mask pointer-event-mask))
-  (declare (values mask32))
+  (declare (clx-values mask32))
   (or (encode-mask *pointer-event-mask-vector* pointer-event-mask
 		   'pointer-event-mask-class)
       (x-type-error pointer-event-mask 'pointer-event-mask)))
diff --git a/clx/cmudep.lisp b/clx/cmudep.lisp
new file mode 100644
index 000000000..c77d181cd
--- /dev/null
+++ b/clx/cmudep.lisp
@@ -0,0 +1,19 @@
+;;; -*- Package: XLIB -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/clx/cmudep.lisp,v 1.1 1992/08/11 15:15:34 ram Exp $")
+;;;
+;;; **********************************************************************
+;;;
+(in-package "XLIB")
+
+(alien:def-alien-routine ("connect_to_server" xlib::connect-to-server)
+			 c-call:int
+  (host c-call:c-string)
+  (port c-call:int))
diff --git a/clx/defsystem.lisp b/clx/defsystem.lisp
index f9c6448be..e1174d1c0 100644
--- a/clx/defsystem.lisp
+++ b/clx/defsystem.lisp
@@ -30,6 +30,7 @@
 ;;;   kcl
 ;;;   ibcl
 ;;;   excl
+;;;   CMU
 
 #+(or Genera Minima)
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -141,6 +142,23 @@
     "buffer" "display" "gcontext" "input" "requests" "fonts" "graphics"
     "text" "attributes" "translate" "keysyms" "manager" "image" "resource"))
 
+#+Minima
+(zl:::scl:defsystem Minima-CLX
+    (:default-pathname "SYS:X11;CLX;"
+     :pretty-name "Minima CLX"
+     :maintain-journals nil
+     :maintaining-sites (:scrc)
+     :distribute-sources t
+     :distribute-binaries t
+     :source-category :basic
+     :default-module-type :minima-lisp)
+  (:module doc ("doc")
+	   (:type :lisp-example))
+  (:serial
+    "package" "depdefs" "clx" "dependent" "macros" "bufmac"
+    "buffer" "display" "gcontext" "input" "requests" "fonts" "graphics"
+    "text" "attributes" "translate" "keysyms" "manager" "image" "resource"))
+
 
 ;;; Franz
 
@@ -322,7 +340,7 @@
       (format t "~&Finished faslinking ~A.~%" pathname)))
   )
 
-#-(or lispm allegro)
+#-(or lispm allegro Minima)
 (defun compile-clx (&optional
 		    (source-pathname-defaults "")
 		    (binary-pathname-defaults "")
@@ -378,7 +396,7 @@
 		 #+(or kcl ibcl) (load source)
 		 (if (equal source binary)
 		     (compile-file source)
-		   (compile-file source :output-file binary))
+		     (compile-file source :output-file binary))
 		 binary))
 	     (compile-and-load (filename)
 	       (load (compile-lisp filename)))
@@ -413,9 +431,9 @@
 
       ;; Now compile and load all the files.
       ;; Defer compiler warnings until everything's compiled, if possible.
-      (#+clx-ansi-common-lisp with-compilation-unit
+      (#+(or clx-ansi-common-lisp CMU) with-compilation-unit
        #+lcl3.0 lucid::with-deferred-warnings
-       #-(or lcl3.0 clx-ansi-common-lisp) progn
+       #-(or lcl3.0 clx-ansi-common-lisp CMU) progn
        ()
        
        (compile-and-load "package")
@@ -465,7 +483,7 @@
 ;;;		(LOAD <clx-defsystem-file>)
 ;;;		(LOAD-CLX <binary-specific-clx-directory>)
 
-#-(or lispm allegro)
+#-(or lispm allegro Minima)
 (defun load-clx (&optional (binary-pathname-defaults "")
 		 &key (macrosp nil))
 
diff --git a/clx/depdefs.lisp b/clx/depdefs.lisp
index 527724dd3..6a89c31a8 100644
--- a/clx/depdefs.lisp
+++ b/clx/depdefs.lisp
@@ -45,10 +45,13 @@
 		   decl-specs))
     `(proclaim ',(car decl-specs))))
 
-;;; VALUES value1 value2 ... -- Documents the values returned by the function.
+;;; CLX-VALUES value1 value2 ... -- Documents the values returned by the function.
 
-#-lispm
-(declaim (declaration values))
+#-Genera
+(declaim (declaration clx-values))
+
+#+Genera
+(setf (get 'clx-values 'si:declaration-alias) 'scl:values)
 
 ;;; ARGLIST arg1 arg2 ... -- Documents the arglist of the function.  Overrides
 ;;; the documentation that might get generated by the real arglist of the
@@ -69,12 +72,6 @@
 #-clx-ansi-common-lisp
 (declaim (declaration ignorable))
 
-;;; ARRAY-REGISTER var1 var2 ... -- The variables mentioned are locals (not
-;;; args) that hold vectors.  
-
-#-Genera 
-(declaim (declaration array-register))
-
 ;;; INDENTATION argpos1 arginden1 argpos2 arginden2 --- Tells the lisp editor how to
 ;;; indent calls to the function or macro containing the declaration.  
 
@@ -89,8 +86,7 @@
 ;;; and then does a type declaration and array register declaration
 (defmacro with-vector ((var type) &body body)
   `(let ((,var ,var))
-     (declare (type ,type ,var)
-	      (array-register ,var))
+     (declare (type ,type ,var))
      ,@body))
 
 ;;; WITHIN-DEFINITION (name type) &body body --- Includes definitions for
@@ -155,6 +151,12 @@
     (:big nil)
     (:little (pushnew :clx-little-endian *features*))))
 
+#+cmu
+(eval-when (compile eval load)
+  (ecase #.(c:backend-byte-order c:*backend*)
+    (:big-endian)
+    (:little-endian (pushnew :clx-little-endian *features*))))
+
 ;;; Steele's Common-Lisp states:  "It is an error if the array specified
 ;;; as the :displaced-to argument  does not have the same :element-type
 ;;; as the array being created" If this is the case on your lisp, then
diff --git a/clx/dependent.lisp b/clx/dependent.lisp
index 9d30de02d..4d7cf2422 100644
--- a/clx/dependent.lisp
+++ b/clx/dependent.lisp
@@ -53,7 +53,7 @@
 
 (eval-when (eval compile load)
 
-(defconstant *buffer-speed* 3
+(defconstant *buffer-speed* #+clx-debugging 1 #-clx-debugging 3
   "Speed compiler option for buffer code.")
 (defconstant *buffer-safety* #+clx-debugging 3 #-clx-debugging 0
   "Safety compiler option for buffer code.")
@@ -80,7 +80,7 @@
 
 (defun card8->int8 (x)
   (declare (type card8 x))
-  (declare (values int8))
+  (declare (clx-values int8))
   #.(declare-buffun)
   (the int8 (if (logbitp 7 x)
 		(the int8 (- x #x100))
@@ -88,13 +88,13 @@
 
 (defun int8->card8 (x)
   (declare (type int8 x))
-  (declare (values card8))
+  (declare (clx-values card8))
   #.(declare-buffun)
   (the card8 (ldb (byte 8 0) x)))
 
 (defun card16->int16 (x)
   (declare (type card16 x))
-  (declare (values int16))
+  (declare (clx-values int16))
   #.(declare-buffun)
   (the int16 (if (logbitp 15 x)
 		 (the int16 (- x #x10000))
@@ -102,13 +102,13 @@
 
 (defun int16->card16 (x)
   (declare (type int16 x))
-  (declare (values card16))
+  (declare (clx-values card16))
   #.(declare-buffun)
   (the card16 (ldb (byte 16 0) x)))
 
 (defun card32->int32 (x)
   (declare (type card32 x))
-  (declare (values int32))
+  (declare (clx-values int32))
   #.(declare-buffun)
   (the int32 (if (logbitp 31 x)
 		 (the int32 (- x #x100000000))
@@ -116,7 +116,7 @@
 
 (defun int32->card32 (x)
   (declare (type int32 x))
-  (declare (values card32))
+  (declare (clx-values card32))
   #.(declare-buffun)
   (the card32 (ldb (byte 32 0) x)))
 
@@ -159,7 +159,7 @@
 (defun aref-card8 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values card8))
+  (declare (clx-values card8))
   #.(declare-buffun)
   (the card8 (aref a i)))
 
@@ -173,7 +173,7 @@
 (defun aref-int8 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values int8))
+  (declare (clx-values int8))
   #.(declare-buffun)
   (card8->int8 (aref a i)))
 
@@ -285,7 +285,7 @@
 (defun aref-card8 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values card8))
+  (declare (clx-values card8))
   #.(declare-buffun)
   (the card8 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
 			 :unsigned-byte)))
@@ -301,7 +301,7 @@
 (defun aref-int8 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values int8))
+  (declare (clx-values int8))
   #.(declare-buffun)
   (the int8 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
 			:signed-byte)))
@@ -317,7 +317,7 @@
 (defun aref-card16 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values card16))
+  (declare (clx-values card16))
   #.(declare-buffun)
   (the card16 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
 			  :unsigned-word)))
@@ -333,7 +333,7 @@
 (defun aref-int16 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values int16))
+  (declare (clx-values int16))
   #.(declare-buffun)
   (the int16 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
 			 :signed-word)))
@@ -349,7 +349,7 @@
 (defun aref-card32 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values card32))
+  (declare (clx-values card32))
   #.(declare-buffun)
   (the card32 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
 			  :unsigned-long)))
@@ -365,7 +365,7 @@
 (defun aref-int32 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values int32))
+  (declare (clx-values int32))
   #.(declare-buffun)
   (the int32 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
 			 :signed-long)))
@@ -381,7 +381,7 @@
 (defun aref-card29 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values card29))
+  (declare (clx-values card29))
   #.(declare-buffun)
   (the card29 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
 			  :unsigned-long)))
@@ -402,7 +402,7 @@
 (defun aref-card8 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i)
-	   (values card8))
+	   (clx-values card8))
   #.(declare-buffun)
   (the card8 (lucid::%svref-8bit a i)))
 
@@ -416,7 +416,7 @@
 (defun aref-int8 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i)
-	   (values int8))
+	   (clx-values int8))
   #.(declare-buffun)
   (the int8 (lucid::%svref-signed-8bit a i)))
 
@@ -430,7 +430,7 @@
 (defun aref-card16 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i)
-	   (values card16))
+	   (clx-values card16))
   #.(declare-buffun)
   (the card16 (lucid::%svref-16bit a (index-ash i -1))))
   
@@ -444,7 +444,7 @@
 (defun aref-int16 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i)
-	   (values int16))
+	   (clx-values int16))
   #.(declare-buffun)
   (the int16 (lucid::%svref-signed-16bit a (index-ash i -1))))
   
@@ -458,7 +458,7 @@
 (defun aref-card32 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i)
-	   (values card32))
+	   (clx-values card32))
   #.(declare-buffun)
   (the card32 (lucid::%svref-32bit a (index-ash i -2))))
     
@@ -472,7 +472,7 @@
 (defun aref-int32 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i)
-	   (values int32))
+	   (clx-values int32))
   #.(declare-buffun)
   (the int32 (lucid::%svref-signed-32bit a (index-ash i -2))))
     
@@ -486,7 +486,7 @@
 (defun aref-card29 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i)
-	   (values card29))
+	   (clx-values card29))
   #.(declare-buffun)
   (the card29 (lucid::%svref-32bit a (index-ash i -2))))
 
@@ -507,7 +507,7 @@
 (defun aref-card16 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values card16))
+  (declare (clx-values card16))
   #.(declare-buffun)
   (the card16
        (logior (the card16
@@ -527,7 +527,7 @@
 (defun aref-int16 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values int16))
+  (declare (clx-values int16))
   #.(declare-buffun)
   (the int16
        (logior (the int16
@@ -547,7 +547,7 @@
 (defun aref-card32 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values card32))
+  (declare (clx-values card32))
   #.(declare-buffun)
   (the card32
        (logior (the card32
@@ -573,7 +573,7 @@
 (defun aref-int32 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values int32))
+  (declare (clx-values int32))
   #.(declare-buffun)
   (the int32
        (logior (the int32
@@ -599,7 +599,7 @@
 (defun aref-card29 (a i)
   (declare (type buffer-bytes a)
 	   (type array-index i))
-  (declare (values card29))
+  (declare (clx-values card29))
   #.(declare-buffun)
   (the card29
        (logior (the card29
@@ -650,7 +650,7 @@
 (defun rgb-val->card16 (value)
   ;; Short floats are good enough
   (declare (type rgb-val value))
-  (declare (values card16))
+  (declare (clx-values card16))
   #.(declare-buffun)
   ;; Convert VALUE from float to card16
   (the card16 (values (round (the rgb-val value) #.(/ 1.0s0 #xffff)))))
@@ -658,7 +658,7 @@
 (defun card16->rgb-val (value) 
   ;; Short floats are good enough
   (declare (type card16 value))
-  (declare (values short-float))
+  (declare (clx-values short-float))
   #.(declare-buffun)
   ;; Convert VALUE from card16 to float
   (the short-float (* (the card16 value) #.(/ 1.0s0 #xffff))))
@@ -666,14 +666,14 @@
 (defun radians->int16 (value)
   ;; Short floats are good enough
   (declare (type angle value))
-  (declare (values int16))
+  (declare (clx-values int16))
   #.(declare-buffun)
   (the int16 (values (round (the angle value) #.(float (/ pi 180.0s0 64.0s0) 0.0s0)))))
 
 (defun int16->radians (value)
   ;; Short floats are good enough
   (declare (type int16 value))
-  (declare (values short-float))
+  (declare (clx-values short-float))
   #.(declare-buffun)
   (the short-float (* (the int16 value) #.(coerce (/ pi 180.0 64.0) 'short-float))))
 
@@ -761,7 +761,7 @@
 						  (cdr pair)))
 					  array))
 			 (defconstant *card8-to-char-translation-table*
-				      ',(let ((array (make-string 256)))
+				      ',(let ((array (make-array 256)))
 					  (dotimes (i (length array))
 					    (setf (aref array i) (code-char i)))
 					  (dolist (pair alist)
@@ -779,8 +779,9 @@
 			     (declare (type card8 card8))
 			     #.(declare-buffun)
 			     (the base-char
-				  (aref (the simple-string *card8-to-char-translation-table*)
-					card8)))
+				  (or (aref (the simple-vector *card8-to-char-translation-table*)
+					    card8)
+				      (error "Invalid CHAR code ~D." card8))))
 			   )
 			 #+Genera
 			 (progn
@@ -791,6 +792,7 @@
 			     (declare lt:(side-effects reader reducible))
 			     (aref *card8-to-char-translation-table* card8))
 			   )
+			 #-Minima
 			 (dotimes (i 256)
 			   (unless (= i (char->card8 (card8->char i)))
 			     (warn "The card8->char mapping is not invertible through char->card8.  Info:~%~S"
@@ -798,6 +800,7 @@
 					 (card8->char i)
 					 (char->card8 (card8->char i))))
 			     (return nil)))
+			 #-Minima
 			 (dotimes (i (length *char-to-card8-translation-table*))
 			   (let ((char (code-char i)))
 			     (unless (eql char (card8->char (char->card8 char)))
@@ -849,7 +852,7 @@
 
 #+Minima
 (defun make-process-lock (name)
-  (minima:make-lock name))
+  (minima:make-lock name :recursive t))
 
 ;;; HOLDING-LOCK: Execute a body of code with a lock held.
 
@@ -859,11 +862,28 @@
 
 ;; If you're not sharing DISPLAY objects within a multi-processing
 ;; shared-memory environment, this is sufficient
-#-(or lispm excl lcl3.0 Minima)
+#-(or lispm excl lcl3.0 Minima CMU)
 (defmacro holding-lock ((locator display &optional whostate &key timeout) &body body)
   (declare (ignore locator display whostate timeout))
   `(progn ,@body))
 
+;;; HOLDING-LOCK for CMU Common Lisp.
+;;;
+;;; We are not multi-processing, but we use this macro to try to protect
+;;; against re-entering request functions.  This can happen if an interrupt
+;;; occurs and the handler attempts to use X over the same display connection.
+;;; This can happen if the GC hooks are used to notify the user over the same
+;;; display connection.  We lock out GC's just as a dummy check for our users.
+;;; Locking out interrupts has the problem that CLX always waits for replies
+;;; within this dynamic scope, so if the server cannot reply for some reason,
+;;; we potentially dead-lock without interrupts.
+;;;
+#+CMU
+(defmacro holding-lock ((locator display &optional whostate &key timeout)
+			&body body)
+  (declare (ignore locator display whostate timeout))
+  `(lisp::without-gcing (system:without-interrupts (progn ,@body))))
+
 #+Genera
 (defmacro holding-lock ((locator display &optional whostate &key timeout)
 			&body body)
@@ -1077,7 +1097,8 @@
 
 #+Minima
 (defun process-wakeup (process)
-  (minima:process-wakeup process))
+  (when process
+    (minima:process-wakeup process)))
 
 ;;; CURRENT-PROCESS: Return the current process object for input locking and
 ;;; for calling PROCESS-WAKEUP.
@@ -1201,7 +1222,7 @@
 ;;; OPEN-X-STREAM - create a stream for communicating to the appropriate X
 ;;; server
 
-#-(or explorer Genera lucid kcl ibcl excl Minima)
+#-(or explorer Genera lucid kcl ibcl excl Minima CMU)
 (defun open-x-stream (host display protocol)
   host display protocol ;; unused
   (error "OPEN-X-STREAM not implemented yet."))
@@ -1305,9 +1326,33 @@
 #+Minima
 (defun open-x-stream (host display protocol)
   (declare (ignore protocol));; unused
-  (minima:open-tcp-stream (minima:gensym-tcp-port)
-			  (apply #'minima:make-ip-address (cdr (host-address host)))
-			  (+ *x-tcp-port* display) :element-type '(unsigned-byte 8)))
+  (minima:open-tcp-stream :foreign-address (apply #'minima:make-ip-address
+						  (cdr (host-address host)))
+			  :foreign-port (+ *x-tcp-port* display)))
+
+;;; OPEN-X-STREAM -- for CMU Common Lisp.
+;;;
+;;; The file descriptor here just gets tossed into the stream slot of the
+;;; display object instead of a stream.
+;;;
+#+CMU
+(defun open-x-stream (host display protocol)
+  (declare (ignore protocol))
+  (let ((server-fd (connect-to-server host display)))
+    (unless (plusp server-fd)
+      (error "Failed to connect to X11 server: ~A (display ~D)" host display))
+    (system:make-fd-stream server-fd :input t :output t
+			   :element-type '(unsigned-byte 8))))
+
+;;; This loads the C foreign function used to make an IPC connection
+;;; to the X11 server.  It also defines the necessary types and things
+;;; to actually make the foreign call.  See the OPEN-X-STREAM function
+;;; in the dependent.lisp file.
+;;;
+#+CMU
+(ext:def-c-routine ("connect_to_server" connect-to-server) (ext:int)
+  (host system:null-terminated-string)
+  (port ext:int))
 
 ;;; BUFFER-READ-DEFAULT - read data from the X stream
 
@@ -1318,12 +1363,12 @@
   (declare (type display display)
 	   (type buffer-bytes vector)
 	   (type array-index start end)
-	   (type (or null number) timeout))
+	   (type (or null (real 0 *)) timeout))
   #.(declare-buffun)
   (let ((stream (display-input-stream display)))
     (or (cond ((null stream))
 	      ((funcall stream :listen) nil)
-	      ((eql timeout 0) :timeout)
+	      ((and timeout (= timeout 0)) :timeout)
 	      ((buffer-input-wait-default display timeout)))
 	(multiple-value-bind (ignore eofp)
 	    (funcall stream :string-in nil vector start end)
@@ -1338,16 +1383,15 @@
   (declare (type display display)
 	   (type buffer-bytes vector)
 	   (type array-index start end)
-	   (type (or null number) timeout))
+	   (type (or null (real 0 *)) timeout))
   #.(declare-buffun)
     
   (let* ((howmany (- end start))
 	 (fd (display-input-stream display)))
     (declare (type array-index howmany)
 	     (fixnum fd))
-	  
     (or (cond ((fd-char-avail-p fd) nil)
-	      ((eql timeout 0) :timeout)
+	      ((and timeout (= timeout 0)) :timeout)
 	      ((buffer-input-wait-default display timeout)))
 	(fd-read-bytes fd vector start howmany))))
 
@@ -1372,13 +1416,13 @@
   (declare (type display display)
 	   (type buffer-bytes vector)
 	   (type array-index start end)
-	   (type (or null number) timeout))
+	   (type (or null (real 0 *)) timeout))
   #.(declare-buffun)
   (let ((stream (display-input-stream display)))
     (declare (type (or null stream) stream))
     (or (cond ((null stream))
 	      ((listen stream) nil)
-	      ((eql timeout 0) :timeout)
+	      ((and timeout (= timeout 0)) :timeout)
 	      ((buffer-input-wait-default display timeout)))
 	(with-underlying-stream (stream stream display input)
 	  (eq (lcl:read-array stream vector start end nil :eof) :eof)))))
@@ -1390,41 +1434,53 @@
   (declare (type display display)
 	   (type buffer-bytes vector)
 	   (type array-index start end)
-	   (type (or null number) timeout))
+	   (type (or null (real 0 *)) timeout))
   #.(declare-buffun)
   (let ((stream (display-input-stream display)))
     (or (cond ((null stream))
 	      ((listen stream) nil)
-	      ((eql timeout 0) :timeout)
+	      ((and timeout (= timeout 0)) :timeout)
 	      ((buffer-input-wait-default display timeout)))
-	(loop while (< start end) do
-	  (multiple-value-bind (buffer bstart bend)
-	      (minima:get-input-buffer stream nil)
-	    (when (null buffer) (return t))
-	    (let ((n (min (- end start) (- bend bstart))))
-	      (replace vector buffer
-		       :start1 start :end1 (incf start n)
-		       :start2 bstart :end2 (incf bstart n)))
-	    (minima:advance-input-buffer stream bstart)))
-	nil)))
+	(eq :eof (minima:read-vector vector stream nil start end)))))
+
+;;; BUFFER-READ-DEFAULT for CMU Common Lisp.
+;;;
+;;;    If timeout is 0, then we call LISTEN to see if there is any input.
+;;; Timeout 0 is the only case where READ-INPUT dives into BUFFER-READ without
+;;; first calling BUFFER-INPUT-WAIT-DEFAULT.
+;;;
+#+CMU
+(defun buffer-read-default (display vector start end timeout)
+  (declare (type display display)
+	   (type buffer-bytes vector)
+	   (type array-index start end)
+	   (type (or null (real 0 *)) timeout))
+  #.(declare-buffun)
+  (cond ((and (and timeout (= timeout 0))
+	      (not (listen (display-input-stream display))))
+	 :timeout)
+	(t
+	 (system:read-n-bytes (display-input-stream display)
+			      vector start (- end start))
+	 nil)))
 
 ;;; WARNING:
 ;;;	CLX performance will suffer if your lisp uses read-byte for
 ;;;	receiving all data from the X Window System server.
 ;;;	You are encouraged to write a specialized version of
 ;;;	buffer-read-default that does block transfers.
-#-(or Genera explorer excl lcl3.0 Minima)
+#-(or Genera explorer excl lcl3.0 Minima CMU)
 (defun buffer-read-default (display vector start end timeout)
   (declare (type display display)
 	   (type buffer-bytes vector)
 	   (type array-index start end)
-	   (type (or null (rational 0 *) (float 0.0 *)) timeout))
+	   (type (or null (real 0 *)) timeout))
   #.(declare-buffun)
   (let ((stream (display-input-stream display)))
     (declare (type (or null stream) stream))
     (or (cond ((null stream))
 	      ((listen stream) nil)
-	      ((eql timeout 0) :timeout)
+	      ((and timeout (= timeout 0)) :timeout)
 	      ((buffer-input-wait-default display timeout)))
 	(do* ((index start (index1+ index)))
 	     ((index>= index end) nil)
@@ -1484,13 +1540,16 @@
   (let ((stream (display-output-stream display)))
     (declare (type (or null stream) stream))
     (unless (null stream) 
-      (loop while (< start end) do
-	(multiple-value-bind (buffer bstart bend)
-	    (minima:get-output-buffer stream)
-	  (let ((n (min (- end start) (- bend bstart))))
-	    (replace buffer vector
-		     :start1 bstart :end1 (incf bstart n) :start2 start :end2 (incf start n) ))
-	    (minima:advance-output-buffer stream bstart))))))
+      (minima:write-vector vector stream start end))))
+
+#+CMU
+(defun buffer-write-default (vector display start end)
+  (declare (type buffer-bytes vector)
+	   (type display display)
+	   (type array-index start end))
+  #.(declare-buffun)
+  (system:output-raw-bytes (display-output-stream display) vector start end)
+  nil)
 
 ;;; WARNING:
 ;;;	CLX performance will be severely degraded if your lisp uses
@@ -1498,7 +1557,7 @@
 ;;;	You are STRONGLY encouraged to write a specialized version
 ;;;	of buffer-write-default that does block transfers.
 
-#-(or Genera explorer excl lcl3.0 Minima)
+#-(or Genera explorer excl lcl3.0 Minima CMU)
 (defun buffer-write-default (vector display start end)
   ;; The default buffer write function for use with common-lisp streams
   (declare (type buffer-bytes vector)
@@ -1558,20 +1617,20 @@
 ;;; The default implementation
 
 ;; Poll for input every *buffer-read-polling-time* SECONDS.
-#-(or Genera explorer excl lcl3.0)
+#-(or Genera explorer excl lcl3.0 CMU)
 (defparameter *buffer-read-polling-time* 0.5)
 
-#-(or Genera explorer excl lcl3.0)
+#-(or Genera explorer excl lcl3.0 CMU)
 (defun buffer-input-wait-default (display timeout)
   (declare (type display display)
-	   (type (or null number) timeout))
-  (declare (values timeout))
+	   (type (or null (real 0 *)) timeout))
+  (declare (clx-values timeout))
   
   (let ((stream (display-input-stream display)))
     (declare (type (or null stream) stream))
     (cond ((null stream))
 	  ((listen stream) nil)
-	  ((eql timeout 0) :timeout)
+	  ((and timeout (= timeout 0)) :timeout)
 	  ((not (null timeout))
 	   (multiple-value-bind (npoll fraction)
 	       (truncate timeout *buffer-read-polling-time*)
@@ -1585,16 +1644,31 @@
 		 (return-from buffer-input-wait-default nil)))
 	     :timeout)))))
 
+#+CMU
+(defun buffer-input-wait-default (display timeout)
+  (declare (type display display)
+	   (type (or null (real 0 *)) timeout))
+  (let ((stream (display-input-stream display)))
+    (declare (type (or null stream) stream))
+    (cond ((null stream))
+	  ((listen stream) nil)
+	  ((and timeout (= timeout 0)) :timeout)
+	  (t
+	   (if (system:wait-until-fd-usable (system:fd-stream-fd stream)
+					    :input timeout)
+	       nil
+	       :timeout)))))
+
 #+Genera
 (defun buffer-input-wait-default (display timeout)
   (declare (type display display)
-	   (type (or null number) timeout))
-  (declare (values timeout))
+	   (type (or null (real 0 *)) timeout))
+  (declare (clx-values timeout))
   (let ((stream (display-input-stream display)))
     (declare (type (or null stream) stream))
     (cond ((null stream))
 	  ((scl:send stream :listen) nil)
-	  ((eql timeout 0) :timeout)
+	  ((and timeout (= timeout 0)) :timeout)
 	  ((null timeout) (si:stream-input-block stream "CLX Input"))
 	  (t
 	   (scl:condition-bind ((neti:protocol-timeout
@@ -1608,13 +1682,13 @@
 #+explorer
 (defun buffer-input-wait-default (display timeout)
   (declare (type display display)
-	   (type (or null number) timeout))
-  (declare (values timeout))
+	   (type (or null (real 0 *)) timeout))
+  (declare (clx-values timeout))
   (let ((stream (display-input-stream display)))
     (declare (type (or null stream) stream))
     (cond ((null stream))
 	  ((zl:send stream :listen) nil)
-	  ((eql timeout 0) :timeout)
+	  ((and timeout (= timeout 0)) :timeout)
 	  ((null timeout)
 	   (si:process-wait "CLX Input" stream :listen))
 	  (t
@@ -1637,8 +1711,8 @@
 #+excl
 (defun buffer-input-wait-default (display timeout)
   (declare (type display display)
-	   (type (or null number) timeout))
-  (declare (values timeout))
+	   (type (or null (real 0 *)) timeout))
+  (declare (clx-values timeout))
   (let ((fd (display-input-stream display)))
     (declare (fixnum fd))
     (when (>= fd 0)
@@ -1646,7 +1720,7 @@
 	     nil)
 	    
 	    ;; Otherwise no bytes were available on the socket
-	    ((and timeout (zerop timeout))
+	    ((and timeout (= timeout 0))
 	     ;; If there aren't enough and timeout == 0, timeout.
 	     :timeout)
 	  
@@ -1685,14 +1759,14 @@
 #+lcl3.0
 (defun buffer-input-wait-default (display timeout)
   (declare (type display display)
-	   (type (or null number) timeout)
-	   (values timeout))
+	   (type (or null (real 0 *)) timeout)
+	   (clx-values timeout))
   #.(declare-buffun)
   (let ((stream (display-input-stream display)))
     (declare (type (or null stream) stream))
     (cond ((null stream))
 	  ((listen stream) nil)
-	  ((eql timeout 0) :timeout)
+	  ((and timeout (= timeout 0)) :timeout)
 	  ((with-underlying-stream (stream stream display input)
 	     (lucid::waiting-for-input-from-stream stream
                (lucid::with-io-unlocked
@@ -1797,6 +1871,18 @@
 	      (setf (aref target-sequence target-index)
 		(aref source-sequence source-index))))))
 
+#+cmu
+(defun buffer-replace (buf1 buf2 start1 end1 &optional (start2 0))
+  (declare (type buffer-bytes buf1 buf2)
+	   (type array-index start1 end1 start2))
+  #.(declare-buffun)
+  (kernel:bit-bash-copy
+   buf2 (+ (* start2 vm:byte-bits)
+	   (* vm:vector-data-offset vm:word-bits))
+   buf1 (+ (* start1 vm:byte-bits)
+	   (* vm:vector-data-offset vm:word-bits))
+   (* (- end1 start1) vm:byte-bits)))
+
 #+lucid
 ;;;The compiler is *supposed* to optimize calls to replace, but in actual
 ;;;fact it does not.
@@ -1815,7 +1901,7 @@
 	   (type array-index start1 end1 start2))
   (replace buf1 buf2 :start1 start1 :end1 end1 :start2 start2))
 
-#-(or lispm lucid excl clx-overlapping-arrays)
+#-(or lispm lucid excl CMU clx-overlapping-arrays)
 (defun buffer-replace (buf1 buf2 start1 end1 &optional (start2 0))
   (declare (type buffer-bytes buf1 buf2)
 	   (type array-index start1 end1 start2))
@@ -1920,7 +2006,7 @@
 ;;; This controls macro expansion, and isn't changable at run-time You will
 ;;; probably want to set this to nil if you want good performance at
 ;;; production time.
-(defconstant *type-check?* #+(or Genera Minima) nil #-(or Genera Minima) t)
+(defconstant *type-check?* #+(or Genera Minima CMU) nil #-(or Genera Minima CMU) t)
 
 ;; TYPE? is used to allow the code to do error checking at a different level from
 ;; the declarations.  It also does some optimizations for systems that don't have
@@ -1928,7 +2014,14 @@
 ;; include range checks.  You can modify TYPE? to do less extensive checking
 ;; for these types if you desire.
 
+;;
+;; ### This comment is a lie!  TYPE? is really also used for run-time type
+;; dispatching, not just type checking.  -- Ram.
+
 (defmacro type? (object type)
+  #+cmu
+  `(typep ,object ,type)
+  #-cmu
   (if (not (constantp type))
       `(typep ,object ,type)
     (progn
@@ -2004,17 +2097,43 @@
   (declare (dynamic-extent keyargs))
   (apply #'error condition keyargs))
 
-#+(or clx-ansi-common-lisp excl lcl3.0)
+#+(or clx-ansi-common-lisp excl lcl3.0 CMU)
 (defun x-cerror (proceed-format-string condition &rest keyargs)
   (declare (dynamic-extent keyargs))
   (apply #'cerror proceed-format-string condition keyargs))
 
-#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+;;; X-ERROR for CMU Common Lisp
+;;;
+;;; We detect a couple condition types for which we disable event handling in
+;;; our system.  This prevents going into the debugger or returning to a
+;;; command prompt with CLX repeatedly seeing the same condition.  This occurs
+;;; because CMU Common Lisp provides for all events (that is, X, input on file
+;;; descriptors, Mach messages, etc.) to come through one routine anyone can
+;;; use to wait for input.
+;;;
+#+CMU
+(defun x-error (condition &rest keyargs)
+  (let ((condx (apply #'make-condition condition keyargs)))
+    (typecase condx
+      ;; This condition no longer exists.
+      #||
+      (server-disconnect
+	(let ((disp (server-disconnect-display condx)))
+	  (warn "Disabled event handling on ~S." disp)
+	  (ext::disable-clx-event-handling disp)))
+      ||#
+      (closed-display
+	(let ((disp (closed-display-display condx)))
+	  (warn "Disabled event handling on ~S." disp)
+	  (ext::disable-clx-event-handling disp))))
+    (error condx)))
+
+#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU)
 (defun x-error (condition &rest keyargs)
   (error "X-Error: ~a"
 	 (princ-to-string (apply #'make-condition condition keyargs))))
 
-#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU)
 (defun x-cerror (proceed-format-string condition &rest keyargs)
   (cerror proceed-format-string "X-Error: ~a"
 	 (princ-to-string (apply #'make-condition condition keyargs))))
@@ -2040,6 +2159,14 @@
 	      slots)
      ,@args))
 
+#+(and CMU (not clx-ansi-common-lisp))
+(defmacro define-condition (name parent-types &optional slots &rest args)
+  `(lisp:define-condition
+     ,name (,(first parent-types))
+     ,(mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
+	      slots)
+     ,@args))
+
 #+(and lispm (not clx-ansi-common-lisp))
 (defmacro define-condition (name parent-types &body options)
   (let ((slot-names
@@ -2099,14 +2226,14 @@
 (sys:defmethod (dbg:document-proceed-type x-error :continue) (stream)
   (format stream continue-format-string))
 
-#+(or clx-ansi-common-lisp excl lcl3.0)
+#+(or clx-ansi-common-lisp excl lcl3.0 CMU)
 (define-condition x-error (error) ())
 
-#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU)
 (defstruct x-error
   report-function)
 
-#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU)
 (defmacro define-condition (name parent-types &body options)
   ;; Define a structure that when printed displays an error message
   (flet ((reporter-for-condition (name)
@@ -2143,7 +2270,7 @@
 	       ,condition))
 	 ',name))))
 
-#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU)
 (defun condition-print (condition stream depth)
   (declare (type x-error condition)
 	   (type stream stream)
@@ -2153,14 +2280,14 @@
     (funcall (x-error-report-function condition) condition stream))
   condition)
   
-#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU)
 (defun make-condition (type &rest slot-initializations)
   (declare (dynamic-extent slot-initializations))
   (let ((make-function (intern (concatenate 'string (string 'make-) (string type))
 			       (symbol-package type))))
     (apply make-function slot-initializations)))
 
-#-(or clx-ansi-common-lisp excl lcl3.0)
+#-(or clx-ansi-common-lisp excl lcl3.0 CMU)
 (define-condition type-error (x-error)
   ((datum :reader type-error-datum :initarg :datum)
    (expected-type :reader type-error-expected-type :initarg :expected-type))
@@ -2175,13 +2302,13 @@
 ;;  HOST hacking
 ;;-----------------------------------------------------------------------------
 
-#-(or explorer Genera Minima)
+#-(or explorer Genera Minima Allegro CMU)
 (defun host-address (host &optional (family :internet))
   ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
   ;; and cdr is a list of network address bytes.
-  (declare (type (or stringable list) host)
+  (declare (type stringable host)
 	   (type (or null (member :internet :decnet :chaos) card8) family))
-  (declare (values list))
+  (declare (clx-values list))
   host family
   (error "HOST-ADDRESS not implemented yet."))
 
@@ -2189,11 +2316,11 @@
 (defun host-address (host &optional (family :internet))
   ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
   ;; and cdr is a list of network address bytes.
-  (declare (type (or stringable list) host)
+  (declare (type stringable host)
 	   (type (or null (member :internet :decnet :chaos) card8) family))
-  (declare (values list))
+  (declare (clx-values list))
   (ecase family
-    (:internet
+    ((:internet nil 0)
      (let ((addr (ip:get-ip-address host)))
        (unless addr (error "~s isn't an internet host name" host))
        (list :internet
@@ -2201,7 +2328,7 @@
 	     (ldb (byte 8 16) addr)
 	     (ldb (byte 8 8) addr)
 	     (ldb (byte 8 0) addr))))
-    (:chaos
+    ((:chaos 2)
      (let ((addr (first (chaos:chaos-addresses host))))
        (unless addr (error "~s isn't a chaos host name" host))
        (list :chaos
@@ -2212,54 +2339,111 @@
 (defun host-address (host &optional (family :internet))
   ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
   ;; and cdr is a list of network address bytes.
-  (declare (type (or stringable list) host)
+  (declare (type stringable host)
 	   (type (or null (member :internet :decnet :chaos) card8) family))
-  (declare (values list))
-  (let ((net-type (if (eq family :DECnet)
-		      :DNA
-		      family)))
+  (declare (clx-values list))
+  (setf host (string host))
+  (let ((net-type (ecase family
+		    ((:internet nil 0) :internet)
+		    ((:DECnet 1) :dna)
+		    ((:chaos 2) :chaos))))
     (dolist (addr
 	      (sys:send (net:parse-host host) :network-addresses)
-	      (error "~s isn't a valid ~(~A~) host name" host family))
+	      (error "~S isn't a valid ~(~A~) host name" host family))
       (let ((network (car addr))
 	    (address (cadr addr)))
 	(when (sys:send network :network-typep net-type)
 	  (return (ecase family
-		    (:internet
-		      (multiple-value-bind (a b c d) (tcp:explode-internet-address address)
-			(list :internet a b c d)))
-		    ((:chaos :DECnet)
-		     (list family (ldb (byte 8 0) address) (ldb (byte 8 8) address))))))))))
+		    ((:internet nil 0)
+		     (multiple-value-bind (a b c d) (tcp:explode-internet-address address)
+		       (list :internet a b c d)))
+		    ((:DECnet 1)
+		     (list :DECnet (ldb (byte 8 0) address) (ldb (byte 8 8) address)))
+		    ((:chaos 2)
+		     (list :chaos (ldb (byte 8 0) address) (ldb (byte 8 8) address))))))))))
 
 #+Minima
 (defun host-address (host &optional (family :internet))
   ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
   ;; and cdr is a list of network address bytes.
-  (declare (type (or stringable list) host)
+  (declare (type stringable host)
+	   (type (or null (member :internet :decnet :chaos) card8) family))
+  (declare (clx-values list))
+  (etypecase family
+    ((:internet nil 0)
+      (list* :internet
+	     (multiple-value-list
+	       (minima:ip-address-components (minima:parse-ip-address (string host))))))))
+
+#+Allegro
+(defun host-address (host &optional (family :internet))
+  ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
+  ;; and cdr is a list of network address bytes.
+  (declare (type stringable host)
+	   (type (or null (member :internet :decnet :chaos) card8) family))
+  (declare (clx-values list))
+  (labels ((no-host-error ()
+	     (error "Unknown host ~S" host))
+	   (no-address-error ()
+	     (error "Host ~S has no ~S address" host family)))
+    (let ((hostent 0))
+      (unwind-protect
+	   (progn
+	     (setf hostent (ipc::gethostbyname (string host)))
+	     (when (zerop hostent)
+	       (no-host-error))
+	     (ecase family
+	       ((:internet nil 0)
+		(unless (= (ipc::hostent-addrtype hostent) 2)
+		  (no-address-error))
+		(assert (= (ipc::hostent-length hostent) 4))
+		(let ((addr (ipc::hostent-addr hostent)))
+		   (when (or (member comp::.target.
+				     '(:hp :sgi4d :sony :dec3100)
+				     :test #'eq)
+			     (probe-file "/lib/ld.so"))
+		     ;; BSD 4.3 based systems require an extra indirection
+		     (setq addr (si:memref-int addr 0 0 :unsigned-long)))
+		  (list :internet
+			(si:memref-int addr 0 0 :unsigned-byte)
+			(si:memref-int addr 1 0 :unsigned-byte)
+			(si:memref-int addr 2 0 :unsigned-byte)
+			(si:memref-int addr 3 0 :unsigned-byte))))))
+	(ff:free-cstruct hostent)))))
+
+#+CMU
+(defun host-address (host &optional (family :internet))
+  ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
+  ;; and cdr is a list of network address bytes.
+  (declare (type stringable host)
 	   (type (or null (member :internet :decnet :chaos) card8) family))
-  (declare (values list))
-  (check-type family (member :internet))
-  (or (loop with (num delim)
-	    repeat 4
-	    for idx = 0 then (1+ delim)
-	    when (and delim (or (= delim (length host))
-				(char-not-equal (char host delim) #\.)))
-	      return nil
-	    do (multiple-value-setq (num delim)
-	         (parse-integer host :start idx :junk-allowed t))
-	    when (or (null num) (< num 0) (> num 255))
-	      return nil
-	    else collect num into nums
-	    finally (return (when (= delim (length host))
-			      (cons :internet nums))))
-      (error "Invalid internet address [~A]." host)))
+  (declare (clx-values list))
+  (labels ((no-host-error ()
+	     (error "Unknown host ~S" host))
+	   (no-address-error ()
+	     (error "Host ~S has no ~S address" host family)))
+    (let ((hostent (ext:lookup-host-entry (string host))))
+      (when (not hostent)
+	(no-host-error))
+      (ecase family
+	((:internet nil 0)
+	 (unless (= (ext::host-entry-addr-type hostent) 2)
+	   (no-address-error))
+	 (let ((addr (first (ext::host-entry-addr-list hostent))))
+	   (list :internet
+		 (ldb (byte 8 24) addr)
+		 (ldb (byte 8 16) addr)
+		 (ldb (byte 8  8) addr)
+		 (ldb (byte 8  0) addr))))))))
+
+;;;
 
 #+explorer ;; This isn't required, but it helps make sense of the results from access-hosts
 (defun get-host (host-object)
   ;; host-object is a list whose car is the family keyword (:internet :DECnet :Chaos)
   ;; and cdr is a list of network address bytes.
   (declare (type list host-object))
-  (declare (values string family))
+  (declare (clx-values string family))
   (let* ((family (first host-object))
 	 (address (ecase family
 		    (:internet
@@ -2282,7 +2466,7 @@
   ;; host-object is a list whose car is the family keyword (:internet :DECnet :Chaos)
   ;; and cdr is a list of network address bytes.
   (declare (type list host-object))
-  (declare (values string family))
+  (declare (clx-values string family))
   (let ((family (first host-object)))
     (values (sys:send (net:get-host-from-address 
 			(ecase family
@@ -2296,6 +2480,20 @@
 		      :name)
 	    family)))
 
+;;; This isn't required, but it helps make sense of the results from access-hosts
+#+Minima
+(defun get-host (host-object)
+  ;; host-object is a list whose car is the family keyword (:internet :DECnet :Chaos)
+  ;; and cdr is a list of network address bytes.
+  (declare (type list host-object))
+  (declare (clx-values string family))
+  (let ((family (first host-object)))
+    (values (ecase family
+	      (:internet
+		(minima:ip-address-string
+		  (apply #'minima:make-ip-address (rest host-object)))))
+	    family)))
+
 
 ;;-----------------------------------------------------------------------------
 ;; Whether to use closures for requests or not.
@@ -2311,38 +2509,57 @@
   #+(or lispm Minima) t
   #-(or lispm Minima) nil)
 
+#+(or Genera Minima)
+(defun clx-macroexpand (form env)
+  (declare (ignore env))
+  form)
+
+#-(or Genera Minima)
+(defun clx-macroexpand (form env)
+  (macroexpand form env))
+
 
 ;;-----------------------------------------------------------------------------
 ;; Resource stuff
 ;;-----------------------------------------------------------------------------
 
 
+;;; Utilities 
+
+(defun getenv (name)
+  #+excl (sys:getenv name)
+  #+lcl3.0 (lcl:environment-value name)
+  #+CMU (cdr (assoc name ext:*environment-list* :test #'string=))
+  #-(or excl lcl3.0 CMU) (progn name nil))
+
+(defun homedir-file-pathname (name)
+  (and #-(or unix mach) (search "Unix" (software-type) :test #'char-equal)
+       (merge-pathnames (user-homedir-pathname) (pathname name))))
+
 ;;; DEFAULT-RESOURCES-PATHNAME - The pathname of the resources file to load if
 ;;; a resource manager isn't running.
 
 (defun default-resources-pathname ()
-  (when #+unix t #-unix (search "Unix" (software-type) :test #'char-equal)
-    (merge-pathnames (user-homedir-pathname) (pathname ".Xdefaults"))))
-
-
+  (homedir-file-pathname ".Xdefaults"))
 
 ;;; RESOURCES-PATHNAME - The pathname of the resources file to load after the
 ;;; defaults have been loaded.
 
 (defun resources-pathname ()
-  (when #+unix t #-unix (search "Unix" (software-type) :test #'char-equal)
-    (or #+(or excl (and lcl3.0 (not vax-vms)))
-	(let ((string (#+excl sys:getenv
-		       #+lcl3.0 lcl:environment-variable
-		       "XENVIRONMENT")))
-	  (when string
-	    (pathname string)))
-	(merge-pathnames
-	  (user-homedir-pathname)
-	  (pathname 
-	    (concatenate 'simple-string ".Xdefaults-"
-			 #+excl (short-site-name)
-			 #-excl (machine-instance)))))))
+  (or (let ((string (getenv "XENVIRONMENT")))
+	(and string
+	     (pathname string)))
+      (homedir-file-pathname (concatenate 'string ".Xdefaults-"
+					  #+excl (short-site-name)
+					  #-excl (machine-instance)))))
+
+;;; AUTHORITY-PATHNAME - The pathname of the authority file.
+
+(defun authority-pathname ()
+  (or (let ((xauthority (getenv "XAUTHORITY")))
+	(and xauthority
+	     (pathname xauthority)))
+      (homedir-file-pathname ".Xauthority")))
 
 
 ;;-----------------------------------------------------------------------------
@@ -2415,12 +2632,12 @@
 ;;; When MASK-MODIFIERS is missing, all other modifiers are ignored.
 ;;; In ambiguous cases, the most specific translation is used.
 
-#+(or (not clx-ansi-common-lisp) lispm allegro)
+#-(or (and clx-ansi-common-lisp (not lispm) (not allegro)) CMU)
 (defun default-keysym-translate (display state object)
   (declare (type display display)
 	   (type card16 state)
 	   (type t object)
-	   (values t)
+	   (clx-values t)
 	   (special left-meta-keysym right-meta-keysym
 		    left-super-keysym right-super-keysym
 		    left-hyper-keysym right-hyper-keysym))
@@ -2438,13 +2655,13 @@
       (setf (char-bit object :hyper) 1)))
   object)
 
-#+(and clx-ansi-common-lisp (not lispm) (not allegro))
+#+(or (and clx-ansi-common-lisp (not lispm) (not allegro)) CMU)
 (defun default-keysym-translate (display state object)
   (declare (type display display)
 	   (type card16 state)
 	   (type t object)
 	   (ignore display state)
-	   (values t))
+	   (clx-values t))
   object)
 
 
@@ -2513,7 +2730,7 @@
 			  ,bits-per-element)
 			:element-type ',element-type
 			:displaced-to ,pixarray)))
-       (declare (array-register ,variable))
+       (declare (type (vector ,element-type) ,variable))
        ,@body)))
 
 #+lcl3.0
@@ -2640,7 +2857,7 @@
   
 #+(or Genera lcl3.0 excl) 
 (defun compute-image-byte-and-bit-ordering ()
-  (declare (values image-byte-lsb-first-p image-bit-lsb-first-p))
+  (declare (clx-values image-byte-lsb-first-p image-bit-lsb-first-p))
   ;; First compute the ordering 
   (let ((ordering nil)
 	(a (make-array '(1 32) :element-type 'bit :initial-element 0)))
diff --git a/clx/display.lisp b/clx/display.lisp
index fd6ee060c..a8f5307b5 100644
--- a/clx/display.lisp
+++ b/clx/display.lisp
@@ -20,6 +20,62 @@
 
 (in-package :xlib)
 
+;;; Authorizaton
+
+(defparameter *known-authorizations* '("MIT-MAGIC-COOKIE-1"))
+
+(defun get-best-authorization (host display protocol)
+  (labels ((read-short (stream &optional (eof-errorp t))
+	     (let ((high-byte (read-byte stream eof-errorp)))
+	       (and high-byte
+		    (dpb high-byte (byte 8 8) (read-byte stream)))))
+	   (read-short-length-string (stream)
+	     (let ((length (read-short stream)))
+	       (let ((string (make-string length)))
+		 (dotimes (k length)
+		   (setf (schar string k) (card8->char (read-byte stream))))
+		 string)))
+	   (read-short-length-vector (stream)
+	     (let ((length (read-short stream)))
+	       (let ((vector (make-array length :element-type '(unsigned-byte 8))))
+		 (dotimes (k length)
+		   (setf (aref vector k) (read-byte stream)))
+		 vector))))
+    (let ((pathname (authority-pathname)))
+      (when pathname
+	(with-open-file (stream pathname :element-type '(unsigned-byte 8)
+				:if-does-not-exist nil)
+	  (when stream
+	    (let* ((host-family (ecase protocol
+				  ((:tcp :internet nil) 0)
+				  ((:dna :DECnet) 1)
+				  ((:chaos) 2)))
+		   (host-address (rest (host-address host host-family)))
+		   (best-name nil)
+		   (best-data nil))
+	      (loop
+		(let ((family (read-short stream nil)))
+		  (when (null family)
+		    (return))
+		  (let* ((address (read-short-length-vector stream))
+			 (number (parse-integer (read-short-length-string stream)))
+			 (name (read-short-length-string stream))
+			 (data (read-short-length-vector stream)))
+		    (when (and (= family host-family)
+			       (equal host-address (coerce address 'list))
+			       (= number display)
+			       (let ((pos1 (position name *known-authorizations* :test #'string=)))
+				 (and pos1
+				      (or (null best-name)
+					  (< pos1 (position best-name *known-authorizations*
+							    :test #'string=))))))
+		      (setf best-name name)
+		      (setf best-data data)))))
+	      (when best-name
+		(return-from get-best-authorization
+		  (values best-name best-data)))))))))
+  (values "" ""))
+
 ;;
 ;; Resource id management
 ;;
@@ -38,7 +94,7 @@
 (defun resourcealloc (display)
   ;; Allocate a resource-id for in DISPLAY
   (declare (type display display))
-  (declare (values resource-id))
+  (declare (clx-values resource-id))
   (dpb (incf (display-resource-id-count display))
        (display-resource-id-byte display)
        (display-resource-id-base display)))
@@ -68,7 +124,7 @@
   (declare (type display display)
 	   (type integer id)
 	   (type t object))
-  (declare (values object))
+  (declare (clx-values object))
   (setf (gethash id (display-resource-id-map display)) object))
 
 ;; Define functions to find the CLX data types given a display and resource-id
@@ -81,7 +137,7 @@
 			       (display id)
 			  (declare (type display display)
 				   (type resource-id id))
-			  (declare (values ,type))
+			  (declare (clx-values ,type))
 			  ,(if (member type *clx-cached-types*)
 			       `(let ((,type (lookup-resource-id display id)))
 				  (cond ((null ,type) ;; Not found, create and save it.
@@ -117,14 +173,14 @@
   ;; Return the cached atom for an atom ID
   (declare (type resource-id id)
 	   (type display display))
-  (declare (values (or null keyword)))
+  (declare (clx-values (or null keyword)))
   (gethash id (display-atom-id-map display)))
 
 (defun atom-id (atom display)
   ;; Return the ID for an atom in DISPLAY
   (declare (type xatom atom)
 	   (type display display))
-  (declare (values (or null resource-id)))
+  (declare (clx-values (or null resource-id)))
   (gethash (if (or (null atom) (keywordp atom)) atom (kintern atom))
 	   (display-atom-cache display)))
 
@@ -133,7 +189,7 @@
   (declare (type xatom atom)
 	   (type display display)
 	   (type resource-id id))
-  (declare (values resource-id))
+  (declare (clx-values resource-id))
   (let ((atom (if (or (null atom) (keywordp atom)) atom (kintern atom))))
     (setf (gethash id (display-atom-id-map display)) atom)
     (setf (gethash atom (display-atom-cache display)) id)
@@ -149,7 +205,7 @@
 (defun visual-info (display visual-id)
   (declare (type display display)
 	   (type resource-id visual-id)
-	   (values visual-info))
+	   (clx-values visual-info))
   (when (zerop visual-id)
     (return-from visual-info nil))
   (dolist (screen (display-roots display))
@@ -223,8 +279,7 @@
 		      ,@(and timeout `(:timeout ,timeout)))
 	 ,@body))))
 
-(defun open-display (host  &rest options &key (display 0) protocol
-		     authorization-name authorization-data &allow-other-keys)
+(defun open-display (host &key (display 0) protocol authorization-name authorization-data)
   ;; Implementation specific routine to setup the buffer for a specific host and display.
   ;; This must interface with the local network facilities, and will probably do special
   ;; things to circumvent the nework when displaying on the local host.
@@ -233,26 +288,25 @@
   ;; for host and protocol are not constrained, and will likely be very
   ;; system dependent.  The default protocol is system specific.  Authorization,
   ;; if any, is assumed to come from the environment somehow.
-  (declare (type integer display)
-	   (dynamic-extent options))
-  (declare (values display))
+  (declare (type integer display))
+  (declare (clx-values display))
+  ;; Get the authorization mechanism from the environment.
+  (when (null authorization-name)
+    (multiple-value-setq (authorization-name authorization-data)
+      (get-best-authorization host display protocol)))
   ;; PROTOCOL is the network protocol (something like :TCP :DNA or :CHAOS). See OPEN-X-STREAM.
   (let* ((stream (open-x-stream host display protocol))
-	 (disp (apply #'make-buffer
-		      *output-buffer-size*
-		      'make-display-internal
-		      :host host
-		      :display display
-		      :output-stream stream
-		      :input-stream stream
-		      :allow-other-keys t
-		      options))
+	 (disp (make-buffer *output-buffer-size* #'make-display-internal
+			    :host host :display display
+			    :output-stream stream :input-stream stream))
 	 (ok-p nil))
     (unwind-protect
 	(progn
 	  (display-connect disp
 			   :authorization-name authorization-name
 			   :authorization-data authorization-data)
+	  (setf (display-authorization-name disp) authorization-name)
+	  (setf (display-authorization-data disp) authorization-data)
 	  (initialize-resource-allocator disp)
 	  (initialize-predefined-atoms disp)
 	  (initialize-extensions disp)
@@ -272,8 +326,6 @@
   (close-buffer display :abort abort))
 
 (defun display-connect (display &key authorization-name authorization-data)
-  (unless authorization-name (setq authorization-name ""))
-  (unless authorization-data (setq authorization-data ""))
   (with-buffer-output (display :sizes (8 16))
     (card8-put
       0
@@ -285,8 +337,11 @@
     (card16-put 6 (length authorization-name))
     (card16-put 8 (length authorization-data))
     (write-sequence-char display 12 authorization-name)
-    (write-sequence-char display
-			 (lround (+ 12 (length authorization-name))) authorization-data))
+    (if (stringp authorization-data)
+	(write-sequence-char display (lround (+ 12 (length authorization-name)))
+			     authorization-data)
+	(write-sequence-card8 display (lround (+ 12 (length authorization-name)))
+			      authorization-data)))
   (buffer-force-output display)
   (let ((reply-buffer nil))
     (declare (type (or null reply-buffer) reply-buffer))
@@ -420,13 +475,13 @@
 
 (defun display-protocol-version (display)
   (declare (type display display))
-  (declare (values major minor))
+  (declare (clx-values major minor))
   (values (display-protocol-major-version display)
 	  (display-protocol-minor-version display)))
 
 (defun display-vendor (display)
   (declare (type display display))
-  (declare (values name release))
+  (declare (clx-values name release))
   (values (display-vendor-name display)
 	  (display-release-number display)))
 
diff --git a/clx/doc.lisp b/clx/doc.lisp
index a1bf83619..bff618e14 100644
--- a/clx/doc.lisp
+++ b/clx/doc.lisp
@@ -57,10 +57,7 @@
 
 ;; Note: all of the following is in the package XLIB.
 
-;; Note: various perversions of the CL type system are used below.
-;; Examples: (list elt-type) (sequence elt-type)
-
-(proclaim '(declaration arglist values))
+(declaim (declaration arglist clx-values))
 
 ;; Note: if you have read the Version 11 protocol document or C Xlib manual, most of
 ;; the relationships should be fairly obvious.  We have no intention of writing yet
@@ -106,18 +103,18 @@
 
 (defun <mumble>-display (<mumble>)
   (declare (type <mumble> <mumble>)
-	   (values display)))
+	   (clx-values display)))
 
 (defun <mumble>-id (<mumble>)
   (declare (type <mumble> <mumble>)
-	   (values resource-id)))
+	   (clx-values resource-id)))
 
 (defun <mumble>-equal (<mumble>-1 <mumble>-2)
   (declare (type <mumble> <mumble>-1 <mumble>-2)))
 
 (defun <mumble>-p (<mumble>)
   (declare (type <mumble> <mumble>)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 ;; The following functions are provided by color objects:
 
@@ -129,26 +126,26 @@
 
 (defun make-color (&key red green blue &allow-other-keys)	; for expansion
   (declare (type rgb-val red green blue)
-	   (values color)))
+	   (clx-values color)))
 
 (defun color-rgb (color)
   (declare (type color color)
-	   (values red green blue)))
+	   (clx-values red green blue)))
 
 (defun color-red (color)
   ;; setf'able
   (declare (type color color)
-	   (values rgb-val)))
+	   (clx-values rgb-val)))
 
 (defun color-green (color)
   ;; setf'able
   (declare (type color color)
-	   (values rgb-val)))
+	   (clx-values rgb-val)))
 
 (defun color-blue (color)
   ;; setf'able
   (declare (type color color)
-	   (values rgb-val)))
+	   (clx-values rgb-val)))
 
 (deftype drawable () '(or window pixmap))
 
@@ -187,6 +184,9 @@
 
 (deftype alist (key-type-and-name datum-type-and-name) 'list)
 
+(deftype clx-list (&optional element-type) 'list)
+(deftype clx-sequence (&optional element-type) 'sequence)
+
 ;; A sequence, containing zero or more repetitions of the given elements,
 ;; with the elements expressed as (type name).
 
@@ -215,7 +215,7 @@
 	   :focus-change :property-change :colormap-change :keymap-state))
 
 (deftype event-mask ()
-  '(or mask32 (list event-mask-class)))
+  '(or mask32 (clx-list event-mask-class)))
 
 (deftype pointer-event-mask-class ()
   '(member :button-press :button-release
@@ -224,7 +224,7 @@
 	   :button-5-motion :button-motion :keymap-state))
 
 (deftype pointer-event-mask ()
-  '(or mask32 (list pointer-event-mask-class)))
+  '(or mask32 (clx-list pointer-event-mask-class)))
 
 (deftype device-event-mask-class ()
   '(member :key-press :key-release :button-press :button-release :pointer-motion
@@ -232,13 +232,13 @@
 	   :button-5-motion :button-motion))
 
 (deftype device-event-mask ()
-  '(or mask32 (list device-event-mask-class)))
+  '(or mask32 (clx-list device-event-mask-class)))
 
 (deftype modifier-key ()
   '(member :shift :lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5))
 
 (deftype modifier-mask ()
-  '(or (member :any) mask16 (list modifier-key)))
+  '(or (member :any) mask16 (clx-list modifier-key)))
 
 (deftype state-mask-key ()
   '(or modifier-key (member :button-1 :button-2 :button-3 :button-4 :button-5)))
@@ -293,7 +293,7 @@
   (height <unspec> :type card16)
   (width-in-millimeters <unspec> :type card16)
   (height-in-millimeters <unspec> :type card16)
-  (depths <unspec> :type (alist (image-depth depth) ((list visual-info) visuals)))
+  (depths <unspec> :type (alist (image-depth depth) ((clx-list visual-info) visuals)))
   (root-depth <unspec> :type image-depth)
   (root-visual-info <unspec> :type visual-info)
   (default-colormap <unspec> :type colormap)
@@ -307,7 +307,7 @@
 
 (defun screen-root-visual (screen)
   (declare (type screen screen)
-	   (values resource-id)))
+	   (clx-values resource-id)))
 
 ;; The list contains alternating keywords and integers.
 
@@ -319,62 +319,62 @@
   ;; default protocol is system specific.  Authorization, if any, is assumed to come
   ;; from the environment somehow.
   (declare (type integer display)
-	   (values display)))
+	   (clx-values display)))
 
 (defun display-protocol-major-version (display)
   (declare (type display display)
-	   (values card16)))
+	   (clx-values card16)))
 
 (defun display-protocol-minor-version (display)
   (declare (type display display)
-	   (values card16)))
+	   (clx-values card16)))
 
 (defun display-vendor-name (display)
   (declare (type display display)
-	   (values string)))
+	   (clx-values string)))
 
 (defun display-release-number (display)
   (declare (type display display)
-	   (values card32)))
+	   (clx-values card32)))
 
 (defun display-image-lsb-first-p (display)
   (declare (type display display)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 (defun display-bitmap-formap (display)
   (declare (type display display)
-	   (values bitmap-format)))
+	   (clx-values bitmap-format)))
 
 (defun display-pixmap-formats (display)
   (declare (type display display)
-	   (values (list pixmap-formats))))
+	   (clx-values (clx-list pixmap-formats))))
 
 (defun display-roots (display)
   (declare (type display display)
-	   (values (list screen))))
+	   (clx-values (clx-list screen))))
 
 (defun display-motion-buffer-size (display)
   (declare (type display display)
-	   (values card32)))
+	   (clx-values card32)))
 
 (defun display-max-request-length (display)
   (declare (type display display)
-	   (values card16)))
+	   (clx-values card16)))
 
 (defun display-min-keycode (display)
   (declare (type display display)
-	   (values card8)))
+	   (clx-values card8)))
 
 (defun display-max-keycode (display)
   (declare (type display display)
-	   (values card8)))
+	   (clx-values card8)))
 
 (defun close-display (display)
   (declare (type display display)))
 
 (defun display-error-handler (display)
   (declare (type display display)
-	   (values handler)))
+	   (clx-values handler)))
 
 (defsetf display-error-handler (display) (handler)
   ;; All errors (synchronous and asynchronous) are processed by calling an error
@@ -397,8 +397,8 @@
   ;; For :value errors, another pair is:
   ;;    :value card32
   (declare (type display display)
-	   (type (or (sequence (function (display symbol &rest key-vals)))
-		     (function (display symbol &rest key-vals)))
+	   (type (or (clx-sequence (function (display symbol &key &allow-other-keys)))
+		     (function (display symbol &key &allow-other-keys)))
 		 handler)))
 
 (defsetf display-report-asynchronous-errors (display) (when)
@@ -450,7 +450,7 @@
   current-sequence
   asynchronous)
 
-(defun default-error-handler (display error-key &rest key-vals)
+(defun default-error-handler (display error-key &key &allow-other-keys)
   ;; The default display-error-handler.
   ;; It signals the conditions listed below.
   (declare (type display display)
@@ -525,7 +525,7 @@
   ;; request.  Default value is nil.  Can be set, for example, to
   ;; #'display-force-output or #'display-finish-output.
   (declare (type display display)
-	   (values (or null (function (display))))))
+	   (clx-values (or null (function (display))))))
 
 (defun create-window (&key parent x y width height (depth 0) (border-width 0)
 		      (class :copy) (visual :copy)
@@ -552,19 +552,19 @@
 	   (type (or null (member :on :off)) save-under override-redirect)
 	   (type (or null (member :copy) colormap) colormap)
 	   (type (or null (member :none) cursor) cursor)
-	   (values window)))
+	   (clx-values window)))
 
 (defun window-class (window)
   (declare (type window window)
-	   (values (member :input-output :input-only))))
+	   (clx-values (member :input-output :input-only))))
 
 (defun window-visual-info (window)
   (declare (type window window)
-	   (values visual-info)))
+	   (clx-values visual-info)))
 
 (defun window-visual (window)
   (declare (type window window)
-	   (values resource-id)))
+	   (clx-values resource-id)))
 
 (defsetf window-background (window) (background)
   (declare (type window window)
@@ -577,51 +577,51 @@
 (defun window-gravity (window)
   ;; setf'able
   (declare (type window window)
-	   (values win-gravity)))
+	   (clx-values win-gravity)))
 
 (defun window-bit-gravity (window)
   ;; setf'able
   (declare (type window window)
-	   (values bit-gravity)))
+	   (clx-values bit-gravity)))
 
 (defun window-backing-store (window)
   ;; setf'able
   (declare (type window window)
-	   (values (member :not-useful :when-mapped :always))))
+	   (clx-values (member :not-useful :when-mapped :always))))
 
 (defun window-backing-planes (window)
   ;; setf'able
   (declare (type window window)
-	   (values pixel)))
+	   (clx-values pixel)))
 
 (defun window-backing-pixel (window)
   ;; setf'able
   (declare (type window window)
-	   (values pixel)))
+	   (clx-values pixel)))
 
 (defun window-save-under (window)
   ;; setf'able
   (declare (type window window)
-	   (values (member :on :off))))
+	   (clx-values (member :on :off))))
 
 (defun window-event-mask (window)
   ;; setf'able
   (declare (type window window)
-	   (values mask32)))
+	   (clx-values mask32)))
 
 (defun window-do-not-propagate-mask (window)
   ;; setf'able
   (declare (type window window)
-	   (values mask32)))
+	   (clx-values mask32)))
 
 (defun window-override-redirect (window)
   ;; setf'able
   (declare (type window window)
-	   (values (member :on :off))))
+	   (clx-values (member :on :off))))
 
 (defun window-colormap (window)
   (declare (type window window)
-	   (values (or null colormap))))
+	   (clx-values (or null colormap))))
 
 (defsetf window-colormap (window) (colormap)
   (declare (type window window)
@@ -633,15 +633,15 @@
 
 (defun window-colormap-installed-p (window)
   (declare (type window window)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 (defun window-all-event-masks (window)
   (declare (type window window)
-	   (values mask32)))
+	   (clx-values mask32)))
 
 (defun window-map-state (window)
   (declare (type window window)
-	   (values (member :unmapped :unviewable :viewable))))
+	   (clx-values (member :unmapped :unviewable :viewable))))
 
 (defsetf drawable-x (window) (x)
   (declare (type window window)
@@ -744,38 +744,38 @@
 
 (defun drawable-root (drawable)
   (declare (type drawable drawable)
-	   (values window)))
+	   (clx-values window)))
 
 (defun drawable-depth (drawable)
   (declare (type drawable drawable)
-	   (values card8)))
+	   (clx-values card8)))
 
 (defun drawable-x (drawable)
   (declare (type drawable drawable)
-	   (values int16)))
+	   (clx-values int16)))
 
 (defun drawable-y (drawable)
   (declare (type drawable drawable)
-	   (values int16)))
+	   (clx-values int16)))
 
 (defun drawable-width (drawable)
   ;; For windows, inside width, excluding border.
   (declare (type drawable drawable)
-	   (values card16)))
+	   (clx-values card16)))
 
 (defun drawable-height (drawable)
   ;; For windows, inside height, excluding border.
   (declare (type drawable drawable)
-	   (values card16)))
+	   (clx-values card16)))
 
 (defun drawable-border-width (drawable)
   (declare (type drawable drawable)
-	   (values card16)))
+	   (clx-values card16)))
 
 (defun query-tree (window &key (result-type 'list))
   (declare (type window window)
 	   (type type result-type)
-	   (values (sequence window) parent root)))
+	   (clx-values (clx-sequence window) parent root)))
 
 (defun change-property (window property data type format
 			&key (mode :replace) (start 0) end transform)
@@ -806,18 +806,18 @@
 	   (type boolean delete-p)
 	   (type type result-type)
 	   (type (or null (function (integer) t)) transform)
-	   (values data type format bytes-after)))
+	   (clx-values data type format bytes-after)))
 
 (defun rotate-properties (window properties &optional (delta 1))
   ;; Postive rotates left, negative rotates right (opposite of actual protocol request).
   (declare (type window window)
-	   (type (sequence xatom) properties)
+	   (type (clx-sequence xatom) properties)
 	   (type int16 delta)))
 
 (defun list-properties (window &key (result-type 'list))
   (declare (type window window)
 	   (type type result-type)
-	   (values (sequence keyword))))
+	   (clx-values (clx-sequence keyword))))
 
 ;; Although atom-ids are not visible in the normal user interface, atom-ids might
 ;; appear in window properties and other user data, so conversion hooks are needed.
@@ -825,22 +825,22 @@
 (defun intern-atom (display name)
   (declare (type display display)
 	   (type xatom name)
-	   (values resource-id)))
+	   (clx-values resource-id)))
 
 (defun find-atom (display name)
   (declare (type display display)
 	   (type xatom name)
-	   (values (or null resource-id))))
+	   (clx-values (or null resource-id))))
 
 (defun atom-name (display atom-id)
   (declare (type display display)
 	   (type resource-id atom-id)
-	   (values keyword)))
+	   (clx-values keyword)))
 
 (defun selection-owner (display selection)
   (declare (type display display)
 	   (type xatom selection)
-	   (values (or null window))))
+	   (clx-values (or null window))))
 
 (defsetf selection-owner (display selection &optional time) (owner)
   ;; A bit strange, but retains setf form.
@@ -877,7 +877,7 @@
 	   (type (or null window) confine-to)
 	   (type (or null cursor) cursor)
 	   (type timestamp time)
-	   (values grab-status)))
+	   (clx-values grab-status)))
 
 (defun ungrab-pointer (display &key time)
   (declare (type display display)
@@ -909,7 +909,7 @@
   (declare (type window window)
 	   (type boolean owner-p sync-pointer-p sync-keyboard-p)
 	   (type timestamp time)
-	   (values grab-status)))
+	   (clx-values grab-status)))
 
 (defun ungrab-keyboard (display &key time)
   (declare (type display display)
@@ -946,28 +946,28 @@
 
 (defun query-pointer (window)
   (declare (type window window)
-	   (values x y same-screen-p child mask root-x root-y root)))
+	   (clx-values x y same-screen-p child mask root-x root-y root)))
 
 (defun pointer-position (window)
   (declare (type window window)
-	   (values x y same-screen-p)))
+	   (clx-values x y same-screen-p)))
 
 (defun global-pointer-position (display)
   (declare (type display display)
-	   (values root-x root-y root)))
+	   (clx-values root-x root-y root)))
 
 (defun motion-events (window &key start stop (result-type 'list))
   (declare (type window window)
 	   (type timestamp start stop)
 	   (type type result-type)
-	   (values (repeat-seq (int16 x) (int16 y) (timestamp time)))))
+	   (clx-values (repeat-seq (int16 x) (int16 y) (timestamp time)))))
 
 (defun translate-coordinates (src src-x src-y dst)
   ;; If src and dst are not on the same screen, nil is returned.
   (declare (type window src)
 	   (type int16 src-x src-y)
 	   (type window dst)
-	   (values dst-x dst-y child)))
+	   (clx-values dst-x dst-y child)))
 
 (defun warp-pointer (dst dst-x dst-y)
   (declare (type window dst)
@@ -1002,11 +1002,11 @@
 
 (defun input-focus (display)
   (declare (type display display)
-	   (values focus revert-to)))
+	   (clx-values focus revert-to)))
 
 (defun query-keymap (display)
   (declare (type display display)
-	   (values (bit-vector 256))))
+	   (clx-values (bit-vector 256))))
 
 (defun open-font (display name)
   ;; Font objects may be cached and reference counted locally within the display
@@ -1014,7 +1014,7 @@
   ;; The protocol QueryFont request happens on-demand under the covers.
   (declare (type display display)
 	   (type stringable name)
-	   (values font)))
+	   (clx-values font)))
 
 ;; We probably want a per-font bit to indicate whether caching on
 ;; text-extents/width calls is desirable.  But what to name it?
@@ -1034,51 +1034,51 @@
 (defun font-name (font)
   ;; Returns nil for a pseudo font returned by gcontext-font.
   (declare (type font font)
-	   (values (or null string))))
+	   (clx-values (or null string))))
 
 (defun font-direction (font)
   (declare (type font font)
-	   (values draw-direction)))
+	   (clx-values draw-direction)))
 
 (defun font-min-char (font)
   (declare (type font font)
-	   (values card16)))
+	   (clx-values card16)))
 
 (defun font-max-char (font)
   (declare (type font font)
-	   (values card16)))
+	   (clx-values card16)))
 
 (defun font-min-byte1 (font)
   (declare (type font font)
-	   (values card8)))
+	   (clx-values card8)))
 
 (defun font-max-byte1 (font)
   (declare (type font font)
-	   (values card8)))
+	   (clx-values card8)))
 
 (defun font-min-byte2 (font)
   (declare (type font font)
-	   (values card8)))
+	   (clx-values card8)))
 
 (defun font-max-byte2 (font)
   (declare (type font font)
-	   (values card8)))
+	   (clx-values card8)))
 
 (defun font-all-chars-exist-p (font)
   (declare (type font font)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 (defun font-default-char (font)
   (declare (type font font)
-	   (values card16)))
+	   (clx-values card16)))
 
 (defun font-ascent (font)
   (declare (type font font)
-	   (values int16)))
+	   (clx-values int16)))
 
 (defun font-descent (font)
   (declare (type font font)
-	   (values int16)))
+	   (clx-values int16)))
 
 ;; The list contains alternating keywords and int32s.
 
@@ -1086,12 +1086,12 @@
 
 (defun font-properties (font)
   (declare (type font font)
-	   (values font-props)))
+	   (clx-values font-props)))
 
 (defun font-property (font name)
   (declare (type font font)
 	   (type keyword name)
-	   (values (or null int32))))
+	   (clx-values (or null int32))))
 
 ;; For each of left-bearing, right-bearing, width, ascent, descent, attributes:
 
@@ -1101,17 +1101,17 @@
   ;; signalling might be better.
   (declare (type font font)
 	   (type card16 index)
-	   (values (or null int16))))
+	   (clx-values (or null int16))))
 
 (defun max-char-<metric> (font)
   ;; Note: I have tentatively chosen separate accessors over allowing :min and
   ;; :max as an index above.
   (declare (type font font)
-	   (values int16)))
+	   (clx-values int16)))
 
 (defun min-char-<metric> (font)
   (declare (type font font)
-	   (values int16)))
+	   (clx-values int16)))
 
 ;; Note: char16-<metric> accessors could be defined to accept two-byte indexes.
 
@@ -1125,7 +1125,7 @@
 	   (type string pattern)
 	   (type card16 max-fonts)
 	   (type type result-type)
-	   (values (sequence string))))
+	   (clx-values (clx-sequence string))))
 
 (defun list-fonts (display pattern &key (max-fonts 65535) (result-type 'list))
   ;; Returns "pseudo" fonts that contain basic font metrics and properties, but
@@ -1137,22 +1137,22 @@
 	   (type string pattern)
 	   (type card16 max-fonts)
 	   (type type result-type)
-	   (values (sequence font))))
+	   (clx-values (clx-sequence font))))
 
 (defun font-path (display &key (result-type 'list))
   (declare (type display display)
 	   (type type result-type)
-	   (values (sequence (or string pathname)))))
+	   (clx-values (clx-sequence (or string pathname)))))
 
 (defsetf font-path (display) (paths)
   (declare (type display display)
-	   (type (sequence (or string pathname)) paths)))
+	   (type (clx-sequence (or string pathname)) paths)))
 
 (defun create-pixmap (&key width height depth drawable)
   (declare (type card16 width height)
 	   (type card8 depth)
 	   (type drawable drawable)
-	   (values pixmap)))
+	   (clx-values pixmap)))
 
 (defun free-pixmap (pixmap)
   (declare (type pixmap pixmap)))
@@ -1191,9 +1191,9 @@
 	   (type (or null (member :on :off)) exposures)
 	   (type (or null (member :none) pixmap rect-seq) clip-mask)
 	   (type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) clip-ordering)
-	   (type (or null (or card8 (sequence card8))) dashes)
+	   (type (or null (or card8 (clx-sequence card8))) dashes)
 	   (type boolean cache)
-	   (values gcontext)))
+	   (clx-values gcontext)))
 
 ;; For each argument to create-gcontext (except font, clip-mask and
 ;; clip-ordering) declared as (type <type> <name>), there is an accessor:
@@ -1202,7 +1202,7 @@
   ;; The value will be nil if the last value stored is unknown (e.g., the cache was
   ;; off, or the component was copied from a gcontext with unknown state).
   (declare (type gcontext gcontext)
-	   (values <type>)))
+	   (clx-values <type>)))
 
 ;; For each argument to create-gcontext (except clip-mask and clip-ordering) declared
 ;; as (type (or null <type>) <name>), there is a setf for the corresponding accessor:
@@ -1220,11 +1220,11 @@
   ;; result in an invalid-font error.
   (declare (type gcontext gcontext)
 	   (type boolean metrics-p)
-	   (values (or null font))))
+	   (clx-values (or null font))))
 
 (defun gcontext-clip-mask (gcontext)
   (declare (type gcontext gcontext)
-	   (values (or null (member :none) pixmap rect-seq)
+	   (clx-values (or null (member :none) pixmap rect-seq)
 		   (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)))))
 
 (defsetf gcontext-clip-mask (gcontext &optional ordering) (clip-mask)
@@ -1255,7 +1255,7 @@
 
 (defun copy-gcontext-components (src dst &rest keys)
   (declare (type gcontext src dst)
-	   (type (list gcontext-key) keys)))
+	   (type (clx-list gcontext-key) keys)))
 
 (defun copy-gcontext (src dst)
   (declare (type gcontext src dst))
@@ -1363,7 +1363,7 @@
   ;; other arguments.
   (declare (type drawable drawable)
 	   (type gcontext gcontext)
-	   (type (sequence card8) data)
+	   (type (clx-sequence card8) data)
 	   (type array-index start)
 	   (type card8 depth left-pad)
 	   (type int16 x y)
@@ -1379,13 +1379,13 @@
   ;; transmission format; the caller is responsible for any byte and bit swapping and
   ;; compaction required for further local use.
   (declare (type drawable drawable)
-	   (type (or null (sequence card8)) data)
+	   (type (or null (clx-sequence card8)) data)
 	   (type array-index start)
 	   (type int16 x y)
 	   (type card16 width height)
 	   (type pixel plane-mask)
 	   (type (member :xy-pixmap :z-pixmap) format)
-	   (values (sequence card8) depth visual-info)))
+	   (clx-values (clx-sequence card8) depth visual-info)))
 
 (defun translate-default (src src-start src-end font dst dst-start)
   ;; dst is guaranteed to have room for (- src-end src-start) integer elements,
@@ -1406,7 +1406,7 @@
 	   (type array-index src-start src-end dst-start)
 	   (type (or null font) font)
 	   (type vector dst)
-	   (values array-index (or null int16 font) (or null int32))))
+	   (clx-values array-index (or null int16 font) (or null int32))))
 
 ;; There is a question below of whether translate should always be required, or
 ;; if not, what the default should be or where it should come from.  For
@@ -1424,7 +1424,7 @@
   (declare (type sequence sequence)
 	   (type (or font gcontext) font)
 	   (type translate translate)
-	   (values width ascent descent left right font-ascent font-descent direction
+	   (clx-values width ascent descent left right font-ascent font-descent direction
 		   (or null array-index))))
 
 (defun text-width (font sequence &key (start 0) end translate)
@@ -1432,7 +1432,7 @@
   (declare (type sequence sequence)
 	   (type (or font gcontext) font)
 	   (type translate translate)
-	   (values int32 (or null array-index))))
+	   (clx-values int32 (or null array-index))))
 
 ;; This controls the element size of the dst buffer given to translate.  If
 ;; :default is specified, the size will be based on the current font, if known,
@@ -1466,7 +1466,7 @@
 	   (type translate translate)
 	   (type (or null int32) width)
 	   (type index-size size)
-	   (values boolean (or null int32))))
+	   (clx-values boolean (or null int32))))
 
 (defun draw-glyphs (drawable gcontext x y sequence
 		    &key (start 0) end translate width (size :default))
@@ -1481,7 +1481,7 @@
 	   (type (or null int32) width)
 	   (type translate translate)
 	   (type index-size size)
-	   (values (or null array-index) (or null int32))))
+	   (clx-values (or null array-index) (or null int32))))
 
 (defun draw-image-glyph (drawable gcontext x y elt
 			 &key translate width (size :default))
@@ -1494,7 +1494,7 @@
 	   (type translate translate)
 	   (type (or null int32) width)
 	   (type index-size size)
-	   (values boolean (or null int32))))
+	   (clx-values boolean (or null int32))))
 
 (defun draw-image-glyphs (drawable gcontext x y sequence
 			  &key (start 0) end width translate (size :default))
@@ -1514,20 +1514,20 @@
 	   (type (or null int32) width)
 	   (type translate translate)
 	   (type index-size size)
-	   (values (or null array-index) (or null int32))))
+	   (clx-values (or null array-index) (or null int32))))
 
 (defun create-colormap (visual window &optional alloc-p)
   (declare (type visual-info visual)
 	   (type window window)
 	   (type boolean alloc-p)
-	   (values colormap)))
+	   (clx-values colormap)))
 
 (defun free-colormap (colormap)
   (declare (type colormap colormap)))
 
 (defun copy-colormap-and-free (colormap)
   (declare (type colormap colormap)
-	   (values colormap)))
+	   (clx-values colormap)))
 
 (defun install-colormap (colormap)
   (declare (type colormap colormap)))
@@ -1538,19 +1538,19 @@
 (defun installed-colormaps (window &key (result-type 'list))
   (declare (type window window)
 	   (type type result-type)
-	   (values (sequence colormap))))
+	   (clx-values (clx-sequence colormap))))
 
 (defun alloc-color (colormap color)
   (declare (type colormap colormap)
 	   (type (or stringable color) color)
-	   (values pixel screen-color exact-color)))
+	   (clx-values pixel screen-color exact-color)))
 
 (defun alloc-color-cells (colormap colors &key (planes 0) contiguous-p (result-type 'list))
   (declare (type colormap colormap)
 	   (type card16 colors planes)
 	   (type boolean contiguous-p)
 	   (type type result-type)
-	   (values (sequence pixel) (sequence mask))))
+	   (clx-values (clx-sequence pixel) (clx-sequence mask))))
 
 (defun alloc-color-planes (colormap colors
 			   &key (reds 0) (greens 0) (blues 0)
@@ -1559,11 +1559,11 @@
 	   (type card16 colors reds greens blues)
 	   (type boolean contiguous-p)
 	   (type type result-type)
-	   (values (sequence pixel) red-mask green-mask blue-mask)))
+	   (clx-values (clx-sequence pixel) red-mask green-mask blue-mask)))
 
 (defun free-colors (colormap pixels &optional (plane-mask 0))
   (declare (type colormap colormap)
-	   (type (sequence pixel) pixels)
+	   (type (clx-sequence pixel) pixels)
 	   (type pixel plane-mask)))
 
 (defun store-color (colormap pixel spec &key (red-p t) (green-p t) (blue-p t))
@@ -1582,21 +1582,21 @@
 
 (defun query-colors (colormap pixels &key (result-type 'list))
   (declare (type colormap colormap)
-	   (type (sequence pixel) pixels)
+	   (type (clx-sequence pixel) pixels)
 	   (type type result-type)
-	   (values (sequence color))))
+	   (clx-values (clx-sequence color))))
 
 (defun lookup-color (colormap name)
   (declare (type colormap colormap)
 	   (type stringable name)
-	   (values screen-color true-color)))
+	   (clx-values screen-color true-color)))
 
 (defun create-cursor (&key source mask x y foreground background)
   (declare (type pixmap source)
 	   (type (or null pixmap) mask)
 	   (type card16 x y)
 	   (type color foreground background)
-	   (values cursor)))
+	   (clx-values cursor)))
 
 (defun create-glyph-cursor (&key source-font source-char mask-font mask-char
 				 foreground background)
@@ -1605,7 +1605,7 @@
 	   (type (or null font) mask-font)
 	   (type (or null card16) mask-char)
 	   (type color foreground background)
-	   (values cursor)))
+	   (clx-values cursor)))
 
 (defun free-cursor (cursor)
   (declare (type cursor cursor)))
@@ -1617,27 +1617,27 @@
 (defun query-best-cursor (width height drawable)
   (declare (type card16 width height)
 	   (type drawable display)
-	   (values width height)))
+	   (clx-values width height)))
 
 (defun query-best-tile (width height drawable)
   (declare (type card16 width height)
 	   (type drawable drawable)
-	   (values width height)))
+	   (clx-values width height)))
 
 (defun query-best-stipple (width height drawable)
   (declare (type card16 width height)
 	   (type drawable drawable)
-	   (values width height)))
+	   (clx-values width height)))
 
 (defun query-extension (display name)
   (declare (type display display)
 	   (type stringable name)
-	   (values major-opcode first-event first-error)))
+	   (clx-values major-opcode first-event first-error)))
 
 (defun list-extensions (display &key (result-type 'list))
   (declare (type display display)
 	   (type type result-type)
-	   (values (sequence string))))
+	   (clx-values (clx-sequence string))))
 
 ;; Should pointer-mapping setf be changed to set-pointer-mapping?
 
@@ -1646,13 +1646,13 @@
   ;; Setf ought to allow multiple values.
   ;; Returns true for success, nil for failure
   (declare (type display display)
-	   (type (sequence card8) shift lock control mod1 mod2 mod3 mod4 mod5)
-	   (values (member :success :busy :failed))))
+	   (type (clx-sequence card8) shift lock control mod1 mod2 mod3 mod4 mod5)
+	   (clx-values (member :success :busy :failed))))
 
 (defun modifier-mapping (display)
   ;; each value is a list of card8s
   (declare (type display display)
-	   (values shift lock control mod1 mod2 mod3 mod4 mod5)))
+	   (clx-values shift lock control mod1 mod2 mod3 mod4 mod5)))
 
 ;; Either we will want lots of defconstants for well-known values, or perhaps
 ;; an integer-to-keyword translation function for well-known values.
@@ -1677,7 +1677,7 @@
 	   (type (or null card8) first-keycode)
 	   (type (or null array-index) start end)
 	   (type (or null (array * (* *))) data)
-	   (values (array * (* *)))))
+	   (clx-values (array * (* *)))))
 
 (defun change-keyboard-control (display &key key-click-percent
 				bell-percent bell-pitch bell-duration
@@ -1691,7 +1691,7 @@
 
 (defun keyboard-control (display)
   (declare (type display display)
-	   (values key-click-percent bell-percent bell-pitch bell-duration
+	   (clx-values key-click-percent bell-percent bell-pitch bell-duration
 		   led-mask global-auto-repeat auto-repeats)))
 
 (defun bell (display &optional (percent-from-normal 0))
@@ -1703,12 +1703,12 @@
 (defun pointer-mapping (display &key (result-type 'list))
   (declare (type display display)
 	   (type type result-type)
-	   (values (sequence card8))))
+	   (clx-values (clx-sequence card8))))
 
 (defsetf pointer-mapping (display) (map)
   ;; Can signal device-busy.
   (declare (type display display)
-	   (type (sequence card8) map)))
+	   (type (clx-sequence card8) map)))
 
 (defun change-pointer-control (display &key acceleration threshold)
   ;; Acceleration is rationalized if necessary.
@@ -1718,7 +1718,7 @@
 
 (defun pointer-control (display)
   (declare (type display display)
-	   (values acceleration threshold)))
+	   (clx-values acceleration threshold)))
 
 (defun set-screen-saver (display timeout interval blanking exposures)
   ;; Setf ought to allow multiple values.
@@ -1730,7 +1730,7 @@
 (defun screen-saver (display)
   ;; Returns timeout and interval in seconds.
   (declare (type display display)
-	   (values timeout interval blanking exposures)))
+	   (clx-values timeout interval blanking exposures)))
 
 (defun activate-screen-saver (display)
   (declare (type display display)))
@@ -1753,18 +1753,18 @@
   ;; be acceptable to add-access-host and remove-access-host.
   (declare (type display display)
 	   (type type result-type)
-	   (values (sequence host) enabled-p)))
+	   (clx-values (clx-sequence host) enabled-p)))
 
 (defun access-control (display)
   ;; setf'able
   (declare (type display display)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 (defun close-down-mode (display)
   ;; setf'able
   ;; Cached locally in display object.
   (declare (type display display)
-	   (values (member :destroy :retain-permanent :retain-temporary))))
+	   (clx-values (member :destroy :retain-permanent :retain-temporary))))
 
 (defun kill-client (display resource-id)
   (declare (type display display)
@@ -1776,22 +1776,22 @@
 (defun make-event-mask (&rest keys)
   ;; This is only defined for core events.
   ;; Useful for constructing event-mask, pointer-event-mask, device-event-mask.
-  (declare (type (list event-mask-class) keys)
-	   (values mask32)))
+  (declare (type (clx-list event-mask-class) keys)
+	   (clx-values mask32)))
 
 (defun make-event-keys (event-mask)
   ;; This is only defined for core events.
   (declare (type mask32 event-mask)
-	   (values (list event-mask-class))))
+	   (clx-values (clx-list event-mask-class))))
 
 (defun make-state-mask (&rest keys)
   ;; Useful for constructing modifier-mask, state-mask.
-  (declare (type (list state-mask-key) keys)
-	   (values mask16)))
+  (declare (type (clx-list state-mask-key) keys)
+	   (clx-values mask16)))
 
 (defun make-state-keys (state-mask)
   (declare (type mask16 mask)
-	   (values (list state-mask-key))))
+	   (clx-values (clx-list state-mask-key))))
 
 (defmacro with-event-queue ((display) &body body)
   ;; Grants exclusive access to event queue.
@@ -1800,7 +1800,7 @@
 (defun event-listen (display &optional (timeout 0))
   (declare (type display display)
 	   (type (or null number) timeout)
-	   (values (or null number) (or null (member :timeout) (not null))))
+	   (clx-values (or null number) (or null (member :timeout) (not null))))
   ;; Returns the number of events queued locally, if any, else nil.  Hangs
   ;; waiting for events, forever if timeout is nil, else for the specified
   ;; number of seconds.  The second value returned is :timeout if the
@@ -1826,8 +1826,8 @@
   ;; process-event is invoked recursively, the nested invocation begins with
   ;; the event after the one currently being processed.
   (declare (type display display)
-	   (type (or (sequence (function (&rest key-vals) t))
-		     (function (&rest key-vals) t))
+	   (type (or (clx-sequence (function (&key &allow-other-keys) t))
+		     (function (&key &allow-other-keys) t))
 		 handler)
 	   (type (or null number) timeout)
 	   (type boolean peek-p)))
@@ -1835,14 +1835,14 @@
 (defun make-event-handlers (&key (type 'array) default)
   (declare (type t type)			;Sequence type specifier
 	   (type function default)
-	   (values sequence))			;Default handler for initial content
+	   (clx-values sequence))			;Default handler for initial content
   ;; Makes a handler sequence suitable for process-event
   )
    
 (defun event-handler (handlers event-key)
   (declare (type sequence handlers)
 	   (type event-key event-key)
-	   (values function))
+	   (clx-values function))
   ;; Accessor for a handler sequence
   )
 
@@ -1850,7 +1850,7 @@
   (declare (type sequence handlers)
 	   (type event-key event-key)
 	   (type function handler)
-	   (values function))
+	   (clx-values function))
   ;; Setf accessor for a handler sequence
   )
 
@@ -1932,7 +1932,7 @@
 
 (defun discard-current-event (display)
   (declare (type display display)
-	   (values boolean))
+	   (clx-values boolean))
   ;; Discard the current event for DISPLAY.
   ;; Returns NIL when the event queue is empty, else T.
   ;; To ensure events aren't ignored, application code should only call
@@ -2128,7 +2128,7 @@
   (card16 sequence)
   (window (window event-window))
   ((member 8 16 32) format)
-  ((sequence integer) data))
+  (sequence data))
 
 (defun queue-event (display event-key &rest args &key append-p &allow-other-keys)
   ;; The event is put at the head of the queue if append-p is nil, else the tail.
@@ -2148,19 +2148,19 @@
 
 (defun wm-name (window)
   (declare (type window window)
-	   (values string)))
+	   (clx-values string)))
 
 (defsetf wm-name (window) (name))
 
 (defun wm-icon-name (window)
   (declare (type window window)
-	   (values string)))
+	   (clx-values string)))
 
 (defsetf wm-icon-name (window) (name))
 
 (defun get-wm-class (window)
   (declare (type window window)
-	   (values (or null name-string) (or null class-string))))
+	   (clx-values (or null name-string) (or null class-string))))
 
 (defun set-wm-class (window resource-name resource-class)
   (declare (type window window)
@@ -2170,7 +2170,7 @@
   ;; Returns a list whose car is a command string and 
   ;; whose cdr is the list of argument strings.
   (declare (type window window)
-	   (values (list string))))
+	   (clx-values (clx-list string))))
 
 (defsetf wm-command (window) (command)
   ;; Uses PRIN1 inside the ANSI common lisp form WITH-STANDARD-IO-SYNTAX (or
@@ -2179,13 +2179,13 @@
   ;;   (with-standard-io-syntax (mapcar #'read-from-string (wm-command window)))
   ;; to recover a lisp command.
   (declare (type window window)
-	   (type (list stringable) command)))
+	   (type (clx-list stringable) command)))
 
 (defun wm-client-machine (window)
   ;; Returns a list whose car is a command string and 
   ;; whose cdr is the list of argument strings.
   (declare (type window window)
-	   (values string)))
+	   (clx-values string)))
 
 (defsetf wm-client-machine (window) (string)
   (declare (type window window)
@@ -2206,7 +2206,7 @@
 
 (defun wm-hints (window)
   (declare (type window window)
-	   (values wm-hints)))
+	   (clx-values wm-hints)))
 
 (defsetf wm-hints (window) (wm-hints))
 
@@ -2233,7 +2233,7 @@
 
 (defun wm-normal-hints (window)
   (declare (type window window)
-	   (values wm-size-hints)))
+	   (clx-values wm-size-hints)))
 
 (defsetf wm-normal-hints (window) (wm-size-hints))
 
@@ -2241,29 +2241,29 @@
 
 (defun icon-sizes (window)
   (declare (type window window)
-	   (values wm-size-hints)))
+	   (clx-values wm-size-hints)))
   
 (defsetf icon-sizes (window) (wm-size-hints))
 
 (defun wm-protocols (window)
   (declare (type window window)
-	   (values protocols)))
+	   (clx-values protocols)))
   
 (defsetf wm-protocols (window) (protocols)
   (declare (type window window)
-	   (type (list keyword) protocols)))
+	   (type (clx-list keyword) protocols)))
 
 (defun wm-colormap-windows (window)
   (declare (type window window)
-	   (values windows)))
+	   (clx-values windows)))
   
 (defsetf wm-colormap-windows (window) (windows)
   (declare (type window window)
-	   (type (list window) windows)))
+	   (type (clx-list window) windows)))
 
 (defun transient-for (window)
   (declare (type window window)
-	   (values window)))
+	   (clx-values window)))
 
 (defsetf transient-for (window) (transient)
   (declare (type window window transient)))
@@ -2316,13 +2316,13 @@
   (declare (type window window)
 	   (type (member :rgb_default_map :rgb_best_map :rgb_red_map
 			 :rgb_green_map :rgb_blue_map) property)
-	   (values (list standard-colormap))))
+	   (clx-values (clx-list standard-colormap))))
 
 (defsetf rgb-colormaps (window property) (standard-colormaps)
   (declare (type window window)
 	   (type (member :rgb_default_map :rgb_best_map :rgb_red_map
 			 :rgb_green_map :rgb_blue_map) property)
-	   (type (list standard-colormap) standard-colormaps)))
+	   (type (clx-list standard-colormap) standard-colormaps)))
 
 (defun cut-buffer (display &key (buffer 0) (type :string) (result-type 'string)
 		                (transform #'card8->char) (start 0) end)
@@ -2334,7 +2334,7 @@
 	   (type (or null array-index) end)
 	   (type t result-type)			;a sequence type
 	   (type (or null (function (integer) t)) transform)
-	   (values sequence type format bytes-after)))
+	   (clx-values sequence type format bytes-after)))
 
 (defsetf cut-buffer (display buffer &key (type :string) (format 8)
 			     (transform #'char->card8) (start 0) end) (data))
@@ -2361,7 +2361,7 @@
   ;; Return the character code set name of keysym
   ;; Note that the keyboard set (255) has been broken up into its parts.
   (declare (type keysym keysym)
-	   (values keyword)))
+	   (clx-values keyword)))
 
 (defun define-keysym (object keysym &key lowercase translate modifiers mask display)	              
   ;; Define the translation from keysym/modifiers to a (usually
@@ -2396,16 +2396,16 @@
   ;;
   (declare (type (or base-char t) object)
 	   (type keysym keysym)
-	   (type (or null mask16 list) ;; (list (or keysym state-mask-key))
+	   (type (or null mask16 (clx-list (or keysym state-mask-key)))
 	         modifiers)
-	   (type (or null (member :modifiers) mask16 list) ;; (list (or keysym state-mask-key))
+	   (type (or null (member :modifiers) mask16 (clx-list (or keysym state-mask-key)))
 	         mask)
 	   (type (or null display) display)
            (type (or null keysym) lowercase)
 	   (type (function (display card16 t) t) translate)))
 
 (defvar *default-keysym-translate-mask*
-	(the (or (member :modifiers) mask16 list)	; (list (or keysym state-mask-key))
+	(the (or (member :modifiers) mask16 (clx-list (or keysym state-mask-key)))
 	     (logand #xff (lognot (make-state-mask :lock))))
   "Default keysym state mask to use during keysym-translation.")
 
@@ -2414,7 +2414,7 @@
   ;; If DISPLAY is non-nil, undefine the translation for DISPLAY if it exists.
   (declare (type (or base-char t) object)
 	   (type keysym keysym)
-	   (type (or null mask16 list) ;; (list (or keysym state-mask-key))
+	   (type (or null mask16 (clx-list (or keysym state-mask-key)))
 	         modifiers)
 	   (type (or null display) display)))
 
@@ -2430,7 +2430,7 @@
   (declare (type display display)
 	   (type card16 state)
 	   (type t object)
-	   (values t))) ;; Object returned by keycode->character
+	   (clx-values t))) ;; Object returned by keycode->character
    
 (defmacro keysym (keysym &rest bytes)
   ;; Build a keysym.
@@ -2442,8 +2442,8 @@
   ;; This is a macro and not a function macro to promote compile-time
   ;; lookup. All arguments are evaluated.
   (declare (type t keysym)
-	   (type (list card8) bytes)
-	   (values keysym)))
+	   (type (clx-list card8) bytes)
+	   (clx-values keysym)))
 
 (defun character->keysyms (character &optional display)
   ;; Given a character, return a list of all matching keysyms.
@@ -2453,20 +2453,20 @@
   ;; May be slow [i.e. do a linear search over all known keysyms]
   (declare (type t character)
 	   (type (or null display) display)
-	   (values (list keysym))))
+	   (clx-values (clx-list keysym))))
 
 (defun keycode->keysym (display keycode keysym-index)
   (declare (type display display)
 	   (type card8 code)
 	   (type card16 state)
 	   (type card8 keysym-index)
-	   (values keysym)))
+	   (clx-values keysym)))
 
 (defun keysym->keycodes (display keysym)
   ;; Return keycodes for keysym, as multiple values
   (declare (type display display)
 	   (type keysym keysym)
-	   (values (or null keycode) (or null keycode) (or null keycode)))
+	   (clx-values (or null keycode) (or null keycode) (or null keycode)))
   )
 
 (defun keysym->character (display keysym &optional state)
@@ -2480,7 +2480,7 @@
   (declare (type display display)
 	   (type keysym keysym)
 	   (type (or null card16) state)
-	   (values (or null character))))
+	   (clx-values (or null character))))
 
 (defun keycode->character (display keycode state &key keysym-index
 	                   (keysym-index-function #'default-keysym-index))
@@ -2502,11 +2502,11 @@
 	   (type (or null card8) keysym-index)
 	   (type (or null (function (char0 state caps-lock-p keysyms-per-keycode) card8))
 		 keysym-index-function)
-	   (values (or null character))))
+	   (clx-values (or null character))))
 
 (defun default-keysym-index (display keycode state)
   ;; Returns a keysym-index for use with keycode->character
-  (declare (values card8))
+  (declare (clx-values card8))
 )
 
 ;;; default-keysym-index implements the following tables:
@@ -2536,7 +2536,7 @@
   (declare (type display display)
 	   (type card16 state)
 	   (type keysym keysym)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 (defun mapping-notify (display request start count)
   ;; Called on a mapping-notify event to update
@@ -2572,7 +2572,7 @@
   ;; To define event handlers, use declare-event.
   ;; To define error handlers, use declare-error and define-condition.
   (declare (type stringable name)
-	   (type (list symbol) events errors)))
+	   (type (clx-list symbol) events errors)))
 
 (defmacro extension-opcode (display name)
   ;; Returns the major opcode for extension NAME.
@@ -2581,7 +2581,7 @@
   ;; Note: The case of NAME is important.
   (declare (type display display)
 	   (type stringable name)
-	   (values card8)))
+	   (clx-values card8)))
 
 (defmacro define-error (error-key function)
   ;; Associate a function with ERROR-KEY which will be called with
@@ -2610,7 +2610,7 @@
   (declare (type display display)
 	   (type reply-buffer event)
 	   (type (or null keyword) arg)
-	   (values keyword/arg-plist)))
+	   (clx-values keyword/arg-plist)))
 
 ;; This isn't new, just extended.
 (defmacro declare-event (event-codes &body declares)
@@ -2620,8 +2620,8 @@
   ;; A compiler warning is printed when all of EVENT-CODES are not
   ;; defined by a preceding DEFINE-EXTENSION.
   ;; See the INPUT file for lots of examples.
-  (declare (type (or keyword (list keywords)) event-codes)
-	   (type (alist (field-type symbol) (field-names (list symbol)))
+  (declare (type (or keyword (clx-list keywords)) event-codes)
+	   (type (alist (field-type symbol) (field-names (clx-list symbol)))
                  declares)))
 
 (defmacro define-gcontext-accessor (name &key default set-function copy-function)
@@ -2641,9 +2641,8 @@
   ;;	  (error "Can't copy unknown GContext component ~a" ',name)))
   (declare (type symbol name)
 	   (type t default)
-	   (type (function (gcontext t) t) set-function) ;; required
-	   (type (or null (function (gcontext gcontext t) t))
-		 copy-function)))
+	   (type symbol set-function) ;; required
+	   (type symbol copy-function)))
 
 
 ;; To aid extension implementors in attaching additional information to
@@ -2678,7 +2677,7 @@ drawable-plist
   ;; With no parameters, returns an empty region
   ;; If some parameters are given, all must be given.
   (declare (type (or null int16) x y width height)
-	   (values region)))
+	   (clx-values region)))
 
 (defun region-p (thing))
 
@@ -2686,13 +2685,13 @@ drawable-plist
 
 (defun region-empty-p (region)
   (declare (type region region)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 (defun region-clip-box (region)
   ;; Returns a region which is the smallest enclosing rectangle
   ;; enclosing REGION
   (declare (type region region)
-	   (values region)))
+	   (clx-values region)))
 
 ;; Accessors that return the boundaries of a region
 (defun region-x (region))
@@ -2708,46 +2707,46 @@ drawable-plist
   "Returns a region which is the intersection of one or more REGIONS.
 Returns an empty region if the intersection is empty.
 If there are no regions given, return a very large region."
-  (declare (type (list region) regions)
-	   (values region)))
+  (declare (type (clx-list region) regions)
+	   (clx-values region)))
 
 (defun region-union (&rest regions)
   "Returns a region which is the union of a number of REGIONS
  (i.e. the smallest region that can contain all the other regions)
  Returns the empty region if no regions are given."
-  (declare (type (list region) regions)
-	   (values region)))
+  (declare (type (clx-list region) regions)
+	   (clx-values region)))
 
 (defun region-subtract (region subtract)
   "Returns a region containing the points that are in REGION but not in SUBTRACT"
   (declare (type region region subtract)
-	   (values region)))
+	   (clx-values region)))
 
 (defun point-in-region-p (region x y)
   ;; Returns T when X/Y are a point within REGION.
   (declare (type region region)
 	   (type int16 x y)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 (defun region-equal (a b)
   ;; Returns T when regions a and b contain the same points.
   ;; That is, return t when for every X/Y (point-in-region-p a x y)
   ;; equals (point-in-region-p b x y)
   (declare (type region a b)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 (defun subregion-p (large small)
   "Returns T if SMALL is within LARGE.
  That is, return T when for every X/Y (point-in-region-p small X Y)
  implies (point-in-region-p large X Y)."
   (declare (type region large small)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 (defun region-intersect-p (a b)
   "Returns T if A intersects B.
  That is, return T when there is some point common to regions A and B."
   (declare (type region a b)
-	   (values boolean)))
+	   (clx-values boolean)))
 
 (defun map-region (region function &rest args)
   ;; Calls function with arguments (x y . args) for every point in REGION.
@@ -2763,7 +2762,7 @@ If there are no regions given, return a very large region."
 ;;(defun gcontext-clip-region (gcontext)
 ;;  ;; If the clip-mask of GCONTEXT is known, return it as a region.
 ;;  (declare (type gcontext gcontext)
-;;	   (values (or null region))))
+;;	   (clx-values (or null region))))
 
 ;;(defsetf gcontext-clip-region (gcontext) (region)
 ;;  ;; Set the clip-rectangles or clip-mask for for GCONTEXT to include
@@ -2775,17 +2774,17 @@ If there are no regions given, return a very large region."
   ;; Returns a region containing the 1 bits of a depth-1 image
   ;; Signals an error if image isn't of depth 1.
   (declare (type image image)
-	   (values region)))
+	   (clx-values region)))
 
 (defun region->image (region)
   ;; Returns a depth-1 image containg 1 bits for every pixel in REGION.
   (declare (type region region)
-	   (values image)))
+	   (clx-values image)))
 
 (defun polygon-region (points &optional (fill-rule :even-odd))
   (declare (type sequence points) ;(repeat-seq (integer x) (integer y))
 	   (type (member :even-odd :winding) fill-rule)
-	   (values region)))
+	   (clx-values region)))
 
 ;;;-----------------------------------------------------------------------------
 ;;; IMAGE functions
@@ -2833,7 +2832,7 @@ If there are no regions given, return a very large region."
 (defstruct (image-xy (:include image))
   ;; Public structure
   ;; Use this format for image processing
-  (bitmap-list nil :type (list bitmap)))
+  (bitmap-list nil :type (clx-list bitmap)))
 
 (defstruct (image-z (:include image))
   ;; Public structure
@@ -2853,7 +2852,7 @@ If there are no regions given, return a very large region."
     (type card16 width height)			; Required
     (type (or null card8) depth)		; Defualts to 1
     (type (or (array card8 (*))			;Returns image-x
-	      (list bitmap)			;Returns image-xy
+	      (clx-list bitmap)			;Returns image-xy
 	      pixarray) data)			;Returns image-z
     (type list plist)
     (type (or null stringable) name)
@@ -2867,7 +2866,7 @@ If there are no regions given, return a very large region."
     (type (or null (member 8 16 32)) scanline-pad)
     (type (or null card16) bytes-per-line) ;default from width and scanline-pad
     (type boolean byte-lsb-first-p bit-lsb-first-p)
-    (values image)))
+    (clx-values image)))
 
 (defun get-image (drawable &key 
 		  (x (required-arg x))
@@ -2887,7 +2886,7 @@ If there are no regions given, return a very large region."
 	   (type (or null pixel) plane-mask)
 	   (type (or null (member :xy-pixmap :z-pixmap)) format)
 	   (type (or null (member image-x image-xy image-z)) result-type)
-	   (values image)))
+	   (clx-values image)))
 
 (defun put-image (drawable gcontext image &key
 		  (src-x 0) (src-y 0)
@@ -2911,12 +2910,12 @@ If there are no regions given, return a very large region."
 	   (type card16 x y)
 	   (type (or null card16) width height) ;; Default from image
 	   (type (or null (member image-x image-xy image-z)) result-type)
-	   (values image)))
+	   (clx-values image)))
 
 (defun read-bitmap-file (pathname)
   ;; Creates an image from a C include file in standard X11 format
   (declare (type (or pathname string stream) pathname)
-	   (values image)))
+	   (clx-values image)))
 
 (defun write-bitmap-file (pathname image &optional name)
   ;; Writes an image to a C include file in standard X11 format
@@ -2931,7 +2930,7 @@ If there are no regions given, return a very large region."
 
 (defun make-resource-database ()
   ;; Returns an empty resource data-base
-  (declare (values resource-database)))
+  (declare (clx-values resource-database)))
 
 (defun get-resource (database value-name value-class full-name full-class)
   ;; Return the value of the resource in DATABASE whose partial name
@@ -2939,8 +2938,8 @@ If there are no regions given, return a very large region."
   ;;                      (append full-class (list value-class)).
   (declare (type resource-database database)
 	   (type stringable value-name value-class)
-	   (type (list stringable) full-name full-class)
-	   (values value)))
+	   (type (clx-list stringable) full-name full-class)
+	   (clx-values value)))
 
 (defun add-resource (database name-list value)
   ;; name-list is a list of either strings or symbols. If a symbol, 
@@ -2948,23 +2947,23 @@ If there are no regions given, return a very large region."
   ;; case-sensitive comparisons will be used.  The symbol '* or
   ;; string "*" are used as wildcards, matching anything or nothing.
   (declare (type resource-database database)
-	   (type (list stringable) name-list)
+	   (type (clx-list stringable) name-list)
 	   (type t value)))
 
 (defun delete-resource (database name-list)
   (declare (type resource-database database)
-	   (type (list stringable) name-list)))
+	   (type (clx-list stringable) name-list)))
 
 (defun map-resource (database function &rest args)
   ;; Call FUNCTION on each resource in DATABASE.
   ;; FUNCTION is called with arguments (name-list value . args)
   (declare (type resource-database database)
-	   (type (function ((list stringable) t &rest t) t) function)
-	   (values nil)))
+	   (type (function ((clx-list stringable) t &rest t) t) function)
+	   (clx-values nil)))
 
 (defun merge-resources (database with-database)
   (declare (type resource-database database with-database)
-	   (values resource-database))
+	   (clx-values resource-database))
   (map-resource #'add-resource database with-database)
   with-database)
 
@@ -2980,9 +2979,9 @@ If there are no regions given, return a very large region."
   (declare (type resource-database database)
 	   (type (or pathname string stream) pathname)
 	   (type (or null (function (string) t)) key)
-	   (type (or null (function ((list string) t) boolean))
+	   (type (or null (function ((clx-list string) t) boolean))
                  test test-not)
-	   (values resource-database)))
+	   (clx-values resource-database)))
 
 (defun write-resources (database pathname &key write test test-not)
   ;; Write resources to PATHNAME in the standard X11 format.
@@ -2992,7 +2991,7 @@ If there are no regions given, return a very large region."
   (declare (type resource-database database)
 	   (type (or pathname string stream) pathname)
 	   (type (or null (function (string stream) t)) write)
-	   (type (or null (function ((list string) t) boolean))
+	   (type (or null (function ((clx-list string) t) boolean))
                  test test-not)))
 
 (defun root-resources (screen &key database key test test-not)
@@ -3010,8 +3009,8 @@ If there are no regions given, return a very large region."
   (declare (type (or screen display) screen)
 	   (type (or null resource-database) database)
 	   (type (or null (function (string) t)) key)
-	   (type (or null (function (list t) boolean)) test test-not)
-	   (values resource-database)))
+	   (type (or null (function list boolean)) test test-not)
+	   (clx-values resource-database)))
 
 (defsetf root-resources (screen &key test test-not (write 'princ)) (database)
   "Changes the contents of the root window RESOURCE_MANAGER property for the
@@ -3024,9 +3023,9 @@ If there are no regions given, return a very large region."
 
   (declare (type (or screen display) screen)
 	(type (or null resource-database) database)
-	(type (or null (function (list t) boolean)) test test-not)
+	(type (or null (function list boolean)) test test-not)
 	(type (or null (function (string stream) t)) write)
-	(values resource-database)))
+	(clx-values resource-database)))
 
 ;;;-----------------------------------------------------------------------------
 ;;; Shared GContext's
@@ -3294,7 +3293,7 @@ SetDashes               FORCE-GCONTEXT-CHANGES
 
 SetFontPath
      (setf (font-path font) paths)
-	Where paths is (type (sequence (or string pathname)))
+	Where paths is (type (clx-sequence (or string pathname)))
 
 SetInputFocus           SET-INPUT-FOCUS
 SetKeyboardMapping      CHANGE-KEYBOARD-MAPPING
diff --git a/clx/fonts.lisp b/clx/fonts.lisp
index 8cc20693d..fe3c99535 100644
--- a/clx/fonts.lisp
+++ b/clx/fonts.lisp
@@ -31,17 +31,17 @@
 ;  ;; signalling might be better.
 ;  (declare (type font font)
 ;	   (type integer index)
-;	   (values (or null integer))))
+;	   (clx-values (or null integer))))
 
 ;(defun max-char-<metric> (font)
 ;  ;; Note: I have tentatively chosen separate accessors over allowing :min and
 ;  ;; :max as an index above.
 ;  (declare (type font font)
-;	   (values integer)))
+;	   (clx-values integer)))
 
 ;(defun min-char-<metric> (font)
 ;  (declare (type font font)
-;	   (values integer)))
+;	   (clx-values integer)))
 
 ;; Note: char16-<metric> accessors could be defined to accept two-byte indexes.
 
@@ -64,7 +64,7 @@
 		       `(defun ,name (font index)
 			  (declare (type font font)
 				   (type array-index index))
-			  (declare (values (or null ,type)))
+			  (declare (clx-values (or null ,type)))
 			  (when (and (font-name font)
 				     (index>= (font-max-char font) index (font-min-char font)))
 			    (the ,type
@@ -91,7 +91,7 @@
 		     (push
 		       `(defun ,name (font)
 			  (declare (type font font))
-			  (declare (values (or null ,type)))
+			  (declare (clx-values (or null ,type)))
 			  (when (font-name font)
 			    (the ,type
 				 ,(from
@@ -103,7 +103,7 @@
 		     (push
 		       `(defun ,name (font)
 			  (declare (type font font))
-			  (declare (values (or null ,type)))
+			  (declare (clx-values (or null ,type)))
 			  (when (font-name font)
 			    (the ,type
 				 ,(from
@@ -119,8 +119,7 @@
 				fields))
 		 (declare ,@(mapcar #'(lambda (field) `(type ,@(reverse field))) fields))
 		 (let ((result (make-array ,(length fields) :element-type 'int16)))
-		   (declare (type char-info-vec result)
-			    (array-register result))
+		   (declare (type char-info-vec result))
 		   ,@(do* ((field fields (cdr field))
 			   (var (caar field) (caar field))
 			   (type (cadar field) (cadar field))
@@ -147,7 +146,7 @@
   ;; The protocol QueryFont request happens on-demand under the covers.
   (declare (type display display)
 	   (type stringable name))
-  (declare (values font))
+  (declare (clx-values font))
   (let* ((name-string (string-downcase (string name)))
 	 (font (car (member name-string (display-font-cache display)
 			    :key 'font-name
@@ -169,7 +168,7 @@
 (defun open-font-internal (font)
   ;; Called "under the covers" to open a font object
   (declare (type font font))
-  (declare (values resource-id))
+  (declare (clx-values resource-id))
   (let* ((name-string (font-name font))
 	 (display (font-display font))
 	 (id (allocate-resource-id display font 'font)))
@@ -193,7 +192,7 @@
 (defun query-font (font)
   ;; Internal function called by font and char info accessors
   (declare (type font font))
-  (declare (values font-info))
+  (declare (clx-values font-info))
   (let ((display (font-display font))
 	font-id
 	font-info
@@ -258,7 +257,7 @@
 	   (type string pattern)
 	   (type card16 max-fonts)
 	   (type t result-type)) ;; CL type
-  (declare (values (sequence string)))
+  (declare (clx-values (clx-sequence string)))
   (let ((string (string pattern)))
     (with-buffer-request-and-reply (display *x-listfonts* size :sizes (8 16))
 	 ((card16 max-fonts (length string))
@@ -278,7 +277,7 @@
 	   (type string pattern)
 	   (type card16 max-fonts)
 	   (type t result-type)) ;; CL type
-  (declare (values (sequence font)))
+  (declare (clx-values (clx-sequence font)))
   (let ((string (string pattern))
 	(result nil))
     (with-buffer-request-and-reply (display *x-listfontswithinfo* 60
@@ -331,7 +330,7 @@
 (defun font-path (display &key (result-type 'list))
   (declare (type display display)
 	   (type t result-type)) ;; CL type
-  (declare (values (sequence (or string pathname))))
+  (declare (clx-values (clx-sequence (or string pathname))))
   (with-buffer-request-and-reply (display *x-getfontpath* size :sizes (8 16))
        ()
     (values
@@ -340,7 +339,7 @@
 
 (defun set-font-path (display paths)
   (declare (type display display)
-	   (type sequence paths)) ;; (sequence (or string pathname))
+	   (type (clx-sequence (or string pathname)) paths))
   (let ((path-length (length paths))
 	(request-length 8))
     ;; Find the request length
diff --git a/clx/gcontext.lisp b/clx/gcontext.lisp
index 3e1b531a2..22150ab07 100644
--- a/clx/gcontext.lisp
+++ b/clx/gcontext.lisp
@@ -95,8 +95,14 @@
 (defstruct (gcontext-extension (:type vector) (:copier nil)) ;; un-named
   (name nil :type symbol :read-only t)
   (default nil :type t :read-only t)
-  (set-function #'identity :type (function (gcontext t) t) :read-only t)
-  (copy-function #'identity :type (function (gcontext gcontext t) t) :read-only t))
+  (set-function #'(lambda (gcontext value)
+		    (declare (ignore gcontext))
+		    value)
+		:type (function (gcontext t) t) :read-only t)
+  (copy-function #'(lambda (from-gc to-gc value)
+		     (declare (ignore from-gc to-gc))
+		     value)
+		 :type (function (gcontext gcontext t) t) :read-only t))
 
 (defvar *gcontext-extensions* nil) ;; list of gcontext-extension
 
@@ -144,7 +150,7 @@
 ;  ;; The value will be nil if the last value stored is unknown (e.g., the cache was
 ;  ;; off, or the component was copied from a gcontext with unknown state).
 ;  (declare (type gcontext gcontext)
-;	   (values <type>)))
+;	   (clx-values <type>)))
 
 ;; For each argument to create-gcontext (except clip-mask and clip-ordering) declared
 ;; as (type (or null <type>) <name>), there is a setf for the corresponding accessor:
@@ -178,7 +184,7 @@
 
        (defun ,gcontext-name (gcontext)
 	 (declare (type gcontext gcontext))
-	 (declare (values (or null ,type)))
+	 (declare (clx-values (or null ,type)))
 	 (let ((value (,internal-accessor (gcontext-local-state gcontext))))
 	   (declare (type (or null card32) value))
 	   (when value ;; Don't do anything when value isn't known
@@ -240,7 +246,7 @@
 
 (defun gcontext-clip-mask (gcontext)
   (declare (type gcontext gcontext))
-  (declare (values (or null (member :none) pixmap rect-seq)
+  (declare (clx-values (or null (member :none) pixmap rect-seq)
 		   (or null (member :unsorted :y-sorted :yx-sorted :yx-banded))))
   (access-gcontext (gcontext local-state)
     (multiple-value-bind (clip clip-mask)
@@ -296,7 +302,7 @@
 
 (defun gcontext-dashes (gcontext)
   (declare (type gcontext gcontext))
-  (declare (values (or null card8 sequence)))
+  (declare (clx-values (or null card8 sequence)))
   (access-gcontext (gcontext local-state)
     (multiple-value-bind (dash dashes)
 	(without-interrupts 
@@ -337,7 +343,7 @@
   ;; result in an invalid-font error.
   (declare (type gcontext gcontext)
 	   (type boolean metrics-p))
-  (declare (values (or null font)))
+  (declare (clx-values (or null font)))
   (access-gcontext (gcontext local-state)
     (let ((font (gcontext-internal-font-obj local-state)))
       (or font
@@ -477,8 +483,7 @@
   (let ((display (gcontext-display gcontext))
 	(server-state (gcontext-server-state gcontext))
 	(local-state (gcontext-local-state gcontext)))
-    (declare (type gcontext-state server-state local-state)
-	     (array-register server-state local-state))
+    (declare (type gcontext-state server-state local-state))
     ;; Update server when timestamps don't match
     (unless (= (the fixnum (gcontext-internal-timestamp local-state))
 	       (the fixnum (gcontext-internal-timestamp server-state)))
@@ -693,7 +698,7 @@
 	   (type (or null card8 sequence) dashes)
 	   (dynamic-extent options)
 	   (type boolean cache-p))
-  (declare (values gcontext))
+  (declare (clx-values gcontext))
   (let* ((display (drawable-display drawable))
 	 (gcontext (make-gcontext :display display :drawable drawable :cache-p cache-p))
 	 (local-state (gcontext-local-state gcontext))
@@ -899,9 +904,8 @@
   ;;	  (error "Can't copy unknown GContext component ~a" ',name)))
   (declare (type symbol name)
 	   (type t default)
-	   (type (function (gcontext t) t) set-function) ;; required
-	   (type (or null (function (gcontext gcontext t) t))
-		 copy-function))
+	   (type symbol set-function) ;; required
+	   (type symbol copy-function))
   (let* ((gc-name (intern (concatenate 'string
 				       (string 'gcontext-)
 				       (string name)))) ;; in current package
diff --git a/clx/generalock.lisp b/clx/generalock.lisp
index 0319ab599..cbf95a38a 100644
--- a/clx/generalock.lisp
+++ b/clx/generalock.lisp
@@ -1,5 +1,15 @@
 ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: PROCESS; Base: 10; Lowercase: Yes -*-
 
+;;; Copyright (C) 1990 Symbolics, Inc.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Symbolics, Inc. provides this software "as is" without
+;;; express or implied warranty.
+
 (defflavor xlib::clx-lock () (simple-recursive-normal-lock)
   (:init-keywords :flavor))
 
diff --git a/clx/graphics.lisp b/clx/graphics.lisp
index 1d354f44e..6e9914091 100644
--- a/clx/graphics.lisp
+++ b/clx/graphics.lisp
@@ -429,7 +429,7 @@
 	   (type array-index start)
 	   (type pixel plane-mask)
 	   (type (member :xy-pixmap :z-pixmap) format))
-  (declare (values (sequence integer) depth visual-info))
+  (declare (clx-values (clx-sequence integer) depth visual-info))
   (let ((display (drawable-display drawable)))
     (with-buffer-request-and-reply (display *x-getimage* nil :sizes (8 32))
 	 (((data (member error :xy-pixmap :z-pixmap)) format)
diff --git a/clx/image.lisp b/clx/image.lisp
index 490233844..be8099688 100644
--- a/clx/image.lisp
+++ b/clx/image.lisp
@@ -124,7 +124,7 @@
     (type boolean byte-lsb-first-p bit-lsb-first-p)
     (type (or null (member 8 16 32)) unit pad)
     (type (or null card8) left-pad))
-  (declare (values image))
+  (declare (clx-values image))
   (let ((image
 	  (etypecase data
 	    (buffer-bytes			; image-x
@@ -760,7 +760,7 @@
 	   (type (member 8 16 32) from-bitmap-unit to-bitmap-unit)
 	   (type boolean from-byte-lsb-first-p from-bit-lsb-first-p
 		 to-byte-lsb-first-p to-bit-lsb-first-p)
-	   (values function lsb-first-p))
+	   (clx-values function lsb-first-p))
   (cond ((index= bits-per-pixel 1)
 	 (let ((from-index
 		 (index+
@@ -1147,7 +1147,7 @@
 	   (type image-depth depth)
 	   (type (member 8 16 32) unit pad)
 	   (type boolean byte-lsb-first-p bit-lsb-first-p)
-	   (values image-x))
+	   (clx-values image-x))
   (assert (index<= (index* depth padded-bytes-per-plane) length))
   (let* ((bytes-per-line (index-ceiling width 8))
 	 (data-length (index* padded-bytes-per-plane depth)))
@@ -1184,7 +1184,7 @@
 	   (type (member 8 16 32) unit pad)
 	   (type boolean byte-lsb-first-p bit-lsb-first-p)
 	   (type (member 1 4 8 16 24 32) bits-per-pixel)
-	   (values image-x))
+	   (clx-values image-x))
   (assert (index<= (index* height padded-bytes-per-line) length))
   (let ((bytes-per-line (index-ceiling (index* width bits-per-pixel) 8))
 	(data-length (index* padded-bytes-per-line height)))
@@ -1214,7 +1214,7 @@
 	   (type image-depth depth)
 	   (type (member 8 16 32) unit)
 	   (type boolean byte-lsb-first-p bit-lsb-first-p)
-	   (values image-xy))
+	   (clx-values image-xy))
   (check-type data list)
   (multiple-value-bind (dimensions element-type)
       (if data
@@ -1254,7 +1254,7 @@
 	   (type (member 1 4 8 16 24 32) bits-per-pixel)
 	   (type (member 8 16 32) unit)
 	   (type boolean byte-lsb-first-p bit-lsb-first-p)
-	   (values image-z))
+	   (clx-values image-z))
   (assert (index<= (index* (index+ y height) padded-bytes-per-line) length))
   (let* ((image-bits-per-line (index* width bits-per-pixel))
 	 (image-pixels-per-line
@@ -1295,7 +1295,7 @@
 	   (type (or null pixel) plane-mask)
 	   (type (or null (member :xy-pixmap :z-pixmap)) format)
 	   (type (or null (member image-xy image-x image-z)) result-type)
-	   (values image visual-info))
+	   (clx-values image visual-info))
   (unless result-type
     (setq result-type (ecase format
 			(:xy-pixmap 'image-xy)
@@ -1610,7 +1610,7 @@
 		(write-image-load-byte 8 pixel 32))
 	  (setf (aref buffer-bbuf (index+ i 2))
 		(write-image-load-byte 16 pixel 32))
-	  (setf (aref buffer-bbuf (index+ i 2))
+	  (setf (aref buffer-bbuf (index+ i 3))
 		(write-image-load-byte 24 pixel 32)))))))
 
 (defun write-pixarray-internal
@@ -1987,7 +1987,7 @@
 		  (declare (type (or null pixmap-format) pixmap-format))
 		  (if (null pixmap-format)
 		      (error "The depth of the image ~s does not match any server pixmap format." image))
-		  (if (not (= (typecase image
+		  (if (not (= (etypecase image
 				(image-z (image-z-bits-per-pixel image))
 				(image-x (image-x-bits-per-pixel image)))
 			      (pixmap-format-bits-per-pixel pixmap-format)))
@@ -2097,7 +2097,7 @@
 (defun xy-format-image-x->image-x (image x y width height)
   (declare (type image-x image)
 	   (type card16 x y width height)
-	   (values image-x))
+	   (clx-values image-x))
   (let* ((padded-x (index+ x (image-x-left-pad image)))
 	 (left-pad (index-mod padded-x 8))
 	 (x (index- padded-x left-pad))
@@ -2142,7 +2142,7 @@
 (defun z-format-image-x->image-x (image x y width height)
   (declare (type image-x image)
 	   (type card16 x y width height)
-	   (values image-x))
+	   (clx-values image-x))
   (let* ((padded-x (index+ x (image-x-left-pad image)))
 	 (left-pad
 	   (if (index= (image-depth image) 1)
@@ -2183,7 +2183,7 @@
 (defun image-x->image-x  (image x y width height)
   (declare (type image-x image)
 	   (type card16 x y width height)
-	   (values image-x))
+	   (clx-values image-x))
   (ecase (image-x-format image)
     ((:bitmap :xy-pixmap)
       (xy-format-image-x->image-x image x y width height))
@@ -2193,7 +2193,7 @@
 (defun image-x->image-xy (image x y width height)
   (declare (type image-x image)
 	   (type card16 x y width height)
-	   (values image-xy))
+	   (clx-values image-xy))
   (unless (or (eq (image-x-format image) :bitmap)
 	      (eq (image-x-format image) :xy-pixmap)
 	      (and (eq (image-x-format image) :z-pixmap)
@@ -2211,7 +2211,7 @@
 (defun image-x->image-z  (image x y width height)
   (declare (type image-x image)
 	   (type card16 x y width height)
-	   (values image-z))
+	   (clx-values image-z))
   (unless (or (eq (image-x-format image) :z-pixmap)
 	      (eq (image-x-format image) :bitmap)
 	      (and (eq (image-x-format image) :xy-pixmap)
@@ -2268,7 +2268,7 @@
 (defun image-xy->image-x (image x y width height)
   (declare (type image-xy image)
 	   (type card16 x y width height)
-	   (values image-x))
+	   (clx-values image-x))
   (let* ((padded-bits-per-line
 	   (index* (index-ceiling width *image-pad*) *image-pad*))
 	 (padded-bytes-per-line (index-ceiling padded-bits-per-line 8))
@@ -2297,7 +2297,7 @@
 (defun image-xy->image-xy (image x y width height)
   (declare (type image-xy image)
 	   (type card16 x y width height)
-	   (values image-xy))
+	   (clx-values image-xy))
   (create-image
     :width width :height height :depth (image-depth image)
     :data (mapcar
@@ -2316,7 +2316,7 @@
 (defun image-z->image-x (image x y width height)
   (declare (type image-z image)
 	   (type card16 x y width height)
-	   (values image-x))
+	   (clx-values image-x))
   (let* ((bits-per-line (index* width (image-z-bits-per-pixel image)))
 	 (padded-bits-per-line
 	   (index* (index-ceiling bits-per-line *image-pad*) *image-pad*))
@@ -2352,7 +2352,7 @@
 (defun image-z->image-z (image x y width height)
   (declare (type image-z image)
 	   (type card16 x y width height)
-	   (values image-z))
+	   (clx-values image-z))
   (create-image
     :width width :height height :depth (image-depth image)
     :data (copy-pixarray
@@ -2366,7 +2366,7 @@
 	   (type card16 x y)
 	   (type (or null card16) width height) ;; Default from image
 	   (type (or null (member image-x image-xy image-z)) result-type))
-  (declare (values image))
+  (declare (clx-values image))
   (let* ((image-width (image-width image))
 	 (image-height (image-height image))
 	 (width (or width image-width))
@@ -2409,7 +2409,7 @@
 (defun read-bitmap-file (pathname)
   ;; Creates an image from a C include file in standard X11 format
   (declare (type (or pathname string stream) pathname))
-  (declare (values image))
+  (declare (clx-values image))
   (with-open-file (fstream pathname :direction :input)
     (let ((line "")
 	  (properties nil)
@@ -2600,7 +2600,7 @@
   ;; If the first parameter is a list, its used as the image property-list.
   (declare (type (or list bit-vector) plist)
 	   (type list patterns)) ;; list of bitvector
-  (declare (values image))
+  (declare (clx-values image))
   (unless (listp plist)
     (push plist patterns)
     (setq plist nil))
@@ -2628,7 +2628,7 @@
 	   (type (or null gcontext) gcontext)
 	   (type (or null card16) width height)
 	   (type (or null card8) depth))
-  (declare (values pixmap))
+  (declare (clx-values pixmap))
   (let* ((image-width (image-width image))
 	 (image-height (image-height image))
 	 (image-depth (image-depth image))
diff --git a/clx/input.lisp b/clx/input.lisp
index d0b72c33b..ecf33ee29 100644
--- a/clx/input.lisp
+++ b/clx/input.lisp
@@ -102,7 +102,7 @@
 (defun canonicalize-event-name (event)
   ;; Returns the event name keyword given an event name stringable
   (declare (type stringable event))
-  (declare (values event-key))
+  (declare (clx-values event-key))
   (kintern event))
 ) ;; end eval-when
 
@@ -134,7 +134,7 @@
   ;; Returns NIL when the event-code is for an extension that isn't handled.
   (declare (type display display)
 	   (type card8 code))
-  (declare (values (or null card8)))
+  (declare (clx-values (or null card8)))
   (setq code (logand #x7f code))
   (if (< code *first-extension-event-code*)
       code
@@ -153,7 +153,7 @@
   ;; Given an X11 event name, return the event-code
   (declare (type display display)
 	   (type event-key event))
-  (declare (values card8))
+  (declare (clx-values card8))
   (let ((code (get-event-code event)))
     (declare (type (or null card8) code))
     (when (>= code *first-extension-event-code*)
@@ -558,7 +558,7 @@
 (defun event-listen (display &optional (timeout 0))
   (declare (type display display)
 	   (type (or null number) timeout)
-	   (values number-of-events-queued eof-or-timeout))
+	   (clx-values number-of-events-queued eof-or-timeout))
   ;; Returns the number of events queued locally, if any, else nil.  Hangs
   ;; waiting for events, forever if timeout is nil, else for the specified
   ;; number of seconds.
@@ -689,7 +689,7 @@
 (define-event :mapping-notify 34)
 
 
-(defmacro declare-event (event-codes &body declares)
+(defmacro declare-event (event-codes &body declares &environment env)
   ;; Used to indicate the keyword arguments for handler functions in
   ;; process-event and event-case.
   ;; Generates the functions used in SEND-EVENT.
@@ -745,13 +745,16 @@
 	   (defun ,get-macro (display event-key variable)
 	     ;; Note: we take pains to macroexpand the get-code here to enable application
 	     ;; code to be compiled without having the CLX macros file loaded.
-	     (subst display '%buffer
-		    (getf `(:display (the display ,display)
-			    :event-key (the keyword ,event-key)
-			    :event-code (the card8 (logand #x7f (read-card8 0)))
-			    :send-event-p (the boolean (logbitp 7 (read-card8 0)))
-			    ,@',(mapcar #'macroexpand get-code))
-			  variable)))
+	     `(let ((%buffer ,display))
+		(declare (ignorable %buffer))
+		,(getf `(:display (the display ,display)
+			 :event-key (the keyword ,event-key)
+			 :event-code (the card8 (logand #x7f (read-card8 0)))
+			 :send-event-p (the boolean (logbitp 7 (read-card8 0)))
+			 ,@',(mapcar #'(lambda (form)
+					 (clx-macroexpand form env))
+				     get-code))
+		       variable)))
 
 	   (defun ,get-function (display event handler)
 	     (declare (type display display)
@@ -997,7 +1000,7 @@
 
 (defun event-loop-setup (display)
   (declare (type display display)
-	   (values progv-vars progv-vals
+	   (clx-values progv-vars progv-vals
 		   current-event-symbol current-event-discarded-p-symbol))
   (let* ((progv-vars (display-current-event-symbol display))
 	 (current-event-symbol (first progv-vars))
@@ -1024,7 +1027,7 @@
 	   (type (or null number) timeout)
 	   (type boolean force-output-p)
 	   (type symbol current-event-symbol)
-	   (values event eof-or-timeout))
+	   (clx-values event eof-or-timeout))
   (unless (symbol-value current-event-symbol)
     (let ((eof-or-timeout (wait-for-event display timeout force-output-p)))
       (when eof-or-timeout
@@ -1040,7 +1043,7 @@
 (defun dequeue-event (display event)
   (declare (type display display)
 	   (type reply-buffer event)
-	   (values next))
+	   (clx-values next))
   ;; Remove the current event from the event queue
   (with-event-queue-internal (display)
     (let ((next (reply-next event))
@@ -1129,7 +1132,7 @@
   ;; inside even-case, event-cond or process-event when :peek-p is T and
   ;; :discard-p is NIL.
   (declare (type display display)
-	   (values boolean))
+	   (clx-values boolean))
   (let* ((symbols (display-current-event-symbol display))
 	 (event
 	   (let ((current-event-symbol (first symbols)))
@@ -1203,14 +1206,14 @@
 (defun make-event-handlers (&key (type 'array) default)
   (declare (type t type)			;Sequence type specifier
 	   (type function default)
-	   (values sequence))			;Default handler for initial content
+	   (clx-values sequence))			;Default handler for initial content
   ;; Makes a handler sequence suitable for process-event
   (make-sequence type *max-events* :initial-element default))
    
 (defun event-handler (handlers event-key)
   (declare (type sequence handlers)
 	   (type event-key event-key)
-	   (values function))
+	   (clx-values function))
   ;; Accessor for a handler sequence
   (elt handlers (position event-key *event-key-vector* :test #'eq)))
 
@@ -1218,7 +1221,7 @@
   (declare (type sequence handlers)
 	   (type event-key event-key)
 	   (type function handler)
-	   (values handler))
+	   (clx-values handler))
   (setf (elt handlers (position event-key *event-key-vector* :test #'eq)) handler))
 
 (defsetf event-handler set-event-handler)
@@ -1313,7 +1316,7 @@
 (defun get-event-code (event)
   ;; Returns the event code given an event-key
   (declare (type event-key event))
-  (declare (values card8))
+  (declare (clx-values card8))
   (or (get event 'event-code)
       (x-type-error event 'event-key)))
 
@@ -1391,7 +1394,7 @@
     ;;  (component-key ((event-key event-key ...) . extraction-code)
     ;;		       ((event-key event-key ...) . extraction-code) ...)
     ;; There should probably be accessor macros for this, instead of things like cdadr.
-    (let ((vars (mapcar #'(lambda (var) (list var)) value-list))
+    (let ((vars (mapcar #'list value-list))
 	  (multiple-p nil))
       ;; Fill in the VARS alist with event-keys and extraction-code
       (do ((keys event-keys (cdr keys))
@@ -1527,7 +1530,7 @@
       (when (= code (second extension))
 	(return (first extension))))))
 
-#-(or clx-ansi-common-lisp excl lcl3.0)
+#-(or clx-ansi-common-lisp excl lcl3.0 CMU)
 (define-condition request-error (x-error)
   ((display :reader request-error-display)
    (error-key :reader request-error-error-key)
@@ -1552,7 +1555,7 @@
 
 ;; Since the :report arg is evaluated as (function report-request-error) the
 ;; define-condition must come after the function definition.
-#+(or clx-ansi-common-lisp excl lcl3.0)
+#+(or clx-ansi-common-lisp excl lcl3.0 CMU)
 (define-condition request-error (x-error)
   ((display :reader request-error-display :initarg :display)
    (error-key :reader request-error-error-key :initarg :error-key)
@@ -1823,7 +1826,7 @@
   (declare (type display display)
 	   (type reply-buffer event)
 	   (type (or null keyword) arg))
-  (declare (values keyword/arg-plist))
+  (declare (clx-values keyword/arg-plist))
   display
   (reading-event (event)
     (let* ((sequence (read-card16 2))
diff --git a/clx/macros.lisp b/clx/macros.lisp
index 6b60265f5..faf64da7b 100644
--- a/clx/macros.lisp
+++ b/clx/macros.lisp
@@ -217,8 +217,9 @@
   ((index &rest keywords)
    (let ((value (gensym)))
      `(let ((,value (read-card8 ,index)))
-	(and (< ,value ,(length keywords))
-	     (svref ',(apply #'vector keywords) ,value)))))
+	(declare (type (integer 0 (,(length keywords))) ,value))
+	(type-check ,value (integer 0 (,(length keywords))))
+	(svref ',(apply #'vector keywords) ,value))))
   ((index thing &rest keywords)
    `(write-card8 ,index (position ,thing
 				  #+lispm ',keywords ;; Lispm's prefer lists
@@ -236,8 +237,9 @@
   ((index &rest keywords)
    (let ((value (gensym)))
      `(let ((,value (read-card16 ,index)))
-	(and (< ,value ,(length keywords))
-	     (svref ',(apply #'vector keywords) ,value)))))
+	(declare (type (integer 0 (,(length keywords))) ,value))
+	(type-check ,value (integer 0 (,(length keywords))))
+	(svref ',(apply #'vector keywords) ,value))))
   ((index thing &rest keywords)
    `(write-card16 ,index (position ,thing
 				   #+lispm ',keywords ;; Lispm's prefer lists
@@ -255,8 +257,9 @@
   ((index &rest keywords)
    (let ((value (gensym)))
      `(let ((,value (read-card29 ,index)))
-	(and (< ,value ,(length keywords))
-	     (svref ',(apply #'vector keywords) ,value)))))
+	(declare (type (integer 0 (,(length keywords))) ,value))
+	(type-check ,value (integer 0 (,(length keywords))))
+	(svref ',(apply #'vector keywords) ,value))))
   ((index thing &rest keywords)
    `(write-card29 ,index (position ,thing
 				   #+lispm ',keywords ;; Lispm's prefer lists
@@ -266,11 +269,11 @@
    (if (cdr keywords) ;; IF more than one
        (let ((value (gensym)))
 	 `(let ((,value (position ,thing
-				   #+lispm ',keywords
-				   #-lispm (the simple-vector ',(apply #'vector keywords))
+				  #+lispm ',keywords
+				  #-lispm (the simple-vector ',(apply #'vector keywords))
 				  :test #'eq)))
 	    (and ,value (write-card29 ,index ,value))))
-     `(and (eq ,thing ,(car keywords)) (write-card29 ,index 0)))))
+       `(and (eq ,thing ,(car keywords)) (write-card29 ,index 0)))))
 
 (deftype member-vector (vector) `(member ,@(coerce (symbol-value vector) 'list)))
 
@@ -303,8 +306,9 @@
   ((index)
    (let ((value (gensym)))
      `(let ((,value (read-card29 ,index)))
-	(and (< ,value ,(length *boole-vector*))
-	     (svref *boole-vector* ,value)))))
+	(declare (type (integer 0 (,(length *boole-vector*))) ,value))
+	(type-check ,value (integer 0 (,(length *boole-vector*))))
+	(svref *boole-vector* ,value))))
   ((index thing)
    `(write-card29 ,index (position ,thing (the simple-vector *boole-vector*))))
   ((index thing)
@@ -390,16 +394,17 @@
   '(let* ((format (read-card8 1))
  	  (sequence (make-array (ceiling 160 format)
 				:element-type `(unsigned-byte ,format))))
+     (declare (type (member 8 16 32) format))
      (do ((i 12)
-	  (j 0 (1+ j)))
+	  (j 0 (index1+ j)))
 	 ((>= i 32))
        (case format
 	 (8 (setf (aref sequence j) (read-card8 i))
-	    (incf i))
+	    (index-incf i))
 	 (16 (setf (aref sequence j) (read-card16 i))
-	     (incf i 2))
+	     (index-incf i 2))
 	 (32 (setf (aref sequence j) (read-card32 i))
-	     (incf i 4))))
+	     (index-incf i 4))))
      sequence))
 
 (defmacro client-message-event-put-sequence (format sequence)
@@ -470,7 +475,7 @@
 (defmacro or-expand (&rest forms &environment environment)
   `(cond ,@(mapcar #'(lambda (forms)
 		       (mapcar #'(lambda (form)
-				   (macroexpand form environment))
+				   (clx-macroexpand form environment))
 			       forms))
 		   forms)))
 
@@ -487,7 +492,7 @@
 	`(let ((,value (read-card32 ,index)))
 	   (macrolet ((read-card32 (index) index ',value)
 		      (read-card29 (index) index ',value))
-	     ,(macroexpand `(or-expand ,@(nreverse result)) environment))))
+	     ,(clx-macroexpand `(or-expand ,@(nreverse result)) environment))))
      (let ((item (car types))
 	   (args nil))
        (when (consp item)
diff --git a/clx/manager.lisp b/clx/manager.lisp
index a8e99e748..5366cd18e 100644
--- a/clx/manager.lisp
+++ b/clx/manager.lisp
@@ -22,7 +22,7 @@
 
 (defun wm-name (window)
   (declare (type window window))
-  (declare (values string))
+  (declare (clx-values string))
   (get-property window :WM_NAME :type :STRING :result-type 'string :transform #'card8->char))
 
 (defsetf wm-name (window) (name)
@@ -37,7 +37,7 @@
 
 (defun wm-icon-name (window)
   (declare (type window window))
-  (declare (values string))
+  (declare (clx-values string))
   (get-property window :WM_ICON_NAME :type :STRING
 		:result-type 'string :transform #'card8->char))
 
@@ -46,7 +46,7 @@
 
 (defun wm-client-machine (window)
   (declare (type window window))
-  (declare (values string))
+  (declare (clx-values string))
   (get-property window :WM_CLIENT_MACHINE :type :STRING
 		:result-type 'string :transform #'card8->char))
 
@@ -55,42 +55,45 @@
 
 (defun get-wm-class (window)
   (declare (type window window))
-  (declare (values (or null name-string) (or null class-string)))
-  (let ((value (get-property window :WM_CLASS :type :STRING
-			     :result-type 'string :transform #'card8->char)))
-    (declare (type (or null string) value))
+  (declare (clx-values (or null name-string) (or null class-string)))
+  (let ((value (get-property window :WM_CLASS :type :STRING :result-type '(vector card8))))
+    (declare (type (or null (vector card8)) value))
     (when value
-      (let* ((name-len (position #.(card8->char 0) (the string value)))
-	     (name (subseq (the string value) 0 name-len))
-	     (class (subseq (the string value) (1+ name-len) (1- (length value)))))
-	(values (and (plusp (length name)) name)
-		(and (plusp (length class)) class))))))
+      (let* ((name-len (position 0 (the (vector card8) value)))
+	     (name (subseq (the (vector card8) value) 0 name-len))
+	     (class (subseq (the (vector card8) value) (1+ name-len) (1- (length value)))))
+	(values (and (plusp (length name)) (map 'string #'card8->char name))
+		(and (plusp (length class)) (map 'string #'card8->char class)))))))
 
 (defun set-wm-class (window resource-name resource-class)
   (declare (type window window)
 	   (type (or null stringable) resource-name resource-class))
-  (set-string-property window :WM_CLASS
-		       (concatenate 'string
-				    (string (or resource-name ""))
-				    #.(make-string 1 :initial-element (card8->char 0))
-				    (string (or resource-class ""))
-				    #.(make-string 1 :initial-element (card8->char 0))))
+  (change-property window :WM_CLASS
+		   (concatenate '(vector card8)
+				(map '(vector card8) #'char->card8
+				     (string (or resource-name "")))
+				#(0)
+				(map '(vector card8) #'char->card8
+				     (string (or resource-class "")))
+				#(0))
+		   :string 8)
   (values))
 
 (defun wm-command (window)
   ;; Returns a list whose car is the command and 
   ;; whose cdr is the list of arguments
   (declare (type window window))
-  (declare (values list))
+  (declare (clx-values list))
   (do* ((command-string (get-property window :WM_COMMAND :type :STRING
-				      :result-type 'string :transform #'card8->char))
+				      :result-type '(vector card8)))
 	(command nil)
 	(start 0 (1+ end))
 	(end 0)
 	(len (length command-string)))
        ((>= start len) (nreverse command))
-    (setq end (position #.(card8->char 0) command-string :start start))
-    (push (subseq command-string start end) command)))
+    (setq end (position 0 command-string :start start))
+    (push (map 'string #'card8->char (subseq command-string start end))
+	  command)))
 
 (defsetf wm-command set-wm-command)
 (defun set-wm-command (window command)
@@ -101,13 +104,16 @@
   ;; to recover a lisp command.
   (declare (type window window)
 	   (type list command))
-  (set-string-property
-    window :WM_COMMAND
-    (with-output-to-string (stream)
-      (with-standard-io-syntax 
-	(dolist (c command)
-	  (prin1 c stream)
-	  (write-char #.(card8->char 0) stream)))))
+  (change-property window :WM_COMMAND
+		   (apply #'concatenate '(vector card8)
+			  (mapcan #'(lambda (c)
+				      (list (map '(vector card8) #'char->card8
+						 (with-output-to-string (stream)
+						   (with-standard-io-syntax 
+						     (prin1 c stream))))
+					    #(0)))
+				  command))
+		   :string 8)
   command)
 
 ;;-----------------------------------------------------------------------------
@@ -128,7 +134,7 @@
 
 (defun wm-hints (window)
   (declare (type window window))
-  (declare (values wm-hints))
+  (declare (clx-values wm-hints))
   (let ((prop (get-property window :WM_HINTS :type :WM_HINTS :result-type 'vector)))
     (when prop
       (decode-wm-hints prop (window-display window)))))
@@ -137,14 +143,14 @@
 (defun set-wm-hints (window wm-hints)
   (declare (type window window)
 	   (type wm-hints wm-hints))
-  (declare (values wm-hints))
+  (declare (clx-values wm-hints))
   (change-property window :WM_HINTS (encode-wm-hints wm-hints) :WM_HINTS 32)
   wm-hints)
 
 (defun decode-wm-hints (vector display)
   (declare (type (simple-vector 9) vector)
 	   (type display display))
-  (declare (values wm-hints))
+  (declare (clx-values wm-hints))
   (let ((input-hint 0)
 	(state-hint 1)
 	(icon-pixmap-hint 2)
@@ -181,7 +187,7 @@
 
 (defun encode-wm-hints (wm-hints)
   (declare (type wm-hints wm-hints))
-  (declare (values simple-vector))
+  (declare (clx-values simple-vector))
   (let ((input-hint         #b1)
 	(state-hint         #b10)
 	(icon-pixmap-hint   #b100)
@@ -249,21 +255,21 @@
 
 (defun wm-normal-hints (window)
   (declare (type window window))
-  (declare (values wm-size-hints))
+  (declare (clx-values wm-size-hints))
   (decode-wm-size-hints (get-property window :WM_NORMAL_HINTS :type :WM_SIZE_HINTS :result-type 'vector)))
 
 (defsetf wm-normal-hints set-wm-normal-hints)
 (defun set-wm-normal-hints (window hints)
   (declare (type window window)
 	   (type wm-size-hints hints))
-  (declare (values wm-size-hints))
+  (declare (clx-values wm-size-hints))
   (change-property window :WM_NORMAL_HINTS (encode-wm-size-hints hints) :WM_SIZE_HINTS 32)
   hints)
 
 ;;; OBSOLETE
 (defun wm-zoom-hints (window)
   (declare (type window window))
-  (declare (values wm-size-hints))
+  (declare (clx-values wm-size-hints))
   (decode-wm-size-hints (get-property window :WM_ZOOM_HINTS :type :WM_SIZE_HINTS :result-type 'vector)))
 
 ;;; OBSOLETE
@@ -272,13 +278,13 @@
 (defun set-wm-zoom-hints (window hints)
   (declare (type window window)
 	   (type wm-size-hints hints))
-  (declare (values wm-size-hints))
+  (declare (clx-values wm-size-hints))
   (change-property window :WM_ZOOM_HINTS (encode-wm-size-hints hints) :WM_SIZE_HINTS 32)
   hints)
 
 (defun decode-wm-size-hints (vector)
   (declare (type (or null (simple-vector *)) vector))
-  (declare (values (or null wm-size-hints)))
+  (declare (clx-values (or null wm-size-hints)))
   (when vector
     (let ((flags (aref vector 0))
 	  (hints (make-wm-size-hints)))
@@ -320,7 +326,7 @@
 
 (defun encode-wm-size-hints (hints)
   (declare (type wm-size-hints hints))
-  (declare (values simple-vector))
+  (declare (clx-values simple-vector))
   (let ((vector (make-array 18 :initial-element 0))
 	(flags 0))
     (declare (type (simple-vector 18) vector)
@@ -386,7 +392,7 @@
 
 (defun icon-sizes (window)
   (declare (type window window))
-  (declare (values wm-size-hints))
+  (declare (clx-values wm-size-hints))
   (let ((vector (get-property window :WM_ICON_SIZE :type :WM_ICON_SIZE :result-type 'vector)))
     (declare (type (or null (simple-vector 6)) vector))
     (when vector
@@ -519,7 +525,7 @@
 	(when icon-x (setf (wm-hints-icon-x wm-hints) icon-x))
 	(when icon-y (setf (wm-hints-icon-y wm-hints) icon-y))
 	(when icon-mask (setf (wm-hints-icon-mask wm-hints) icon-mask))
-	(when window-group (setf (wm-hints-input wm-hints) window-group))
+	(when window-group (setf (wm-hints-window-group wm-hints) window-group))
 	(setf (wm-hints window) wm-hints))
       (when hints (setf (wm-hints window) hints)))
   ;; WM-NORMAL-HINTS
@@ -666,7 +672,7 @@
   (declare (type window window)
 	   (type (member :RGB_DEFAULT_MAP :RGB_BEST_MAP :RGB_RED_MAP
 			 :RGB_GREEN_MAP :RGB_BLUE_MAP) property))
-  (declare (values colormap base-pixel max-color mult-color))
+  (declare (clx-values colormap base-pixel max-color mult-color))
   (let ((prop (get-property window property :type :RGB_COLOR_MAP :result-type 'vector)))
     (declare (type (or null simple-vector) prop))
     (when prop
@@ -687,14 +693,14 @@
 	   (type colormap colormap)
 	   (type pixel base-pixel)
 	   (type color max-color mult-color))
-  (let ((prop (apply #'vector (encode-type colormap colormap)
-		     (encode-type rgb-val (color-red max-color))
-		     (encode-type rgb-val (color-red mult-color))
-		     (encode-type rgb-val (color-green max-color))
-		     (encode-type rgb-val (color-green mult-color))
-		     (encode-type rgb-val (color-blue max-color))
-		     (encode-type rgb-val (color-blue mult-color))
-		     base-pixel)))
+  (let ((prop (vector (encode-type colormap colormap)
+		      (encode-type rgb-val (color-red max-color))
+		      (encode-type rgb-val (color-red mult-color))
+		      (encode-type rgb-val (color-green max-color))
+		      (encode-type rgb-val (color-green mult-color))
+		      (encode-type rgb-val (color-blue max-color))
+		      (encode-type rgb-val (color-blue mult-color))
+		      base-pixel)))
     (change-property window property prop :RGB_COLOR_MAP 32)))
 
 ;;-----------------------------------------------------------------------------
@@ -710,7 +716,7 @@
 	   (type (or null array-index) end)
 	   (type t result-type)			;a sequence type
 	   (type (or null (function (integer) t)) transform))
-  (declare (values sequence type format bytes-after))
+  (declare (clx-values sequence type format bytes-after))
   (let* ((root (screen-root (first (display-roots display))))
 	 (property (aref '#(:CUT_BUFFER0 :CUT_BUFFER1 :CUT_BUFFER2 :CUT_BUFFER3
 			    :CUT_BUFFER4 :CUT_BUFFER5 :CUT_BUFFER6 :CUT_BUFFER7)
diff --git a/clx/package.lisp b/clx/package.lisp
index aae50abc7..cdfd8b166 100644
--- a/clx/package.lisp
+++ b/clx/package.lisp
@@ -22,6 +22,9 @@
     rational
     ))
 
+#+(and CMU (not clx-ansi-common-lisp))
+(shadow '(define-condition))
+
 #+(and lispm (not clx-ansi-common-lisp))
 (import
   '(
@@ -35,7 +38,6 @@
   '(
     future-common-lisp:print-unreadable-object
     future-common-lisp:with-standard-io-syntax
-    sys:array-register
     zwei:indentation
     ))
 
@@ -232,7 +234,6 @@
   #+allegro (:use cltl1)
   #+allegro (:import-from excl without-interrupts)
   #+excl (:import-from excl arglist)
-  #+Genera (:import-from sys array-register)
   #+Genera (:import-from zwei indentation)
   #+lcl3.0 (:import-from lcl arglist)
   #+lispm (:import-from lisp char-bit)
diff --git a/clx/requests.lisp b/clx/requests.lisp
index 5b9557998..d91ea8f0b 100644
--- a/clx/requests.lisp
+++ b/clx/requests.lisp
@@ -53,7 +53,7 @@
 	   (type (or null (member :on :off)) save-under override-redirect)
 	   (type (or null (member :copy) colormap) colormap)
 	   (type (or null (member :none) cursor) cursor))
-  (declare (values window))
+  (declare (clx-values window))
   (let* ((display (window-display parent))
 	 (window (or window (make-window :display display)))
 	 (wid (allocate-resource-id display window 'window))
@@ -179,7 +179,7 @@
 (defun query-tree (window &key (result-type 'list))
   (declare (type window window)
 	   (type t result-type)) ;;type specifier
-  (declare (values (sequence window) parent root))
+  (declare (clx-values (clx-sequence window) parent root))
   (let ((display (window-display window)))
     (multiple-value-bind (root parent sequence)
 	(with-buffer-request-and-reply (display *x-querytree* nil :sizes (8 16 32))
@@ -201,7 +201,7 @@
 (defun intern-atom (display name)
   (declare (type display display)
 	   (type xatom name))
-  (declare (values resource-id))
+  (declare (clx-values resource-id))
   (let ((name (if (or (null name) (keywordp name))
 		  name
 		(kintern (string name)))))
@@ -225,7 +225,7 @@
   ;; Same as INTERN-ATOM, but with the ONLY-IF-EXISTS flag True
   (declare (type display display)
 	   (type xatom name))
-  (declare (values (or null resource-id)))
+  (declare (clx-values (or null resource-id)))
   (let ((name (if (or (null name) (keywordp name))
 		  name
 		(kintern (string name)))))
@@ -249,7 +249,7 @@
 (defun atom-name (display atom-id)
   (declare (type display display)
 	   (type resource-id atom-id))
-  (declare (values keyword))
+  (declare (clx-values keyword))
   (if (zerop atom-id)
       nil
   (or (id-atom atom-id display)
@@ -281,7 +281,7 @@
 	   (type (member :replace :prepend :append) mode)
 	   (type array-index start)
 	   (type (or null array-index) end)
-	   (type t transform))			;(or null (function (t) integer))
+	   (type (or null (function (t) integer)) transform))
   (unless end (setq end (length data)))
   (let* ((display (window-display window))
 	 (length (index- end start))
@@ -326,8 +326,8 @@
 	   (type (or null array-index) end)
 	   (type boolean delete-p)
 	   (type t result-type)			;a sequence type
-	   (type t transform))			;(or null (function (integer) t))
-  (declare (values data (or null type) format bytes-after))
+	   (type (or null (function (integer) t)) transform))
+  (declare (clx-values data (or null type) format bytes-after))
   (let* ((display (window-display window))
 	 (property-id (intern-atom display property))
 	 (type-id (and type (intern-atom display type))))
@@ -392,7 +392,7 @@
 (defun list-properties (window &key (result-type 'list))
   (declare (type window window)
 	   (type t result-type)) ;; a sequence type
-  (declare (values (sequence keyword)))
+  (declare (clx-values (clx-sequence keyword)))
   (let ((display (window-display window)))
     (multiple-value-bind (seq)
 	(with-buffer-request-and-reply (display *x-listproperties* nil :sizes 16)
@@ -411,7 +411,7 @@
 (defun selection-owner (display selection)
   (declare (type display display)
 	   (type xatom selection))
-  (declare (values (or null window)))
+  (declare (clx-values (or null window)))
   (let ((selection-id (intern-atom display selection)))
     (declare (type resource-id selection-id))
     (multiple-value-bind (window)
@@ -501,7 +501,7 @@
 	   (type (or null window) confine-to)
 	   (type (or null cursor) cursor)
 	   (type timestamp time))
-  (declare (values grab-status))
+  (declare (clx-values grab-status))
   (let ((display (window-display window)))
     (with-buffer-request-and-reply (display *x-grabpointer* nil :sizes 8)
 	 (((data boolean) owner-p)
@@ -563,7 +563,7 @@
   (declare (type window window)
 	   (type boolean owner-p sync-pointer-p sync-keyboard-p)
 	   (type timestamp time))
-  (declare (values grab-status))
+  (declare (clx-values grab-status))
   (let ((display (window-display window)))
     (with-buffer-request-and-reply (display *x-grabkeyboard* nil :sizes 8)
 	 (((data boolean) owner-p)
@@ -634,7 +634,7 @@
 
 (defun query-pointer (window)
   (declare (type window window))
-  (declare (values x y same-screen-p child mask root-x root-y root))
+  (declare (clx-values x y same-screen-p child mask root-x root-y root))
   (let ((display (window-display window)))
     (with-buffer-request-and-reply (display *x-querypointer* 26 :sizes (8 16 32))
 	 ((window window))
@@ -650,7 +650,7 @@
 
 (defun pointer-position (window)
   (declare (type window window))
-  (declare (values x y same-screen-p))
+  (declare (clx-values x y same-screen-p))
   (let ((display (window-display window)))
     (with-buffer-request-and-reply (display *x-querypointer* 24 :sizes (8 16))
 	 ((window window))
@@ -661,7 +661,7 @@
 
 (defun global-pointer-position (display)
   (declare (type display display))
-  (declare (values root-x root-y root))
+  (declare (clx-values root-x root-y root))
   (with-buffer-request-and-reply (display *x-querypointer* 20 :sizes (16 32))
        ((window (screen-root (first (display-roots display)))))
     (values
@@ -673,7 +673,7 @@
   (declare (type window window)
 	   (type timestamp start stop)
 	   (type t result-type)) ;; a type specifier
-  (declare (values (repeat-seq (integer x) (integer y) (timestamp time))))
+  (declare (clx-values (repeat-seq (integer x) (integer y) (timestamp time))))
   (let ((display (window-display window)))
     (with-buffer-request-and-reply (display *x-getmotionevents* nil :sizes 32)
 	 ((window window)
@@ -687,7 +687,7 @@
   (declare (type window src)
 	   (type int16 src-x src-y)
 	   (type window dst))
-  (declare (values dst-x dst-y child))
+  (declare (clx-values dst-x dst-y child))
   (let ((display (window-display src)))
     (with-buffer-request-and-reply (display *x-translatecoords* 16 :sizes (8 16 32))
 	 ((window src dst)
@@ -759,7 +759,7 @@
 
 (defun input-focus (display)
   (declare (type display display))
-  (declare (values focus revert-to))
+  (declare (clx-values focus revert-to))
   (with-buffer-request-and-reply (display *x-getinputfocus* 16 :sizes (8 32))
        ()
     (values
@@ -769,7 +769,7 @@
 (defun query-keymap (display &optional bit-vector)
   (declare (type display display)
 	   (type (or null (bit-vector 256)) bit-vector))
-  (declare (values (bit-vector 256)))
+  (declare (clx-values (bit-vector 256)))
   (with-buffer-request-and-reply (display *x-querykeymap* 40 :sizes 8)
        ()
     (values
@@ -785,7 +785,7 @@
 	   (type card8 depth) ;; required
 	   (type card16 width height) ;; required
 	   (type drawable drawable)) ;; required
-  (declare (values pixmap))
+  (declare (clx-values pixmap))
   (let* ((display (drawable-display drawable))
 	 (pixmap (or pixmap (make-pixmap :display display)))
 	 (pid (allocate-resource-id display pixmap 'pixmap)))
@@ -846,7 +846,7 @@
   (declare (type (or visual-info resource-id) visual-info)
 	   (type window window)
 	   (type boolean alloc-p))
-  (declare (values colormap))
+  (declare (clx-values colormap))
   (let ((display (window-display window)))
     (when (typep visual-info 'resource-id)
       (setf visual-info (visual-info display visual-info)))
@@ -869,7 +869,7 @@
 
 (defun copy-colormap-and-free (colormap)
   (declare (type colormap colormap))
-  (declare (values colormap))
+  (declare (clx-values colormap))
   (let* ((display (colormap-display colormap))
 	 (new-colormap (make-colormap :display display
 				      :visual-info (colormap-visual-info colormap)))
@@ -893,7 +893,7 @@
 (defun installed-colormaps (window &key (result-type 'list))
   (declare (type window window)
 	   (type t result-type)) ;; CL type
-  (declare (values (sequence colormap)))
+  (declare (clx-values (clx-sequence colormap)))
   (let ((display (window-display window)))
     (flet ((get-colormap (id)
 	     (lookup-colormap display id)))
@@ -906,7 +906,7 @@
 (defun alloc-color (colormap color)
   (declare (type colormap colormap)
 	   (type (or stringable color) color))
-  (declare (values pixel screen-color exact-color))
+  (declare (clx-values pixel screen-color exact-color))
   (let ((display (colormap-display colormap)))
     (etypecase color
       (color
@@ -944,7 +944,7 @@
 	   (type card16 colors planes)
 	   (type boolean contiguous-p)
 	   (type t result-type)) ;; CL type
-  (declare (values (sequence pixel) (sequence mask)))
+  (declare (clx-values (clx-sequence pixel) (clx-sequence mask)))
   (let ((display (colormap-display colormap)))
     (with-buffer-request-and-reply (display *x-alloccolorcells* nil :sizes 16)
 	 (((data boolean) contiguous-p)
@@ -964,7 +964,7 @@
 	   (type card16 colors reds greens blues)
 	   (type boolean contiguous-p)
 	   (type t result-type)) ;; CL type
-  (declare (values (sequence pixel) red-mask green-mask blue-mask))
+  (declare (clx-values (clx-sequence pixel) red-mask green-mask blue-mask))
   (let ((display (colormap-display colormap)))
     (with-buffer-request-and-reply (display *x-alloccolorplanes* nil :sizes (16 32))
 	 (((data boolean) contiguous-p)
@@ -1041,7 +1041,7 @@
   (declare (type colormap colormap)
 	   (type sequence pixels) ;; sequence of integer
 	   (type t result-type))   ;; a type specifier
-  (declare (values (sequence color)))
+  (declare (clx-values (clx-sequence color)))
   (let ((display (colormap-display colormap)))
     (with-buffer-request-and-reply (display *x-querycolors* nil :sizes (8 16))
 	 ((colormap colormap)
@@ -1058,7 +1058,7 @@
 (defun lookup-color (colormap name)
   (declare (type colormap colormap)
 	   (type stringable name))
-  (declare (values screen-color true-color))
+  (declare (clx-values screen-color true-color))
   (let* ((display (colormap-display colormap))
 	 (string (string name))
 	 (length (length string)))
@@ -1086,7 +1086,7 @@
 	   (type (or null pixmap) mask)
 	   (type card16 x y) ;; required
 	   (type (or null color) foreground background)) ;; required
-  (declare (values cursor))
+  (declare (clx-values cursor))
   (let* ((display (pixmap-display source))
 	 (cursor (make-cursor :display display))
 	 (cid (allocate-resource-id display cursor 'cursor)))
@@ -1116,7 +1116,7 @@
 	   (type (or null font) mask-font)
 	   (type (or null card16) mask-char)
 	   (type color foreground background)) ;; required
-  (declare (values cursor))
+  (declare (clx-values cursor))
   (let* ((display (font-display source-font))
 	 (cursor (make-cursor :display display))
 	 (cid (allocate-resource-id display cursor 'cursor))
@@ -1159,7 +1159,7 @@
 (defun query-best-cursor (width height drawable)
   (declare (type card16 width height)
 	   (type (or drawable display) drawable))	
-  (declare (values width height))
+  (declare (clx-values width height))
   ;; Drawable can be a display for compatibility.
   (multiple-value-bind (display drawable)
       (if (type? drawable 'drawable)
@@ -1176,7 +1176,7 @@
 (defun query-best-tile (width height drawable)
   (declare (type card16 width height)
 	   (type drawable drawable))
-  (declare (values width height))
+  (declare (clx-values width height))
   (let ((display (drawable-display drawable)))
     (with-buffer-request-and-reply (display *x-querybestsize* 12 :sizes 16)
 	 ((data 1)
@@ -1189,7 +1189,7 @@
 (defun query-best-stipple (width height drawable)
   (declare (type card16 width height)
 	   (type drawable drawable))
-  (declare (values width height))
+  (declare (clx-values width height))
   (let ((display (drawable-display drawable)))
     (with-buffer-request-and-reply (display *x-querybestsize* 12 :sizes 16)
 	 ((data 2)
@@ -1202,7 +1202,7 @@
 (defun query-extension (display name)
   (declare (type display display)
 	   (type stringable name))
-  (declare (values major-opcode first-event first-error))
+  (declare (clx-values major-opcode first-event first-error))
   (let ((string (string name)))
     (with-buffer-request-and-reply (display *x-queryextension* 12 :sizes 8)
 	 ((card16 (length string))
@@ -1217,7 +1217,7 @@
 (defun list-extensions (display &key (result-type 'list))
   (declare (type display display)
 	   (type t result-type)) ;; CL type
-  (declare (values (sequence string)))
+  (declare (clx-values (clx-sequence string)))
   (with-buffer-request-and-reply (display *x-listextensions* size :sizes 8)
        ()
     (values
@@ -1247,7 +1247,7 @@
 
 (defun keyboard-control (display)
   (declare (type display display))
-  (declare (values key-click-percent bell-percent bell-pitch bell-duration
+  (declare (clx-values key-click-percent bell-percent bell-pitch bell-duration
 		  led-mask global-auto-repeat auto-repeats))
   (with-buffer-request-and-reply (display *x-getkeyboardcontrol* 32 :sizes (8 16 32))
        ()
@@ -1279,7 +1279,7 @@
 (defun pointer-mapping (display &key (result-type 'list))
   (declare (type display display)
 	   (type t result-type)) ;; CL type
-  (declare (values sequence)) ;; Sequence of card
+  (declare (clx-values sequence)) ;; Sequence of card
   (with-buffer-request-and-reply (display *x-getpointermapping* nil :sizes 8)
        ()
     (values
@@ -1304,13 +1304,11 @@
   ;; Acceleration is rationalized if necessary.
   (declare (type display display)
 	   (type (or null (member :default) number) acceleration)
-	   (type (or null (member :default) integer) threshold)
-	   (inline rationalize16))
+	   (type (or null (member :default) integer) threshold))
   (flet ((rationalize16 (number)
 	   ;; Rationalize NUMBER into the ratio of two signed 16 bit numbers
-	   (declare (type number number)
-		    (inline rationalize16))
-	   (declare (values numerator denominator))
+	   (declare (type number number))
+	   (declare (clx-values numerator denominator))
 	   (do* ((rational (rationalize number))
 		 (numerator (numerator rational) (ash numerator -1))
 		 (denominator (denominator rational) (ash denominator -1)))
@@ -1319,7 +1317,7 @@
 			  (< denominator #x8000)))
 		 (values
 		   numerator (min denominator #x7fff))))))
-
+    (declare (inline rationalize16))
     (let ((acceleration-p 1)
 	  (threshold-p 1)
 	  (numerator 0)
@@ -1339,12 +1337,12 @@
 
 (defun pointer-control (display)
   (declare (type display display))
-  (declare (values acceleration threshold))
+  (declare (clx-values acceleration threshold))
   (with-buffer-request-and-reply (display *x-getpointercontrol* 16 :sizes 16)
        ()
     (values
-      (/ (card16-get 8) (card16-get 10)		; Should we float this?
-	 (card16-get 12)))))
+      (/ (card16-get 8) (card16-get 10))	; Should we float this?
+      (card16-get 12))))
 
 (defun set-screen-saver (display timeout interval blanking exposures)
   ;; Timeout and interval are in seconds, will be rounded to minutes.
@@ -1362,7 +1360,7 @@
 (defun screen-saver (display)
   ;; Returns timeout and interval in seconds.
   (declare (type display display))
-  (declare (values timeout interval blanking exposures))
+  (declare (clx-values timeout interval blanking exposures))
   (with-buffer-request-and-reply (display *x-getscreensaver* 14 :sizes (8 16))
        ()
     (values
@@ -1422,7 +1420,7 @@
   ;; (:internet :DECnet :Chaos) and cdr is a list of network address bytes.
   (declare (type display display)
 	   (type t result-type)) ;; CL type
-  (declare (values (sequence host) enabled-p))
+  (declare (clx-values (clx-sequence host) enabled-p))
   (with-buffer-request-and-reply (display *x-listhosts* nil :sizes (8 16))
        ()
     (let* ((enabled-p (boolean-get 1))
@@ -1445,7 +1443,7 @@
 
 (defun access-control (display)
   (declare (type display display))
-  (declare (values boolean)) ;; True when access-control is ENABLED
+  (declare (clx-values boolean)) ;; True when access-control is ENABLED
   (with-buffer-request-and-reply (display *x-listhosts* 2 :sizes 8)
        ()
     (boolean-get 1)))
@@ -1463,7 +1461,7 @@
   ;; setf'able
   ;; Cached locally in display object.
   (declare (type display display))
-  (declare (values (member :destroy :retain-permanent :retain-temporary nil)))
+  (declare (clx-values (member :destroy :retain-permanent :retain-temporary nil)))
   (display-close-down-mode display))
 
 (defun set-close-down-mode (display mode)
diff --git a/clx/resource.lisp b/clx/resource.lisp
index 9cc052ece..3e7b74aab 100644
--- a/clx/resource.lisp
+++ b/clx/resource.lisp
@@ -116,7 +116,7 @@
   ;; Compare two stringables.
   ;; Ignore case when comparing to a symbol.
   (declare (type stringable a b))
-  (declare (values boolean))
+  (declare (clx-values boolean))
   (etypecase a
     (string
       (etypecase b
@@ -150,7 +150,7 @@
   ;; case-sensitive comparisons will be used.  The symbol '* or
   ;; string "*" are used as wildcards, matching anything or nothing.
   (declare (type resource-database database)
-	   (type list name-list) ;; (list stringable)
+	   (type (clx-list stringable) name-list)
 	   (type t value))
   (unless value (error "Null resource values are ignored"))
   (incf-resource-database-timestamp database)
@@ -190,7 +190,7 @@
 
 (defun delete-resource-internal (database name-list)
   (declare (type resource-database database)
-	   (type list name-list)) ;; (list stringable)
+	   (type (clx-list stringable) name-list))
   (do* ((list name-list (cdr list))
 	(string (car list) (car list))
 	(node database)
@@ -232,8 +232,8 @@
   ;;                      (append full-class (list value-class)).
   (declare (type resource-database database)
 	   (type stringable value-name value-class)
-	   (type list full-name full-class)) ;; (list stringable)
-  (declare (values value))
+	   (type (clx-list stringable) full-name full-class))
+  (declare (clx-values value))
   (let ((names (append full-name (list value-name)))
 	(classes (append full-class (list value-class))))
     (let* ((result (get-entry (resource-database-tight database)
@@ -321,8 +321,8 @@
 (defun get-search-table (database full-name full-class)
   ;; Return a search table for use with get-search-resource.
   (declare (type resource-database database)
-	   (type list full-name full-class)) ;; (list stringable)
-  (declare (values value))
+	   (type (clx-list stringable) full-name full-class))
+  (declare (clx-values value))
   (let* ((tight (resource-database-tight database))
 	 (loose (resource-database-loose database))
 	 (result (cons nil nil))
@@ -411,7 +411,7 @@
 	   #+(and lispm (not clx-ansi-common-lisp))
 	   (sys:downward-funarg function)
 	   (dynamic-extent args))
-  (declare (values nil))
+  (declare (clx-values nil))
   (labels ((map-resource-internal (database function args name)
 	     (declare (type resource-database database)
 		      (type (function (list t &rest t) t) function)
@@ -445,7 +445,7 @@
 
 (defun merge-resources (database with-database)
   (declare (type resource-database database with-database))
-  (declare (values resource-database))
+  (declare (clx-values resource-database))
   (map-resource
     database
     #'(lambda (name value database)
@@ -484,7 +484,7 @@
 	   (type (or null (function (string) t)) key)
 	   (type (or null (function (list t) boolean))
                  test test-not))
-  (declare (values resource-database))
+  (declare (clx-values resource-database))
   (resource-with-open-file (stream pathname)
     (loop
       (let ((string (read-line stream nil :eof)))
@@ -499,7 +499,7 @@
 	  (when i ;; else blank line
 	    (case (char string i)
 	      (#\! nil)  ;; Comment - skip
-	      (#.(card8->char 0) nil) ;; terminator for C strings - skip
+	      ;;(#.(card8->char 0) nil) ;; terminator for C strings - skip
 	      (#\#       ;; Include
 	       (setq term (position '(#\tab #\space) string :test #'char-memq
 				    :start i :end end))
@@ -525,7 +525,7 @@
   (declare (type string string)
 	   (type array-index start)
 	   (type (or null array-index) end))
-  (declare (values name-list value))
+  (declare (clx-values name-list value))
   (do ((i start)
        (end (or end (length string)))
        (term)
@@ -601,7 +601,7 @@
 	   (type (or null (function (string) t)) key)
 	   (type (or null (function (list t) boolean))
                  test test-not))
-  (declare (values resource-database))
+  (declare (clx-values resource-database))
   (let ((string (get-property window :RESOURCE_MANAGER :type :STRING
 			      :result-type 'string
 			      :transform #'xlib::card8->char)))
@@ -643,7 +643,7 @@
 	   (type (or null resource-database) database)
 	   (type (or null (function (string) t)) key)
 	   (type (or null (function (list t) boolean)) test test-not)
-	   (values resource-database))
+	   (clx-values resource-database))
   (let* ((screen (if (type? screen 'display)
 		     (display-default-screen screen)
 		   screen))
@@ -652,7 +652,7 @@
     (wm-resources database window :key key :test test :test-not test-not)
     database))
 
-(defun set-root-resources (screen &key test test-not (write 'princ) database)
+(defun set-root-resources (screen &key test test-not (write #'princ) database)
   "Changes the contents of the root window RESOURCE_MANAGER property for the
    given SCREEN. If SCREEN is a display, then its default screen is used. 
 
@@ -665,7 +665,7 @@
 	(type (or null resource-database) database)
 	(type (or null (function (list t) boolean)) test test-not)
 	(type (or null (function (string stream) t)) write)
-	(values resource-database))
+	(clx-values resource-database))
   (let* ((screen (if (type? screen 'display)
 		     (display-default-screen screen)
 		   screen))
diff --git a/clx/text.lisp b/clx/text.lisp
index c02ac22e5..f39bfc7d5 100644
--- a/clx/text.lisp
+++ b/clx/text.lisp
@@ -68,7 +68,7 @@
 	   (type (or null font) font)
 	   (type vector dst)
 	   (inline graphic-char-p))
-  (declare (values integer (or null integer font) (or null integer)))
+  (declare (clx-values integer (or null integer font) (or null integer)))
   font ;;not used
   (if (stringp src)
       (do ((i src-start (index+ i 1))
@@ -114,7 +114,7 @@
 	   (dynamic-extent translate)
 	   #+(and lispm (not clx-ansi-common-lisp))
 	   (sys:downward-funarg #+Genera * #-Genera translate))
-  (declare (values width ascent descent left right
+  (declare (clx-values width ascent descent left right
 		  font-ascent font-descent direction
 		  (or null array-index)))
   (when (type? font 'gcontext)
@@ -221,7 +221,7 @@
 	   (dynamic-extent translate)
 	   #+(and lispm (not clx-ansi-common-lisp))
 	   (sys:downward-funarg #+Genera * #-Genera translate))
-  (declare (values integer (or null integer)))
+  (declare (clx-values integer (or null integer)))
   (when (type? font 'gcontext)
     (force-gcontext-changes font)
     (setq font (gcontext-font font t)))
@@ -267,7 +267,7 @@
   (declare (type font font)
 	   (type string string)
 	   (type array-index start end))
-  (declare (values width ascent descent left right font-ascent font-descent direction))
+  (declare (clx-values width ascent descent left right font-ascent font-descent direction))
   (let ((display (font-display font))
 	(length (index- end start))
 	(font-id (font-id font)))
@@ -294,7 +294,7 @@
   (declare (type (or font gcontext) font)
 	   (type string string)
 	   (type array-index start end))
-  (declare (values integer))
+  (declare (clx-values integer))
   (let ((display (font-display font))
 	(length (index- end start))
 	(font-id (font-id font)))
@@ -314,12 +314,11 @@
 	   (type sequence sequence)
 	   (type integer start end)
 	   (type boolean width-only-p))
-  (declare (values width ascent descent overall-left overall-right))
+  (declare (clx-values width ascent descent overall-left overall-right))
   (let* ((char-infos (font-char-infos font))
 	 (font-info (font-font-info font)))
     (declare (type font-info font-info))
-    (declare (type (simple-array int16 (*)) char-infos)
-	     (array-register char-infos))
+    (declare (type (simple-array int16 (*)) char-infos))
     (if (zerop (length char-infos))
 	;; Fixed width font
 	(let* ((font-width (max-char-width font))
@@ -466,7 +465,7 @@
 	   (dynamic-extent translate)
 	   #+(and lispm (not clx-ansi-common-lisp))
 	   (sys:downward-funarg #+Genera * #-Genera translate))
-  (declare (values boolean (or null int32)))
+  (declare (clx-values boolean (or null int32)))
   (let* ((display (gcontext-display gcontext))
 	 (result t)
 	 (opcode *x-polytext8*))
@@ -517,7 +516,7 @@
 	   (dynamic-extent translate)
 	   #+(and lispm (not clx-ansi-common-lisp))
 	   (sys:downward-funarg #+Genera * #-Genera translate))
-  (declare (values (or null array-index) (or null int32)))
+  (declare (clx-values (or null array-index) (or null int32)))
   (unless end (setq end (length sequence)))
   (ecase size
     ((:default 8) (draw-glyphs8 drawable gcontext x y sequence start end
@@ -535,7 +534,7 @@
 	   (type sequence sequence)
 	   (type (or null array-index) end)
 	   (type (or null int32) width))
-  (declare (values (or null array-index) (or null int32)))
+  (declare (clx-values (or null array-index) (or null int32)))
   (declare (type translation-function translate)
 	   #+clx-ansi-common-lisp
 	   (dynamic-extent translate)
@@ -638,7 +637,7 @@
 	   (type sequence sequence)
 	   (type (or null array-index) end)
 	   (type (or null int32) width))
-  (declare (values (or null array-index) (or null int32)))
+  (declare (clx-values (or null array-index) (or null int32)))
   (declare (type translation-function translate)
 	   #+clx-ansi-common-lisp
 	   (dynamic-extent translate)
@@ -747,7 +746,7 @@
 	   (dynamic-extent translate)
 	   #+(and lispm (not clx-ansi-common-lisp))
 	   (sys:downward-funarg #+Genera * #-Genera translate))
-  (declare (values boolean (or null int32)))
+  (declare (clx-values boolean (or null int32)))
   (let* ((display (gcontext-display gcontext))
 	 (result t)
 	 (opcode *x-imagetext8*))
@@ -803,7 +802,7 @@
 	   (dynamic-extent translate)
 	   #+(and lispm (not clx-ansi-common-lisp))
 	   (sys:downward-funarg #+Genera * #-Genera translate))
-  (declare (values (or null array-index) (or null int32)))
+  (declare (clx-values (or null array-index) (or null int32)))
   (setf end (index-min (index+ start 255) (or end (length sequence))))
   (ecase size
     ((:default 8)
@@ -831,7 +830,7 @@
 	   (dynamic-extent translate)
 	   #+(and lispm (not clx-ansi-common-lisp))
 	   (sys:downward-funarg translate))
-  (declare (values (or null array-index) (or null int32)))
+  (declare (clx-values (or null array-index) (or null int32)))
   (do* ((display (gcontext-display gcontext))
 	(length (index- end start))
 	;; Should metrics-p be T?  Don't want to pass a NIL font into translate...
@@ -897,7 +896,7 @@
 	   (dynamic-extent translate)
 	   #+(and lispm (not clx-ansi-common-lisp))
 	   (sys:downward-funarg translate))
-  (declare (values (or null array-index) (or null int32)))
+  (declare (clx-values (or null array-index) (or null int32)))
   (do* ((display (gcontext-display gcontext))
 	(length (index- end start))
 	;; Should metrics-p be T?  Don't want to pass a NIL font into translate...
@@ -952,7 +951,7 @@
 
 (defun display-keycode-range (display)
   (declare (type display display))
-  (declare (values min max))
+  (declare (clx-values min max))
   (values (display-min-keycode display)
 	  (display-max-keycode display)))
 
@@ -965,7 +964,7 @@
   ;; Setf ought to allow multiple values.
   (declare (type display display)
 	   (type sequence shift lock control mod1 mod2 mod3 mod4 mod5))
-  (declare (values (member :success :busy :failed)))
+  (declare (clx-values (member :success :busy :failed)))
   (let* ((keycodes-per-modifier (index-max (length shift)
 					   (length lock)
 					   (length control)
@@ -993,7 +992,7 @@
 (defun modifier-mapping (display)
   ;; each value is a list of integers
   (declare (type display display))
-  (declare (values shift lock control mod1 mod2 mod3 mod4 mod5))
+  (declare (clx-values shift lock control mod1 mod2 mod3 mod4 mod5))
   (let ((lists nil))
     (with-buffer-request-and-reply (display *x-getmodifiermapping* nil :sizes 8)
 	 ()
@@ -1059,7 +1058,7 @@
 	   (type (or null card8) first-keycode)
 	   (type (or null array-index) start end)
 	   (type (or null (array * (* *))) data))
-  (declare (values (array * (* *))))
+  (declare (clx-values (array * (* *))))
   (unless first-keycode (setq first-keycode (display-min-keycode display)))
   (unless start (setq start first-keycode))
   (unless end (setq end (1+ (display-max-keycode display))))
diff --git a/clx/translate.lisp b/clx/translate.lisp
index 9ec5768c0..aa8ff5b2d 100644
--- a/clx/translate.lisp
+++ b/clx/translate.lisp
@@ -41,7 +41,7 @@
 (defun keysym-set (keysym)
   ;; Return the character code set name of keysym
   (declare (type keysym keysym)
-	   (values keyword))
+	   (clx-values keyword))
   (dolist (set *keysym-sets*)
     (let ((first (second set))
 	  (last (third set)))
@@ -60,7 +60,7 @@
   ;; lookup. All arguments are evaluated.
   (declare (type t keysym)
 	   (type list bytes)
-	   (values keysym))
+	   (clx-values keysym))
   (typecase keysym
     ((integer 0 *)
      (dolist (b bytes keysym) (setq keysym (+ (ash keysym 8) b))))
@@ -102,7 +102,7 @@
   `(fifth ,keysym-mapping))
 
 (defvar *default-keysym-translate-mask*
-	(the (or (member :modifiers) mask16 list)	; (list (or keysym state-mask-key))
+	(the (or (member :modifiers) mask16 (clx-list (or keysym state-mask-key)))
 	     (logand #xff (lognot (make-state-mask :lock))))
   "Default keysym state mask to use during keysym-translation.")
 
@@ -139,13 +139,13 @@
   ;;
   (declare (type (or base-char t) object)
 	   (type keysym keysym)
-	   (type (or null mask16 list) ;; (list (or keysym state-mask-key))
+	   (type (or null mask16 (clx-list (or keysym state-mask-key)))
 	         modifiers)
-	   (type (or null (member :modifiers) mask16 list) ;; (list (or keysym state-mask-key))
+	   (type (or null (member :modifiers) mask16 (clx-list (or keysym state-mask-key)))
 	         mask)
 	   (type (or null display) display)
            (type (or null keysym) lowercase)
-	   (type (function (display card16 t) t) translate))
+	   (type (or null (function (display card16 t) t)) translate))
   (flet ((merge-keysym-mappings (new old)
 	   ;; Merge new keysym-mapping with list of old mappings.
 	   ;; Ensure that the mapping with no modifiers or mask comes first.
@@ -160,7 +160,7 @@
 			 (unless (or (find element *state-mask-vector*)
 				     (gethash element *keysym->character-map*))
 			   (return nil))))
-	     (x-type-error mask '(or mask16 (list (or modifier-key modifier-keysym)))))))
+	     (x-type-error mask '(or mask16 (clx-list (or modifier-key modifier-keysym)))))))
     (let ((entry
 	    ;; Create with a single LIST call, to ensure cdr-coding
 	    (cond
@@ -189,7 +189,7 @@
   ;; If DISPLAY is non-nil, undefine the translation for DISPLAY if it exists.
   (declare (type (or base-char t) object)
 	   (type keysym keysym)
-	   (type (or null mask16 list) ;; (list (or keysym state-mask-key))
+	   (type (or null mask16 (clx-list (or keysym state-mask-key)))
 	         modifiers)
 	   (type (or null display) display))
   (flet ((match (key entry)
@@ -211,7 +211,7 @@
 (defun keysym-downcase (keysym)
   ;; If keysym has a lower-case equivalent, return it, otherwise return keysym.
   (declare (type keysym keysym))
-  (declare (values keysym))
+  (declare (clx-values keysym))
   (let ((translations (gethash keysym *keysym->character-map*)))
     (or (and translations (keysym-mapping-lowercase (first translations))) keysym)))
 
@@ -219,7 +219,7 @@
   ;; Returns T if keysym is uppercase-alphabetic.
   ;; I.E. If it has a lowercase equivalent.
   (declare (type keysym keysym))
-  (declare (values (or null keysym)))
+  (declare (clx-values (or null keysym)))
   (let ((translations (gethash keysym *keysym->character-map*)))
     (and translations
 	 (keysym-mapping-lowercase (first translations)))))
@@ -232,7 +232,7 @@
   ;; May be slow [i.e. do a linear search over all known keysyms]
   (declare (type t character)
 	   (type (or null display) display)
-	   (values (list keysym)))
+	   (clx-values (clx-list keysym)))
   (let ((result nil))
     (when display
       (dolist (mapping (display-keysym-translation display))
@@ -269,7 +269,7 @@
 
 (defun display-keyboard-mapping (display)
   (declare (type display display))
-  (declare (values (simple-array keysym (display-max-keycode keysyms-per-keycode))))
+  (declare (clx-values (simple-array keysym (display-max-keycode keysyms-per-keycode))))
   (or (display-keysym-mapping display)
       (setf (display-keysym-mapping display) (keyboard-mapping display))))
 
@@ -277,7 +277,7 @@
   (declare (type display display)
 	   (type card8 keycode)
 	   (type card8 keysym-index)
-	   (values keysym))
+	   (clx-values keysym))
   (let* ((mapping (display-keyboard-mapping display))
 	 (keysym (aref mapping keycode keysym-index)))
     (declare (type (simple-array keysym (* *)) mapping)
@@ -300,7 +300,7 @@
   (declare (type display display)
 	   (type keysym keysym)
 	   (type card16 state))
-  (declare (values (or null character)))
+  (declare (clx-values (or null character)))
   (let* ((display-mappings (cdr (assoc keysym (display-keysym-translation display))))
 	 (mapping (or ;; Find the matching display mapping
 		      (dolist (mapping display-mappings)
@@ -319,7 +319,7 @@
   (declare (type display display)
 	   (type mask16 state)
 	   (type list mapping))
-  (declare (values boolean))
+  (declare (clx-values boolean))
   (flet
     ((modifiers->mask (display-mapping modifiers errorp &aux (mask 0))
        ;; Convert MODIFIERS, which is a modifier mask, or a list of state-mask-keys into a mask.
@@ -328,7 +328,7 @@
        (declare (type list display-mapping)	; Alist of (keysym . mask)
 		(type (or mask16 list) modifiers)
 		(type mask16 mask))
-       (declare (values (or null mask16)))
+       (declare (clx-values (or null mask16)))
        (if (numberp modifiers)
 	   modifiers
 	 (dolist (modifier modifiers mask)
@@ -360,7 +360,7 @@
 
 (defun default-keysym-index (display keycode state)
   ;; Returns a keysym-index for use with keycode->character
-  (declare (values card8))
+  (declare (clx-values card8))
   (macrolet ((keystate-p (state keyword)
 	       `(the boolean
 		     (logbitp ,(position keyword *state-mask-vector*)
@@ -388,7 +388,7 @@
 	   (type boolean uppercase-alphabetic-p)
 	   (type boolean shift-lock-xors));;; If T, both SHIFT-LOCK and SHIFT is the same
 	                                  ;;; as neither if the character is alphabetic.
-  (declare (values boolean))
+  (declare (clx-values boolean))
   (macrolet ((keystate-p (state keyword)
 	       `(the boolean
 		     (logbitp ,(position keyword *state-mask-vector*)
@@ -450,7 +450,7 @@
 	   (type (or null card8) keysym-index)
 	   (type (or null (function (base-char card16 boolean card8) card8))
 		 keysym-index-function))
-  (declare (values (or null character)))
+  (declare (clx-values (or null character)))
   (let* ((index (or keysym-index
 		    (funcall keysym-index-function display keycode state)))
 	 (keysym (if index (keycode->keysym display keycode index) 0)))
@@ -481,7 +481,7 @@
   (declare (type display display)
 	   (type card16 state)
 	   (type keysym keysym))
-  (declare (values boolean))
+  (declare (clx-values boolean))
   (let* ((mapping (get-display-modifier-mapping display))
 	 (mask (assoc keysym mapping)))
     (and mask (plusp (logand state (cdr mask))))))
@@ -505,7 +505,7 @@
   (declare (type display display)
 	   (type keysym keysym)
 	   (type (bit-vector 256) keymap))
-  (declare (values boolean))
+  (declare (clx-values boolean))
   ;; The keysym may appear in the keymap more than once,
   ;; So we have to search the entire keysym map.
   (do* ((min (display-min-keycode display))
@@ -527,7 +527,7 @@
   (declare (type display display)
 	   (type character character)
 	   (type (bit-vector 256) keymap))
-  (declare (values boolean))
+  (declare (clx-values boolean))
   ;; Check all one bits in keymap
   (do* ((min (display-min-keycode display))
 	(max (display-max-keycode display))
@@ -546,7 +546,7 @@
   ;; Return keycodes for keysym, as multiple values
   (declare (type display display)
 	   (type keysym keysym))
-  (declare (values (or null keycode) (or null keycode) (or null keycode)))
+  (declare (clx-values (or null keycode) (or null keycode) (or null keycode)))
   ;; The keysym may appear in the keymap more than once,
   ;; So we have to search the entire keysym map.
   (do* ((min (display-min-keycode display))
-- 
GitLab