diff --git a/src/clx/README-CMUCL b/src/clx/README-CMUCL
index d0fead6c71212df86e9dbdffa5f48da0dc19890e..f08c5c7caa9ec9c0cf0bf26894f5974e0ac6f872 100644
--- a/src/clx/README-CMUCL
+++ b/src/clx/README-CMUCL
@@ -1,40 +1,9 @@
-$Id: README-CMUCL,v 1.2 2009/06/11 16:03:56 rtoy Rel $
+This is an import of Telent-CLX from the fork
+https://github.com/sharplispers/clx, version
+6e39a0df2a0a1d083166f405d4b8bbc463d54d85.
 
-This is an import of Telent-CLX as of 0.7.3.
+All (almost?) files are included.  A few changes to fix bugs related
+to CMUCL have been added, as well as the CVS id.  I've tried to make
+few changes so it will be easy to merge again when desired.
 
-All files are included.  A few changes to fix bugs related to CMUCL
-have been added, as well as the CVS id.  I've tried to make few
-changes so it will be easy to merge again when desired.
-
-The following files from this directory are compiled and loaded by
-CMUCL when it builds utilities:
-
-clx-library.lisp
-package.lisp
-depdefs.lisp
-clx.lisp
-dependent.lisp
-macros.lisp
-bufmac.lisp
-buffer.lisp
-display.lisp
-gcontext.lisp
-input.lisp
-requests.lisp
-fonts.lisp
-graphics.lisp
-text.lisp
-attributes.lisp
-translate.lisp
-keysyms.lisp
-manager.lisp
-image.lisp
-resource.lisp
-shape.lisp
-big-requests.lisp
-xvidmode.lisp
-xrender.lisp
-glx.lisp
-gl.lisp
-dpms.lisp
-provide.lisp
+See src/tools/clxcom.lisp to see what files are compiled.
diff --git a/src/clx/attributes.lisp b/src/clx/attributes.lisp
index c4a92d023f48eed19512595746af1a617d12693e..613abda304a8c3bc9525e1c0018b44af2d91bb41 100644
--- a/src/clx/attributes.lisp
+++ b/src/clx/attributes.lisp
@@ -40,9 +40,6 @@
 ;;;	All WITH-STATE has to do (re)bind *Window-attributes* to a list including
 ;;;	the new drawable.  The caches are initialized to NIL and allocated as needed.
 
-#+cmu
-(ext:file-comment "$Id: attributes.lisp,v 1.8 2009/06/17 18:22:45 rtoy Rel $")
-
 (in-package :xlib)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -519,13 +516,11 @@
   window
   (error "~S can only be set" 'window-cursor))
 
-(defun set-window-cursor (window cursor)
+(defun (setf window-cursor) (cursor window)
   (change-window-attribute
     window 14 (encode-type (or (member :none) cursor) cursor))
   cursor)
 
-(defsetf window-cursor set-window-cursor)
-
 (defun window-colormap-installed-p (window)
   (declare (type window window))
   (declare (clx-values generalized-boolean))
diff --git a/src/clx/buffer.lisp b/src/clx/buffer.lisp
index a5a38889658d2002da194d2611999bae236cf621..dd71190e255d1e65f43c2f1a27bbaa89126df0c0 100644
--- a/src/clx/buffer.lisp
+++ b/src/clx/buffer.lisp
@@ -49,9 +49,6 @@
 ;;     a point after a complete request.  This is to ensure that a partial
 ;;     request won't be left after aborts (e.g. control-abort on a lispm).
 
-#+cmu
-(ext:file-comment "$Id: buffer.lisp,v 1.10 2009/06/17 18:22:45 rtoy Rel $")
-
 (in-package :xlib)
 
 (defconstant +requestsize+ 160) ;; Max request size (excluding variable length requests)
@@ -71,7 +68,6 @@
 		   ,@body)))
      ,(if (and (null inline) (macroexpand '(use-closures) env))
 	  `(flet ((.with-buffer-body. () ,@body))
-	     #+clx-ansi-common-lisp
 	     (declare (dynamic-extent #'.with-buffer-body.))
 	     (with-buffer-function ,buffer ,timeout #'.with-buffer-body.))
 	(let ((buf (if (or (symbolp buffer) (constantp buffer))
@@ -90,13 +86,10 @@
   (declare (type display buffer)
 	   (type (or null number) timeout)
 	   (type function function)
-	   #+clx-ansi-common-lisp
 	   (dynamic-extent function)
 	   ;; FIXME: This is probably more a bug in SBCL (logged as
 	   ;; bug #243)
-	   (ignorable timeout)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg function))
+	   (ignorable timeout))
   (with-buffer (buffer :timeout timeout :inline t)
     (funcall function)))
 
@@ -288,10 +281,7 @@
   (declare (type display display)
 	   (type (or null gcontext) gc-force))
   (declare (type function request-function)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent request-function)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg request-function))
+	   (dynamic-extent request-function))
   (with-buffer (display :inline t)
     (multiple-value-prog1
       (progn
@@ -303,10 +293,7 @@
   (declare (type display display)
 	   (type (or null gcontext) gc-force))
   (declare (type function request-function)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent request-function)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg request-function))
+	   (dynamic-extent request-function))
   (multiple-value-prog1
     (progn
       (when gc-force (force-gcontext-changes-internal gc-force))
@@ -324,10 +311,7 @@
   (declare (type display display)
 	   (type generalized-boolean multiple-reply))
   (declare (type function request-function reply-function)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent request-function reply-function)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg request-function reply-function))
+	   (dynamic-extent request-function reply-function))
   (let ((pending-command nil)
 	(reply-buffer nil))
     (declare (type (or null pending-command) pending-command)
@@ -498,11 +482,10 @@
        (type array-index nitems start index)
        (type (or null sequence) data)
        (type (or null (function (,totype) t)) transform)
-       #+clx-ansi-common-lisp (dynamic-extent transform)
-       #+(and lispm (not clx-ansi-common-lisp)) (sys:downward-funarg transform))
+       (dynamic-extent transform))
       (if transform
 	  (flet ((,ntrans (v) (funcall transform (,transformer v))))
-	    #+clx-ansi-common-lisp (declare (dynamic-extent #',ntrans))
+            (declare (dynamic-extent #',ntrans))
 	    (,reader reply-buffer result-type nitems #',ntrans data start index))
 	  (,reader reply-buffer result-type nitems #',transformer data start index)))))
 
@@ -529,8 +512,7 @@
 	       (type array-index nitems start index)
 	       (type list data)
 	       (type (function (,type) t) transform)
-	       #+clx-ansi-common-lisp (dynamic-extent transform)
-	       #+(and lispm (not clx-ansi-common-lisp)) (sys:downward-funarg transform))
+               (dynamic-extent transform))
       (with-buffer-input (reply-buffer :sizes (,size) :index index)
 	(do* ((j nitems (index- j 1))
 	      (list (nthcdr start data) (cdr list))
@@ -557,10 +539,7 @@
 	   (type array-index nitems start index)
 	   (type (simple-array card8 (*)) data))
   (declare (type (function (card8) card8) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data (simple-array card8 (*)))
     (with-buffer-input (reply-buffer :sizes (8) :index index)
       (do* ((j start (index+ j 1))
@@ -590,10 +569,7 @@
 	   (type vector data)
 	   (optimize #+cmu(ext:inhibit-warnings 3)))
   (declare (type (function (card8) t) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data vector)
     (with-buffer-input (reply-buffer :sizes (8) :index index)
       (do* ((j start (index+ j 1))
@@ -611,8 +587,7 @@
      (type array-index nitems start index)
      (type (or null sequence) data)
      (type (or null (function (,type) t)) transform)
-     #+clx-ansi-common-lisp (dynamic-extent transform)
-     #+(and lispm (not clx-ansi-common-lisp)) (sys:downward-funarg transform))
+     (dynamic-extent transform))
     (let ((result (or data (make-sequence result-type nitems))))
       (typecase result
 	(list
@@ -667,10 +642,7 @@
 	   (type array-index nitems start index)
 	   (type (simple-array card16 (*)) data))
   (declare (type (function (card16) card16) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data (simple-array card16 (*)))
     (with-buffer-input (reply-buffer :sizes (16) :index index)
       (do* ((j start (index+ j 1))
@@ -703,10 +675,7 @@
 	   (type vector data)
 	   (optimize #+cmu(ext:inhibit-warnings 3)))
   (declare (type (function (card16) t) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data vector)
     (with-buffer-input (reply-buffer :sizes (16) :index index)
       (do* ((j start (index+ j 1))
@@ -752,10 +721,7 @@
 	   (type array-index nitems start index)
 	   (type (simple-array card32 (*)) data))
   (declare (type (function (card32) card32) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data (simple-array card32 (*)))
     (with-buffer-input (reply-buffer :sizes (32) :index index)
       (do* ((j start (index+ j 1))
@@ -788,10 +754,7 @@
 	   (type vector data)
 	   (optimize #+cmu(ext:inhibit-warnings 3)))
   (declare (type (function (card32) t) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data vector)
     (with-buffer-input (reply-buffer :sizes (32) :index index)
       (do* ((j start (index+ j 1))
@@ -819,11 +782,10 @@
        (type sequence data)
        (type array-index boffset start end)
        (type (or null (function (t) ,fromtype)) transform)
-       #+clx-ansi-common-lisp (dynamic-extent transform)
-       #+(and lispm (not clx-ansi-common-lisp)) (sys:downward-funarg transform))
+       (dynamic-extent transform))
       (if transform
 	  (flet ((,ntrans (x) (,transformer (the ,fromtype (funcall transform x)))))
-	    #+clx-ansi-common-lisp (declare (dynamic-extent #',ntrans))
+            (declare (dynamic-extent #',ntrans))
 	    (,writer buffer boffset data start end #',ntrans))
 	  (,writer buffer boffset data start end #',transformer)))))
 
@@ -852,8 +814,7 @@
        (type list data)
        (type array-index boffset start end)
        (type (function (t) ,type) transform)
-       #+clx-ansi-common-lisp (dynamic-extent transform)
-       #+(and lispm (not clx-ansi-common-lisp)) (sys:downward-funarg transform))
+       (dynamic-extent transform))
       (writing-buffer-chunks ,type
 	  ((list (nthcdr start data)))
 	  ((type list list))
@@ -905,10 +866,7 @@
 	   (type (simple-array card8 (*)) data)
 	   (type array-index boffset start end))
   (declare (type (function (card8) card8) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data (simple-array card8 (*)))
     (writing-buffer-chunks card8
 			   ((index start))
@@ -939,10 +897,7 @@
 	   (type vector data)
 	   (type array-index boffset start end))
   (declare (type (function (t) card8) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data vector)
     (writing-buffer-chunks card8
 			   ((index start))
@@ -960,8 +915,7 @@
      (type sequence data)
      (type array-index boffset start end)
      (type (or null (function (t) ,type)) transform)
-     #+clx-ansi-common-lisp (dynamic-extent transform)
-     #+(and lispm (not clx-ansi-common-lisp)) (sys:downward-funarg transform))
+     (dynamic-extent transform))
     (typecase data
       (list
        (if transform
@@ -1020,10 +974,7 @@
 	   (type (simple-array card16 (*)) data)
 	   (type array-index boffset start end))
   (declare (type (function (card16) card16) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data (simple-array card16 (*)))
     (writing-buffer-chunks card16
 			   ((index start))
@@ -1066,10 +1017,7 @@
 	   (type array-index boffset start end)
 	   (optimize #+cmu(ext:inhibit-warnings 3)))
   (declare (type (function (t) card16) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data vector)
     (writing-buffer-chunks card16
 			   ((index start))
@@ -1122,10 +1070,7 @@
 	   (type (simple-array int16 (*)) data)
 	   (type array-index boffset start end))
   (declare (type (function (int16) int16) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data (simple-array int16 (*)))
     (writing-buffer-chunks int16
 			   ((index start))
@@ -1168,10 +1113,7 @@
 	   (type array-index boffset start end)
 	   (optimize #+cmu(ext:inhibit-warnings 3)))
   (declare (type (function (t) int16) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data vector)
     (writing-buffer-chunks int16
 			   ((index start))
@@ -1224,10 +1166,7 @@
 	   (type (simple-array card32 (*)) data)
 	   (type array-index boffset start end))
   (declare (type (function (card32) card32) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data (simple-array card32 (*)))
     (writing-buffer-chunks card32
 			   ((index start))
@@ -1270,10 +1209,7 @@
 	   (type array-index boffset start end)
 	   (optimize #+cmu(ext:inhibit-warnings 3)))
   (declare (type (function (t) card32) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data vector)
     (writing-buffer-chunks card32
 			   ((index start))
@@ -1362,10 +1298,7 @@
 	   (type (simple-array card16 (*)) data)
 	   (type array-index boffset start end))
   (declare (type (function (card16) card16) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data (simple-array card16 (*)))
     (writing-buffer-chunks card16
 			   ((index start))
@@ -1399,10 +1332,7 @@
 	   (type array-index boffset start end)
 	   (optimize #+cmu(ext:inhibit-warnings 3)))
   (declare (type (function (t) card16) transform)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent transform)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg transform))
+	   (dynamic-extent transform))
   (with-vector (data vector)
     (writing-buffer-chunks card16
 			   ((index start))
diff --git a/src/clx/bufmac.lisp b/src/clx/bufmac.lisp
index a2cbcd938d64f09ea781f96917766ca6e40a1ff5..1e002b824dfa240e93c10b6bd2858ab36f44bb8c 100644
--- a/src/clx/bufmac.lisp
+++ b/src/clx/bufmac.lisp
@@ -19,9 +19,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: bufmac.lisp,v 1.6 2009/06/17 18:22:45 rtoy Rel $")
-
 (in-package :xlib)
 
 ;;; The read- macros are in buffer.lisp, because event-case depends on (most of) them.
diff --git a/src/clx/build-clx.lisp b/src/clx/build-clx.lisp
index cb8ccddaa149d397a915d60f6d83af6ad8cee811..76b3299ea82ce418a3ae2bc21b65469ee5b4c3cf 100644
--- a/src/clx/build-clx.lisp
+++ b/src/clx/build-clx.lisp
@@ -1,8 +1,5 @@
 ;;; -*- Mode: Lisp; Package: Xlib; Log: clx.log -*-
 
-#+cmu
-(ext:file-comment "$Id: build-clx.lisp,v 1.5 2009/06/17 18:22:45 rtoy Rel $")
-
 ;;; Load this file if you want to compile CLX in its entirety.
 (proclaim '(optimize (speed 3) (safety 1) (space 1)
 		     (compilation-speed 0)))
diff --git a/src/clx/clx-module.lisp b/src/clx/clx-module.lisp
index 903e1ef2222e1157a24cb7e23e2a9d6d868de6dd..e72651fc85659dc7269a585694d3266404c05290 100644
--- a/src/clx/clx-module.lisp
+++ b/src/clx/clx-module.lisp
@@ -1,9 +1,5 @@
 ;;;(in-package :xlib)
 ;;;(common-lisp:use-package (list :common-lisp))
-
-#+cmu
-(ext:file-comment "$Id: clx-module.lisp,v 1.2 2009/06/17 18:22:45 rtoy Rel $")
-
 (provide :clx)
 (load "clx:defsystem.lisp")
-(load-clx (translate-logical-pathname "CLX:"))
+(load-clx (translate-logical-pathname "CLX:"))
\ No newline at end of file
diff --git a/src/clx/clx.lisp b/src/clx/clx.lisp
index 02c18f62f56fd84607f5bd1b037ea6d22dbb6475..2795556245ead84d7ab108abaf9540554e968659 100644
--- a/src/clx/clx.lisp
+++ b/src/clx/clx.lisp
@@ -76,9 +76,6 @@
 ;;; objects, and the additional functionality to match the C Xlib is still in
 ;;; progress.  Bug reports should be addressed to bug-clx@expo.lcs.mit.edu.
 
-#+cmu
-(ext:file-comment "$Id: clx.lisp,v 1.16 2009/06/17 18:22:45 rtoy Rel $")
-
 ;; Note: all of the following is in the package XLIB.
 
 (in-package :xlib)
@@ -86,7 +83,7 @@
 (pushnew :clx *features*)
 (pushnew :xlib *features*)
 
-(defparameter *version* "Telent CLX 0.7.3 + CMUCL mods, based on MIT R5.02")
+(defparameter *version* "MIT R5.02")
 (pushnew :clx-mit-r4 *features*)
 (pushnew :clx-mit-r5 *features*)
 
@@ -162,20 +159,6 @@
 
 (deftype card4 () '(unsigned-byte 4))
 
-#-clx-ansi-common-lisp
-(deftype real (&optional (min '*) (max '*))
-  (labels ((convert (limit floatp)
-	     (typecase limit
-	       (number (if floatp (float limit 0s0) (rational limit)))
-	       (list (map 'list #'convert limit))
-	       (otherwise limit))))
-    `(or (float ,(convert min t) ,(convert max t))
-	 (rational ,(convert min nil) ,(convert max nil)))))
-
-#-clx-ansi-common-lisp
-(deftype base-char ()
-  'string-char)
-
 ; Note that we are explicitly using a different rgb representation than what
 ; is actually transmitted in the protocol.
 
diff --git a/src/clx/cmudep.lisp b/src/clx/cmudep.lisp
index 0c10b3daa7b5210d0de2b8abed7dd993b96542b4..8624a3ee36a7db24680ce3f817fe7f355a13b9c1 100644
--- a/src/clx/cmudep.lisp
+++ b/src/clx/cmudep.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: src/clx/cmudep.lisp $")
+  "$Header: /loaclhost/usr/local/src/cvs/clx/cmudep.lisp,v 1.1 2000/07/02 19:19:46 dan Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/src/clx/defsystem.lisp b/src/clx/defsystem.lisp
index ad34fbaa99905d052ea6c8a9c296c4d0d12e97a8..74b5a2c3318ec8a7f24f06fbe70c72ad0291efde 100644
--- a/src/clx/defsystem.lisp
+++ b/src/clx/defsystem.lisp
@@ -20,7 +20,6 @@
 ;;; implied warranty.
 
 ;;; #+ features used in this file
-;;;   clx-ansi-common-lisp
 ;;;   lispm
 ;;;   genera
 ;;;   minima
@@ -33,26 +32,15 @@
 ;;;   CMU
 ;;;   sbcl
 
-#+cmu
-(ext:file-comment "$Id: defsystem.lisp,v 1.9 2009/06/17 18:22:45 rtoy Rel $")
-
-#+(or Genera Minima sbcl ecl)
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (common-lisp:pushnew :clx-ansi-common-lisp common-lisp:*features*))
-
-#+(and Genera clx-ansi-common-lisp)
+#+Genera
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf *readtable* si:*ansi-common-lisp-readtable*))
 
-#-(or clx-ansi-common-lisp cmu)
-(lisp:in-package :user)
-
 #+cmu
 (lisp:in-package "XLIB")
 #+cmu 
 (export 'load-clx)
 
-#+clx-ansi-common-lisp
 (common-lisp:in-package :common-lisp-user)
 
 
@@ -378,7 +366,7 @@
 			:version   (pathname-version   source-path)))
 	 (binary-path (merge-pathnames binary-pathname-defaults
 				       path))
-	 #+clx-ansi-common-lisp (*compile-verbose* t)
+         (*compile-verbose* t)
 	 (*load-verbose* t))
 				       
     ;; Make sure source-path and binary-path file types are distinct so
@@ -448,9 +436,8 @@
 
       ;; Now compile and load all the files.
       ;; Defer compiler warnings until everything's compiled, if possible.
-      (#+(or clx-ansi-common-lisp CMU) with-compilation-unit
+      (with-compilation-unit
        #+lcl3.0 lucid::with-deferred-warnings
-       #-(or lcl3.0 clx-ansi-common-lisp CMU) progn
        ()
        
        (compile-and-load "package")
diff --git a/src/clx/demo/bezier.lisp b/src/clx/demo/bezier.lisp
index f5776115445a67ab97dfe72a4fa8bbd078dbd9ea..fca439b0020bdbbe0c1c889e259c79054c86ab16 100644
--- a/src/clx/demo/bezier.lisp
+++ b/src/clx/demo/bezier.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: bezier.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (export 'draw-curves)
diff --git a/src/clx/demo/beziertest.lisp b/src/clx/demo/beziertest.lisp
index f564bc9ef86e57efea43980eedec42372a29679e..a8b2c2feb82092a6bc966e91a6b03bc4c9f04553 100644
--- a/src/clx/demo/beziertest.lisp
+++ b/src/clx/demo/beziertest.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: beziertest.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (defun bezier-test (host &optional (pathname "/usr/X.V11R1/extensions/test/datafile"))
diff --git a/src/clx/demo/clclock.lisp b/src/clx/demo/clclock.lisp
index bf9db76b09fdad101e69236bdd8f4a59445e527d..c5413dadca04c1bfa1d85d75dbb0b407e2d8dcdf 100644
--- a/src/clx/demo/clclock.lisp
+++ b/src/clx/demo/clclock.lisp
@@ -1,11 +1,8 @@
-#+cmu
-(ext:file-comment "$Id: clclock.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
-
-(defpackage "XCLCLOCK"
+(defpackage #:xlib-demo/clclock
   (:use "CL")
   (:export "CLOCK"))
 
-(in-package "XCLCLOCK")
+(in-package #:xlib-demo/clclock)
 
 (defvar *display* (xlib:open-default-display))
 (defvar *screen* (xlib:display-default-screen *display*))
diff --git a/src/clx/demo/clipboard.lisp b/src/clx/demo/clipboard.lisp
index c544a09d600d47d115fdb228e34ff77dd243f30f..803ebfeb62a2c41761a1ecd1796223548d926d57 100644
--- a/src/clx/demo/clipboard.lisp
+++ b/src/clx/demo/clipboard.lisp
@@ -59,14 +59,11 @@
 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 ;;; DEALINGS IN THE SOFTWARE.
 
-#+cmu
-(ext:file-comment "$Id: clipboard.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
-
-(defpackage "CLIPBOARD"
+(defpackage #:xlib-demo/clipboard
   (:use "CL" "XLIB")
   (:export "MAIN"))
 
-(in-package "CLIPBOARD")
+(in-package #:xlib-demo/clipboard)
 
 ;;; This is "traditional" XLIB style; I don't really know if it's the
 ;;; best way -- in developing this program, style of XLIB programming
diff --git a/src/clx/demo/clx-demos.lisp b/src/clx/demo/clx-demos.lisp
index 4f08d8d5f0f63179fd6c8b38209da1428fd9a26a..0179e538ba9e4b9836bb5e76546ed0387e5f2ca4 100644
--- a/src/clx/demo/clx-demos.lisp
+++ b/src/clx/demo/clx-demos.lisp
@@ -6,13 +6,10 @@
 ;;; This file should be portable to any valid Common Lisp with CLX -- DEC 88.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: clx-demos.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
-
-(defpackage :demos (:use :common-lisp)
+(defpackage #:xlib-demo/demos (:use :common-lisp)
   (:export do-all-demos demo))
 
-(in-package :demos)
+(in-package :xlib-demo/demos)
 
 
 ;;;; Graphic demos wrapper macro.
@@ -39,11 +36,11 @@
        (unless *display*
 	 #+:cmu
 	 (multiple-value-setq (*display* *screen*) (ext:open-clx-display))
-	 #+(or sbcl allegro clisp)
+	 #+(or sbcl allegro clisp lispworks)
 	 (progn
 	   (setf *display* (xlib::open-default-display))
 	   (setf *screen* (xlib:display-default-screen *display*)))
-	 #-(or cmu sbcl allegro clisp)
+	 #-(or cmu sbcl allegro clisp lispworks)
 	 (progn
 	   ;; Portable method
 	   (setf *display* (xlib:open-display (machine-instance)))
diff --git a/src/clx/demo/gl-test.lisp b/src/clx/demo/gl-test.lisp
index d9cd3dfda8295bc1626b74c3e734288cd0cbab1c..543cc8cd49d95dfeebd81af765f2845946dc3b39 100644
--- a/src/clx/demo/gl-test.lisp
+++ b/src/clx/demo/gl-test.lisp
@@ -1,11 +1,8 @@
-#+cmu
-(ext:file-comment "$Id: gl-test.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
-
-(defpackage :gl-test
-  (:use :common-lisp :xlib)
+(defpackage #:xlib-demo/gl-test
+  (:use :common-lisp :xlib :xlib/gl)
   (:export "TEST" "CLX-TEST"))
 
-(in-package :gl-test)
+(in-package #:xlib-demo/gl-test)
 
 
 (defun test (function &key (host "localhost") (display 1) (width 200) (height 200))
@@ -16,19 +13,19 @@
     (unwind-protect
          (progn
            ;;; Inform the server about us.
-           (glx::client-info display)
-           (let* ((visual (glx:choose-visual screen '(:glx-rgba
+           (xlib/glx::client-info display)
+           (let* ((visual (xlib/glx:choose-visual screen '(:glx-rgba
                                                       (:glx-red-size 1)
                                                       (:glx-green-size 1)
                                                       (:glx-blue-size 1)
                                                       :glx-double-buffer)))
-                  (colormap (create-colormap (glx:visual-id visual) root))
+                  (colormap (create-colormap (xlib/glx:visual-id visual) root))
                   (window (create-window :parent root
                                          :x 10 :y 10 :width width :height height
                                          :class :input-output
                                          :background (screen-black-pixel screen)
                                          :border (screen-black-pixel screen)
-                                         :visual (glx:visual-id visual)
+                                         :visual (xlib/glx:visual-id visual)
                                          :depth 24
                                          :colormap colormap
                                          :event-mask '(:structure-notify :exposure)))
@@ -44,16 +41,16 @@
                                 :min-width width :min-height height
                                 :initial-state :normal)
 
-             (setf ctx (glx:create-context screen (glx:visual-id visual)))
+             (setf ctx (xlib/glx:create-context screen (xlib/glx:visual-id visual)))
              (map-window window)
-             (glx:make-current window ctx)
+             (xlib/glx:make-current window ctx)
 
              (funcall function display window)
 
              (unmap-window window)
              (free-gcontext gc)))
       
-      (when ctx (glx:destroy-context ctx))
+      (when ctx (xlib/glx:destroy-context ctx))
       (close-display display))))
 
 
@@ -62,76 +59,76 @@
 
 (defun no-floats (display window)
   (declare (ignore display window))
-  (gl:color-3s #x7fff #x7fff 0)
-  (gl:begin gl:+polygon+)
-  (gl:vertex-2s 0 0)
-  (gl:vertex-2s 1 0)
-  (gl:vertex-2s 1 1)
-  (gl:vertex-2s 0 1)
-  (gl:end)
-  (glx:swap-buffers)
+  (color-3s #x7fff #x7fff 0)
+  (begin +polygon+)
+  (vertex-2s 0 0)
+  (vertex-2s 1 0)
+  (vertex-2s 1 1)
+  (vertex-2s 0 1)
+  (end)
+  (xlib/glx:swap-buffers)
   (sleep 5))
 
 
 (defun anim (display window)
   (declare (ignore display window))
-  (gl:ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0)
-  (gl:clear-color 0.0s0 0.0s0 0.0s0 0.0s0)
-  (gl:line-width 2.0s0)
+  (ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0)
+  (clear-color 0.0s0 0.0s0 0.0s0 0.0s0)
+  (line-width 2.0s0)
   (loop
      repeat 361
      for angle upfrom 0.0s0 by 1.0s0
      do (progn
-          (gl:clear gl:+color-buffer-bit+)
-          (gl:push-matrix)
-          (gl:translate-f 0.5s0 0.5s0 0.0s0)
-          (gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
-          (gl:translate-f -0.5s0 -0.5s0 0.0s0)
-          (gl:begin gl:+polygon+ #-(and) gl:+line-loop+)
-          (gl:color-3ub 255 0 0)
-          (gl:vertex-2f 0.25s0 0.25s0)
-          (gl:color-3ub 0 255 0)
-          (gl:vertex-2f 0.75s0 0.25s0)
-          (gl:color-3ub 0 0 255)
-          (gl:vertex-2f 0.75s0 0.75s0)
-          (gl:color-3ub 255 255 255)
-          (gl:vertex-2f 0.25s0 0.75s0)
-          (gl:end)
-          (gl:pop-matrix)
-          (glx:swap-buffers)
+          (clear +color-buffer-bit+)
+          (push-matrix)
+          (translate-f 0.5s0 0.5s0 0.0s0)
+          (rotate-f angle 0.0s0 0.0s0 1.0s0)
+          (translate-f -0.5s0 -0.5s0 0.0s0)
+          (begin +polygon+ #-(and) +line-loop+)
+          (color-3ub 255 0 0)
+          (vertex-2f 0.25s0 0.25s0)
+          (color-3ub 0 255 0)
+          (vertex-2f 0.75s0 0.25s0)
+          (color-3ub 0 0 255)
+          (vertex-2f 0.75s0 0.75s0)
+          (color-3ub 255 255 255)
+          (vertex-2f 0.25s0 0.75s0)
+          (end)
+          (pop-matrix)
+          (xlib/glx:swap-buffers)
           (sleep 0.02)))
   (sleep 3))
 
 
 (defun anim/list (display window)
   (declare (ignore display window))
-  (gl:ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0)
-  (gl:clear-color 0.0s0 0.0s0 0.0s0 0.0s0)
-  (let ((list (gl:gen-lists 1)))
-    (gl:new-list list gl:+compile+)
-    (gl:begin gl:+polygon+)
-    (gl:color-3ub 255 0 0)
-    (gl:vertex-2f 0.25s0 0.25s0)
-    (gl:color-3ub 0 255 0)
-    (gl:vertex-2f 0.75s0 0.25s0)
-    (gl:color-3ub 0 0 255)
-    (gl:vertex-2f 0.75s0 0.75s0)
-    (gl:color-3ub 255 255 255)
-    (gl:vertex-2f 0.25s0 0.75s0)
-    (gl:end)
-    (glx:render)
-    (gl:end-list)
+  (ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0)
+  (clear-color 0.0s0 0.0s0 0.0s0 0.0s0)
+  (let ((list (gen-lists 1)))
+    (new-list list +compile+)
+    (begin +polygon+)
+    (color-3ub 255 0 0)
+    (vertex-2f 0.25s0 0.25s0)
+    (color-3ub 0 255 0)
+    (vertex-2f 0.75s0 0.25s0)
+    (color-3ub 0 0 255)
+    (vertex-2f 0.75s0 0.75s0)
+    (color-3ub 255 255 255)
+    (vertex-2f 0.25s0 0.75s0)
+    (end)
+    (xlib/glx:render)
+    (end-list)
 
     (loop
        repeat 361
        for angle upfrom 0.0s0 by 1.0s0
        do (progn
-            (gl:clear gl:+color-buffer-bit+)
-            (gl:push-matrix)
-            (gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
-            (gl:call-list list)
-            (gl:pop-matrix)
-            (glx:swap-buffers)
+            (clear +color-buffer-bit+)
+            (push-matrix)
+            (rotate-f angle 0.0s0 0.0s0 1.0s0)
+            (call-list list)
+            (pop-matrix)
+            (xlib/glx:swap-buffers)
             (sleep 0.02))))
   
   (sleep 3))
@@ -148,101 +145,101 @@
         (r1 (/ (- outer-radius tooth-depth) 2.0s0))
         (r2 (/ (+ outer-radius tooth-depth) 2.0s0))
         (da (/ (* 2.0s0 +pi+) teeth 4.0s0)))
-    (gl:shade-model gl:+flat+)
-    (gl:normal-3f 0.0s0 0.0s0 1.0s0)
+    (shade-model +flat+)
+    (normal-3f 0.0s0 0.0s0 1.0s0)
 
     ;; Front face.
-    (gl:begin gl:+quad-strip+)
+    (begin +quad-strip+)
     (dotimes (i (1+ teeth))
       (let ((angle (/ (* i 2.0 +pi+) teeth)))
         (declare (type single-float angle))
-        (gl:vertex-3f (* r0 (cos angle))
+        (vertex-3f (* r0 (cos angle))
                       (* r0 (sin angle))
                       (* width 0.5s0))
-        (gl:vertex-3f (* r1 (cos angle))
+        (vertex-3f (* r1 (cos angle))
                       (* r1 (sin angle))
                       (* width 0.5s0))
         (when (< i teeth)
-          (gl:vertex-3f (* r0 (cos angle))
+          (vertex-3f (* r0 (cos angle))
                         (* r0 (sin angle))
                         (* width 0.5s0))
-          (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
+          (vertex-3f (* r1 (cos (+ angle (* 3 da))))
                         (* r1 (sin (+ angle (* 3 da))))
                         (* width 0.5s0)))))
-    (gl:end)
+    (end)
 
 
     ;; Draw front sides of teeth.
-    (gl:begin gl:+quads+)
+    (begin +quads+)
     (setf da (/ (* 2.0s0 +pi+) teeth 4.0s0))
     (dotimes (i teeth)
       (let ((angle (/ (* i 2.0s0 +pi+) teeth)))
         (declare (type single-float angle))
-        (gl:vertex-3f (* r1 (cos angle))
+        (vertex-3f (* r1 (cos angle))
                       (* r1 (sin angle))
                       (* width 0.5s0))
-        (gl:vertex-3f (* r2 (cos (+ angle da)))
+        (vertex-3f (* r2 (cos (+ angle da)))
                       (* r2 (sin (+ angle da)))
                       (* width 0.5s0))
-        (gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
+        (vertex-3f (* r2 (cos (+ angle (* 2 da))))
                       (* r2 (sin (+ angle (* 2 da))))
                       (* width 0.5s0))
-        (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
+        (vertex-3f (* r1 (cos (+ angle (* 3 da))))
                       (* r1 (sin (+ angle (* 3 da))))
                       (* width 0.5s0))))
-    (gl:end)
+    (end)
 
-    (gl:normal-3f 0.0s0 0.0s0 -1.0s0)
+    (normal-3f 0.0s0 0.0s0 -1.0s0)
                  
     ;; Draw back face.
-    (gl:begin gl:+quad-strip+)
+    (begin +quad-strip+)
     (dotimes (i (1+ teeth))
       (let ((angle (/ (* i 2.0s0 +pi+) teeth)))
         (declare (type single-float angle))
-        (gl:vertex-3f (* r1 (cos angle))
+        (vertex-3f (* r1 (cos angle))
                       (* r1 (sin angle))
                       (* width -0.5s0))
-        (gl:vertex-3f (* r0 (cos angle))
+        (vertex-3f (* r0 (cos angle))
                       (* r0 (sin angle))
                       (* width -0.5s0))
         (when (< i teeth)
-          (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
+          (vertex-3f (* r1 (cos (+ angle (* 3 da))))
                         (* r1 (sin (+ angle (* 3 da))))
                         (* width -0.5s0))
-          (gl:vertex-3f (* r0 (cos angle))
+          (vertex-3f (* r0 (cos angle))
                         (* r0 (sin angle))
                         (* width 0.5s0)))))
-    (gl:end)
+    (end)
 
     ;; Draw back sides of teeth.
-    (gl:begin gl:+quads+)
+    (begin +quads+)
     (setf da (/ (* 2.0s0 +pi+) teeth 4.0s0))
     (dotimes (i teeth)
       (let ((angle (/ (* i 2.0s0 +pi+) teeth)))
         (declare (type single-float angle))
-        (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
+        (vertex-3f (* r1 (cos (+ angle (* 3 da))))
                       (* r1 (sin (+ angle (* 3 da))))
                       (* width -0.5s0))
-        (gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
+        (vertex-3f (* r2 (cos (+ angle (* 2 da))))
                       (* r2 (sin (+ angle (* 2 da))))
                       (* width -0.5s0))
-        (gl:vertex-3f (* r2 (cos (+ angle da)))
+        (vertex-3f (* r2 (cos (+ angle da)))
                       (* r2 (sin (+ angle da)))
                       (* width -0.5s0))
-        (gl:vertex-3f (* r1 (cos angle))
+        (vertex-3f (* r1 (cos angle))
                       (* r1 (sin angle))
                       (* width -0.5s0))))
-    (gl:end)
+    (end)
 
     ;; Draw outward faces of teeth.
-    (gl:begin gl:+quad-strip+)
+    (begin +quad-strip+)
     (dotimes (i teeth)
       (let ((angle (/ (* i 2.0s0 +pi+) teeth)))
         (declare (type single-float angle))
-        (gl:vertex-3f (* r1 (cos angle))
+        (vertex-3f (* r1 (cos angle))
                       (* r1 (sin angle))
                       (* width 0.5s0))
-        (gl:vertex-3f (* r1 (cos angle))
+        (vertex-3f (* r1 (cos angle))
                       (* r1 (sin angle))
                       (* width -0.5s0))
         (let* ((u (- (* r2 (cos (+ angle da))) (* r1 (cos angle))))
@@ -250,118 +247,118 @@
                (len (sqrt (+ (* u u) (* v v)))))
           (setf u (/ u len)
                 v (/ v len))
-          (gl:normal-3f v u 0.0s0)
-          (gl:vertex-3f (* r2 (cos (+ angle da)))
+          (normal-3f v u 0.0s0)
+          (vertex-3f (* r2 (cos (+ angle da)))
                         (* r2 (sin (+ angle da)))
                         (* width 0.5s0))
-          (gl:vertex-3f (* r2 (cos (+ angle da)))
+          (vertex-3f (* r2 (cos (+ angle da)))
                         (* r2 (sin (+ angle da)))
                         (* width -0.5s0))
-          (gl:normal-3f (cos angle) (sin angle) 0.0s0)
-          (gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
+          (normal-3f (cos angle) (sin angle) 0.0s0)
+          (vertex-3f (* r2 (cos (+ angle (* 2 da))))
                         (* r2 (sin (+ angle (* 2 da))))
                         (* width 0.5s0))
-          (gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
+          (vertex-3f (* r2 (cos (+ angle (* 2 da))))
                         (* r2 (sin (+ angle (* 2 da))))
                         (* width -0.5s0))
           (setf u (- (* r1 (cos (+ angle (* 3 da)))) (* r2 (cos (+ angle (* 2 da)))))
                 v (- (* r1 (sin (+ angle (* 3 da)))) (* r2 (sin (+ angle (* 2 da))))))
-          (gl:normal-3f v (- u) 0.0s0)
-          (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
+          (normal-3f v (- u) 0.0s0)
+          (vertex-3f (* r1 (cos (+ angle (* 3 da))))
                         (* r1 (sin (+ angle (* 3 da))))
                         (* width 0.5s0))
-          (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
+          (vertex-3f (* r1 (cos (+ angle (* 3 da))))
                         (* r1 (sin (+ angle (* 3 da))))
                         (* width -0.5s0))
-          (gl:normal-3f (cos angle) (sin angle) 0.0s0))))
+          (normal-3f (cos angle) (sin angle) 0.0s0))))
 
-    (gl:vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width 0.5s0))
-    (gl:vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width -0.5s0))
+    (vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width 0.5s0))
+    (vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width -0.5s0))
 
-    (gl:end)
+    (end)
 
-    (gl:shade-model gl:+smooth+)
+    (shade-model +smooth+)
                  
     ;; Draw inside radius cylinder.
-    (gl:begin gl:+quad-strip+)
+    (begin +quad-strip+)
     (dotimes (i (1+ teeth))
       (let ((angle (/ (* i 2.0s0 +pi+) teeth)))
         (declare (type single-float angle))
-        (gl:normal-3f (- (cos angle)) (- (sin angle)) 0.0s0)
-        (gl:vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5s0))
-        (gl:vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5s0))))
-    (gl:end)))
+        (normal-3f (- (cos angle)) (- (sin angle)) 0.0s0)
+        (vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5s0))
+        (vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5s0))))
+    (end)))
 
 
 (defun draw (gear-1 gear-2 gear-3 view-rotx view-roty view-rotz angle)
-  (gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
+  (clear (logior +color-buffer-bit+ +depth-buffer-bit+))
 
-  (gl:push-matrix)
-  (gl:rotate-f view-rotx 1.0s0 0.0s0 0.0s0)
-  (gl:rotate-f view-roty 0.0s0 1.0s0 0.0s0)
-  (gl:rotate-f view-rotz 0.0s0 0.0s0 1.0s0)
+  (push-matrix)
+  (rotate-f view-rotx 1.0s0 0.0s0 0.0s0)
+  (rotate-f view-roty 0.0s0 1.0s0 0.0s0)
+  (rotate-f view-rotz 0.0s0 0.0s0 1.0s0)
 
-  (gl:push-matrix)
-  (gl:translate-f -3.0s0 -2.0s0 0.0s0)
-  (gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
-  (gl:call-list gear-1)
-  (gl:pop-matrix)
+  (push-matrix)
+  (translate-f -3.0s0 -2.0s0 0.0s0)
+  (rotate-f angle 0.0s0 0.0s0 1.0s0)
+  (call-list gear-1)
+  (pop-matrix)
 
-  (gl:push-matrix)
-  (gl:translate-f 3.1s0 -2.0s0 0.0s0)
-  (gl:rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0)
-  (gl:call-list gear-2)
-  (gl:pop-matrix)
+  (push-matrix)
+  (translate-f 3.1s0 -2.0s0 0.0s0)
+  (rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0)
+  (call-list gear-2)
+  (pop-matrix)
 
-  (gl:push-matrix)
-  (gl:translate-f -3.1s0 4.2s0 0.0s0)
-  (gl:rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0)
-  (gl:call-list gear-3)
-  (gl:pop-matrix)
+  (push-matrix)
+  (translate-f -3.1s0 4.2s0 0.0s0)
+  (rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0)
+  (call-list gear-3)
+  (pop-matrix)
 
-  (gl:pop-matrix))
+  (pop-matrix))
 
 
 (defun reshape (width height)
-  (gl:viewport 0 0 width height)
+  (viewport 0 0 width height)
   (let ((h (coerce (/ height width) 'double-float)))
-    (gl:matrix-mode gl:+projection+)
-    (gl:load-identity)
-    (gl:frustum -1.0d0 1.0d0 (- h) h 5.0d0 60.0d0))
+    (matrix-mode +projection+)
+    (load-identity)
+    (frustum -1.0d0 1.0d0 (- h) h 5.0d0 60.0d0))
 
-  (gl:matrix-mode gl:+modelview+)
-  (gl:load-identity)
-  (gl:translate-f 0.0s0 0.0s0 -40.0s0))
+  (matrix-mode +modelview+)
+  (load-identity)
+  (translate-f 0.0s0 0.0s0 -40.0s0))
 
              
 (defun init ()
   (let (gear-1 gear-2 gear-3)
-    ;;(gl:light-fv gl:+light0+ gl:+position+ '(5.0s0 5.0s0 10.0s0 0.0s0))
-    ;;(gl:enable gl:+cull-face+)
-    ;;(gl:enable gl:+lighting+)
-    ;;(gl:enable gl:+light0+)
-    ;;(gl:enable gl:+depth-test+)
+    ;;(light-fv +light0+ +position+ '(5.0s0 5.0s0 10.0s0 0.0s0))
+    ;;(enable +cull-face+)
+    ;;(enable +lighting+)
+    ;;(enable +light0+)
+    ;;(enable +depth-test+)
 
     ;; Make the gears.
-    (setf gear-1 (gl:gen-lists 1))
-    (gl:new-list gear-1 gl:+compile+)
-    (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
+    (setf gear-1 (gen-lists 1))
+    (new-list gear-1 +compile+)
+    (material-fv +front+ +ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
     (gear 1.0s0 4.0s0 1.0s0 20 0.7s0)
-    (gl:end-list)
+    (end-list)
 
-    (setf gear-2 (gl:gen-lists 1))
-    (gl:new-list gear-2 gl:+compile+)
-    (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0))
+    (setf gear-2 (gen-lists 1))
+    (new-list gear-2 +compile+)
+    (material-fv +front+ +ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0))
     (gear 0.5s0 2.0s0 2.0s0 10 0.7s0)
-    (gl:end-list)
+    (end-list)
 
-    (setf gear-3 (gl:gen-lists 1))
-    (gl:new-list gear-3 gl:+compile+)
-    (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0))
+    (setf gear-3 (gen-lists 1))
+    (new-list gear-3 +compile+)
+    (material-fv +front+ +ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0))
     (gear 1.3s0 2.0s0 0.5s0 10 0.7s0)
-    (gl:end-list)
+    (end-list)
 
-    ;;(gl:enable gl:+normalize+)
+    ;;(enable +normalize+)
 
     (values gear-1 gear-2 gear-3)))
 
@@ -369,31 +366,31 @@
 (defun gears* (display window)
   (declare (ignore display window))
 
-  (gl:enable gl:+cull-face+)
-  (gl:enable gl:+lighting+)
-  (gl:enable gl:+light0+)
-  (gl:enable gl:+normalize+)
-  (gl:enable gl:+depth-test+)
+  (enable +cull-face+)
+  (enable +lighting+)
+  (enable +light0+)
+  (enable +normalize+)
+  (enable +depth-test+)
 
   (reshape 300 300)
 
-  ;;(gl:light-fv gl:+light0+ gl:+position+ #(5.0s0 5.0s0 10.0s0 0.0s0))
+  ;;(light-fv +light0+ +position+ #(5.0s0 5.0s0 10.0s0 0.0s0))
 
   (let (list)
     (declare (ignore list))
     #-(and)
     (progn
-      (setf list (gl:gen-lists 1))
-      (gl:new-list list gl:+compile+)
-      ;;(gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
+      (setf list (gen-lists 1))
+      (new-list list +compile+)
+      ;;(material-fv +front+ +ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
       (gear 1.0s0 4.0s0 1.0s0 20 0.7s0)
-      (glx:render)
-      (gl:end-list))
+      (xlib/glx:render)
+      (end-list))
 
 
     (loop
        ;;for angle from 0.0s0 below 361.0s0 by 1.0s0
-       with angle single-float = 0.0s0
+       with angle of-type single-float = 0.0s0
        with dt = 0.004s0
        repeat 2500
        do (progn
@@ -402,39 +399,39 @@
             (when (< 3600.0s0 angle)
               (decf angle 3600.0s0))
 
-            (gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
+            (clear (logior +color-buffer-bit+ +depth-buffer-bit+))
 
-            (gl:push-matrix)
-            (gl:rotate-f 20.0s0 0.0s0 1.0s0 0.0s0)
+            (push-matrix)
+            (rotate-f 20.0s0 0.0s0 1.0s0 0.0s0)
 
 
-            (gl:push-matrix)
-            (gl:translate-f -3.0s0 -2.0s0 0.0s0)
-            (gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
-            (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
+            (push-matrix)
+            (translate-f -3.0s0 -2.0s0 0.0s0)
+            (rotate-f angle 0.0s0 0.0s0 1.0s0)
+            (material-fv +front+ +ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
             (gear 1.0s0 4.0s0 1.0s0 20 0.7s0)
-            (gl:pop-matrix)
+            (pop-matrix)
 
             
-            (gl:push-matrix)
-            (gl:translate-f 3.1s0 -2.0s0 0.0s0)
-            (gl:rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0)
-            (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0))
+            (push-matrix)
+            (translate-f 3.1s0 -2.0s0 0.0s0)
+            (rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0)
+            (material-fv +front+ +ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0))
             (gear 0.5s0 2.0s0 2.0s0 10 0.7s0)
-            (gl:pop-matrix)
+            (pop-matrix)
 
 
-            (gl:push-matrix)
-            (gl:translate-f -3.1s0 4.2s0 0.0s0)
-            (gl:rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0)
-            (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0))
+            (push-matrix)
+            (translate-f -3.1s0 4.2s0 0.0s0)
+            (rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0)
+            (material-fv +front+ +ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0))
             (gear 1.3s0 2.0s0 0.5s0 10 0.7s0)
-            (gl:pop-matrix)
+            (pop-matrix)
 
 
-            (gl:pop-matrix)
+            (pop-matrix)
 
-            (glx:swap-buffers)
+            (xlib/glx:swap-buffers)
             ;;(sleep 0.025)
             )))
   
@@ -472,7 +469,7 @@
          (decf angle 3600.0s0))
 
        (draw gear-1 gear-2 gear-3 view-rotx view-roty view-rotz angle)
-       (glx:swap-buffers)
+       (xlib/glx:swap-buffers)
        
        (incf frames)
 
diff --git a/src/clx/demo/hello.lisp b/src/clx/demo/hello.lisp
index 8ede2221f134829c59104e50a5a6f3c3368ed1ab..a3fbd88d827042a80aaa16833d3560c2892aa56e 100644
--- a/src/clx/demo/hello.lisp
+++ b/src/clx/demo/hello.lisp
@@ -1,8 +1,5 @@
 ;;; -*- Mode:Lisp; Syntax: Common-lisp; Package:XLIB; Base:10; Lowercase: Yes -*-
 
-#+cmu
-(ext:file-comment "$Id: hello.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (defun hello-world (host &rest args &key (string "Hello World") (font "fixed"))
diff --git a/src/clx/demo/mandel.lisp b/src/clx/demo/mandel.lisp
index f094b4a9c3cde455117298907038bd1694061931..008797417481e7ef2aa3e516691ac21be84664a2 100644
--- a/src/clx/demo/mandel.lisp
+++ b/src/clx/demo/mandel.lisp
@@ -1,11 +1,8 @@
-#+cmu
-(ext:file-comment "$Id: mandel.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
-
-(defpackage "XMANDEL"
+(defpackage #:xlib-demo/mandel
   (:use "CL")
   (:export "NEW-WINDOW" "EVENT-LOOP"))
 
-(in-package "XMANDEL")
+(in-package #:xlib-demo/mandel)
 
 (defvar *display* (xlib:open-default-display))
 (defvar *screen* (xlib:display-default-screen *display*))
diff --git a/src/clx/dep-allegro.lisp b/src/clx/dep-allegro.lisp
index 37def9aca6e70714d54a0ae344baf035fbc297df..365d279df96df883dec1789b978a5d508ef089f2 100644
--- a/src/clx/dep-allegro.lisp
+++ b/src/clx/dep-allegro.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: dep-allegro.lisp,v 1.2 2009/06/17 18:22:45 rtoy Rel $")
-
 (in-package :xlib)
 
 (proclaim '(declaration array-register))
@@ -866,7 +863,7 @@
   ;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
   `(let ((,var (list ,@elements)))
      (declare (type cons ,var)
-	      #+clx-ansi-common-lisp (dynamic-extent ,var))
+              (dynamic-extent ,var))
      ,@body))
 
 #-lispm
@@ -877,7 +874,7 @@
   ;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
   `(let ((,var (list* ,@elements)))
      (declare (type cons ,var)
-	      #+clx-ansi-common-lisp (dynamic-extent ,var))
+              (dynamic-extent ,var))
      ,@body))
 
 (declaim (inline buffer-replace))
@@ -1033,12 +1030,10 @@
       (apply #'x-cerror "Ignore" error-key :display display :error-key error-key key-vals)
       (apply #'x-error error-key :display display :error-key error-key key-vals)))
 
-#+(or clx-ansi-common-lisp excl lcl3.0 (and CMU mp))
 (defun x-error (condition &rest keyargs)
   (declare (dynamic-extent keyargs))
   (apply #'error condition keyargs))
 
-#+(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))
@@ -1061,33 +1056,8 @@
 	(ext::disable-clx-event-handling disp)))
     (error condx)))
 
-#-(or lispm ansi-common-lisp excl lcl3.0 CMU sbcl)
-(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 CMU sbcl)
-(defun x-cerror (proceed-format-string condition &rest keyargs)
-  (cerror proceed-format-string "X-Error: ~a"
-	 (princ-to-string (apply #'make-condition condition keyargs))))
-
-;; version 15 of Pitman error handling defines the syntax for define-condition to be:
-;; DEFINE-CONDITION name (parent-type) [({slot}*) {option}*]
-;; Where option is one of: (:documentation doc-string) (:conc-name symbol-or-string)
-;; or (:report exp)
-
-#+(and excl (not clx-ansi-common-lisp))
-(defmacro define-condition (name parent-types &optional slots &rest args)
-  `(excl::define-condition
-     ,name (,(first parent-types))
-     ,(mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
-	      slots)
-     ,@args))
-
-#+(or clx-ansi-common-lisp excl lcl3.0 CMU sbcl)
 (define-condition x-error (error) ())
 
-
 
 ;;-----------------------------------------------------------------------------
 ;;  HOST hacking
@@ -1276,38 +1246,6 @@ Returns a list of (host display-number screen protocol)."
   (setq *temp-gcontext-cache* nil)
   nil)
 
-
-
-;;-----------------------------------------------------------------------------
-;; WITH-STANDARD-IO-SYNTAX equivalent, used in (SETF WM-COMMAND)
-;;-----------------------------------------------------------------------------
-
-#-(or clx-ansi-common-lisp Genera CMU sbcl)
-(defun with-standard-io-syntax-function (function)
-  (declare #+lispm
-	   (sys:downward-funarg function))
-  (let ((*package* (find-package :user))
-	(*print-array* t)
-	(*print-base* 10)
-	(*print-case* :upcase)
-	(*print-circle* nil)
-	(*print-escape* t)
-	(*print-gensym* t)
-	(*print-length* nil)
-	(*print-level* nil)
-	(*print-pretty* nil)
-	(*print-radix* nil)
-	(*read-base* 10)
-	(*read-default-float-format* 'single-float)
-	(*read-suppress* nil)
-	)
-    (funcall function)))
-
-#-(or clx-ansi-common-lisp Genera CMU sbcl)
-(defmacro with-standard-io-syntax (&body body)
-  `(flet ((.with-standard-io-syntax-body. () ,@body))
-     (with-standard-io-syntax-function #'.with-standard-io-syntax-body.)))
-
 
 ;;-----------------------------------------------------------------------------
 ;; DEFAULT-KEYSYM-TRANSLATE
@@ -1324,7 +1262,6 @@ Returns a list of (host display-number screen protocol)."
 ;;; When MASK-MODIFIERS is missing, all other modifiers are ignored.
 ;;; In ambiguous cases, the most specific translation is used.
 
-#-(or (and clx-ansi-common-lisp (not lispm) (not allegro)) CMU sbcl)
 (defun default-keysym-translate (display state object)
   (declare (type display display)
 	   (type card16 state)
diff --git a/src/clx/dep-lispworks.lisp b/src/clx/dep-lispworks.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..6adcc5aefc35e08c7e362df30e6ab9d3e33d3472
--- /dev/null
+++ b/src/clx/dep-lispworks.lisp
@@ -0,0 +1,1407 @@
+;;; -*- Mode: Lisp; Package: Xlib; Log: clx.log -*-
+
+;; This file contains some of the system dependent code for CLX
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; 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.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+#-(or lispworks6 lispworks7)
+(error "Sorry, your ~S lisp version ~S is not currently supported.  ~
+        Patches are welcome."
+       (lisp-implementation-type) (lisp-implementation-version))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (require "comm"))
+
+(proclaim '(declaration array-register))
+
+;;; The size of the output buffer.  Must be a multiple of 4.
+(defparameter *output-buffer-size* 8192)
+
+;;; Number of seconds to wait for a reply to a server request
+(defparameter *reply-timeout* nil)
+
+(defconstant +word-0+ 0)
+(defconstant +word-1+ 1)
+
+(defconstant +long-0+ 0)
+(defconstant +long-1+ 1)
+(defconstant +long-2+ 2)
+(defconstant +long-3+ 3)
+
+;;; Set some compiler-options for often used code
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (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.")
+  (defconstant +buffer-debug+ #+clx-debugging 2 #-clx-debugging 1
+    "Debug compiler option for buffer code>")
+  (defun declare-bufmac ()
+    `(declare (optimize
+	       (speed ,+buffer-speed+)
+	       (safety ,+buffer-safety+)
+	       (debug ,+buffer-debug+))))
+  ;; It's my impression that in lucid there's some way to make a
+  ;; declaration called fast-entry or something that causes a function
+  ;; to not do some checking on args. Sadly, we have no lucid manuals
+  ;; here.  If such a declaration is available, it would be a good
+  ;; idea to make it here when +buffer-speed+ is 3 and +buffer-safety+
+  ;; is 0.
+  (defun declare-buffun ()
+    `(declare (optimize
+	       (speed ,+buffer-speed+)
+	       (safety ,+buffer-safety+)
+	       (debug ,+buffer-debug+)))))
+
+(declaim (inline card8->int8 int8->card8
+		 card16->int16 int16->card16
+		 card32->int32 int32->card32))
+
+(defun card8->int8 (x)
+  (declare (type card8 x))
+  (declare (clx-values int8))
+  #.(declare-buffun)
+  (the int8 (if (logbitp 7 x)
+		(the int8 (- x #x100))
+                x)))
+
+(defun int8->card8 (x)
+  (declare (type int8 x))
+  (declare (clx-values card8))
+  #.(declare-buffun)
+  (the card8 (ldb (byte 8 0) x)))
+
+(defun card16->int16 (x)
+  (declare (type card16 x))
+  (declare (clx-values int16))
+  #.(declare-buffun)
+  (the int16 (if (logbitp 15 x)
+		 (the int16 (- x #x10000))
+		 x)))
+
+(defun int16->card16 (x)
+  (declare (type int16 x))
+  (declare (clx-values card16))
+  #.(declare-buffun)
+  (the card16 (ldb (byte 16 0) x)))
+
+(defun card32->int32 (x)
+  (declare (type card32 x))
+  (declare (clx-values int32))
+  #.(declare-buffun)
+  (the int32 (if (logbitp 31 x)
+		 (the int32 (- x #x100000000))
+		 x)))
+
+(defun int32->card32 (x)
+  (declare (type int32 x))
+  (declare (clx-values card32))
+  #.(declare-buffun)
+  (the card32 (ldb (byte 32 0) x)))
+
+(declaim (inline aref-card8 aset-card8 aref-int8 aset-int8))
+
+(defun aref-card8 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (clx-values card8))
+  #.(declare-buffun)
+  (the card8 (aref a i)))
+
+(defun aset-card8 (v a i)
+  (declare (type card8 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a i) v))
+
+(defun aref-int8 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (clx-values int8))
+  #.(declare-buffun)
+  (card8->int8 (aref a i)))
+
+(defun aset-int8 (v a i)
+  (declare (type int8 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a i) (int8->card8 v)))
+
+(defun aref-card16 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (clx-values card16))
+  #.(declare-buffun)
+  (the card16
+       (logior (the card16
+		    (ash (the card8 (aref a (index+ i +word-1+))) 8))
+	       (the card8
+		    (aref a (index+ i +word-0+))))))
+
+(defun aset-card16 (v a i)
+  (declare (type card16 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a (index+ i +word-1+)) (the card8 (ldb (byte 8 8) v))
+	(aref a (index+ i +word-0+)) (the card8 (ldb (byte 8 0) v)))
+  v)
+
+(defun aref-int16 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (clx-values int16))
+  #.(declare-buffun)
+  (the int16
+       (logior (the int16
+		    (ash (the int8 (aref-int8 a (index+ i +word-1+))) 8))
+	       (the card8
+		    (aref a (index+ i +word-0+))))))
+
+(defun aset-int16 (v a i)
+  (declare (type int16 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a (index+ i +word-1+)) (the card8 (ldb (byte 8 8) v))
+	(aref a (index+ i +word-0+)) (the card8 (ldb (byte 8 0) v)))
+  v)
+
+(defun aref-card32 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (clx-values card32))
+  #.(declare-buffun)
+  (the card32
+       (logior (the card32
+		    (ash (the card8 (aref a (index+ i +long-3+))) 24))
+	       (the card29
+		    (ash (the card8 (aref a (index+ i +long-2+))) 16))
+	       (the card16
+		    (ash (the card8 (aref a (index+ i +long-1+))) 8))
+	       (the card8
+		    (aref a (index+ i +long-0+))))))
+
+(defun aset-card32 (v a i)
+  (declare (type card32 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a (index+ i +long-3+)) (the card8 (ldb (byte 8 24) v))
+	(aref a (index+ i +long-2+)) (the card8 (ldb (byte 8 16) v))
+	(aref a (index+ i +long-1+)) (the card8 (ldb (byte 8 8) v))
+	(aref a (index+ i +long-0+)) (the card8 (ldb (byte 8 0) v)))
+  v)
+
+(defun aref-int32 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (clx-values int32))
+  #.(declare-buffun)
+  (the int32
+       (logior (the int32
+		    (ash (the int8 (aref-int8 a (index+ i +long-3+))) 24))
+	       (the card29
+		    (ash (the card8 (aref a (index+ i +long-2+))) 16))
+	       (the card16
+		    (ash (the card8 (aref a (index+ i +long-1+))) 8))
+	       (the card8
+		    (aref a (index+ i +long-0+))))))
+
+(defun aset-int32 (v a i)
+  (declare (type int32 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a (index+ i +long-3+)) (the card8 (ldb (byte 8 24) v))
+	(aref a (index+ i +long-2+)) (the card8 (ldb (byte 8 16) v))
+	(aref a (index+ i +long-1+)) (the card8 (ldb (byte 8 8) v))
+	(aref a (index+ i +long-0+)) (the card8 (ldb (byte 8 0) v)))
+  v)
+
+(defun aref-card29 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (clx-values card29))
+  #.(declare-buffun)
+  (the card29
+       (logior (the card29
+		    (ash (the card8 (aref a (index+ i +long-3+))) 24))
+	       (the card29
+		    (ash (the card8 (aref a (index+ i +long-2+))) 16))
+	       (the card16
+		    (ash (the card8 (aref a (index+ i +long-1+))) 8))
+	       (the card8
+		    (aref a (index+ i +long-0+))))))
+
+(defun aset-card29 (v a i)
+  (declare (type card29 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a (index+ i +long-3+)) (the card8 (ldb (byte 8 24) v))
+	(aref a (index+ i +long-2+)) (the card8 (ldb (byte 8 16) v))
+	(aref a (index+ i +long-1+)) (the card8 (ldb (byte 8 8) v))
+	(aref a (index+ i +long-0+)) (the card8 (ldb (byte 8 0) v)))
+  v)
+
+(defsetf aref-card8 (a i) (v)
+  `(aset-card8 ,v ,a ,i))
+
+(defsetf aref-int8 (a i) (v)
+  `(aset-int8 ,v ,a ,i))
+
+(defsetf aref-card16 (a i) (v)
+  `(aset-card16 ,v ,a ,i))
+
+(defsetf aref-int16 (a i) (v)
+  `(aset-int16 ,v ,a ,i))
+
+(defsetf aref-card32 (a i) (v)
+  `(aset-card32 ,v ,a ,i))
+
+(defsetf aref-int32 (a i) (v)
+  `(aset-int32 ,v ,a ,i))
+
+(defsetf aref-card29 (a i) (v)
+  `(aset-card29 ,v ,a ,i))
+
+;;; Other random conversions
+
+(defun rgb-val->card16 (value)
+  ;; Short floats are good enough
+  (declare (type rgb-val value))
+  (declare (clx-values card16))
+  #.(declare-buffun)
+  ;; Convert VALUE from float to card16
+  (the card16 (values (round (the rgb-val value) #.(/ 1.0s0 #xffff)))))
+
+(defun card16->rgb-val (value)
+  ;; Short floats are good enough
+  (declare (type card16 value))
+  (declare (clx-values short-float))
+  #.(declare-buffun)
+  ;; Convert VALUE from card16 to float
+  (the short-float (* (the card16 value) #.(/ 1.0s0 #xffff))))
+
+(defun radians->int16 (value)
+  ;; Short floats are good enough
+  (declare (type angle value))
+  (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 (clx-values short-float))
+  #.(declare-buffun)
+  (the short-float (* (the int16 value) #.(coerce (/ pi 180.0 64.0) 'short-float))))
+
+;;; This overrides the (probably incorrect) definition in clx.lisp.  Since PI
+;;; is irrational, there can't be a precise rational representation.  In
+;;; particular, the different float approximations will always be /=.  This
+;;; causes problems with type checking, because people might compute an
+;;; argument in any precision.  What we do is discard all the excess precision
+;;; in the value, and see if the protocol encoding falls in the desired range
+;;; (64'ths of a degree.)
+;;;
+(deftype angle () '(satisfies anglep))
+
+(defun anglep (x)
+  (and (typep x 'real)
+       (<= (* -360 64) (radians->int16 x) (* 360 64))))
+
+
+;;-----------------------------------------------------------------------------
+;; Character transformation
+;;-----------------------------------------------------------------------------
+
+;;; This stuff transforms chars to ascii codes in card8's and back.
+;;; You might have to hack it a little to get it to work for your machine.
+
+(declaim (inline char->card8 card8->char))
+
+(macrolet ((char-translators ()
+	     (let ((alist
+		     `(;; The normal ascii codes for the control characters.
+		       ,@`((#\Return . 13)
+			   (#\Linefeed . 10)
+			   (#\Rubout . 127)
+			   (#\Page . 12)
+			   (#\Tab . 9)
+			   (#\Backspace . 8)
+			   (#\Newline . 10)
+			   (#\Space . 32))
+		       ;; The rest of the common lisp charater set with the normal
+		       ;; ascii codes for them.
+		       (#\! . 33) (#\" . 34) (#\# . 35) (#\$ . 36)
+		       (#\% . 37) (#\& . 38) (#\' . 39) (#\( . 40)
+		       (#\) . 41) (#\* . 42) (#\+ . 43) (#\, . 44)
+		       (#\- . 45) (#\. . 46) (#\/ . 47) (#\0 . 48)
+		       (#\1 . 49) (#\2 . 50) (#\3 . 51) (#\4 . 52)
+		       (#\5 . 53) (#\6 . 54) (#\7 . 55) (#\8 . 56)
+		       (#\9 . 57) (#\: . 58) (#\; . 59) (#\< . 60)
+		       (#\= . 61) (#\> . 62) (#\? . 63) (#\@ . 64)
+		       (#\A . 65) (#\B . 66) (#\C . 67) (#\D . 68)
+		       (#\E . 69) (#\F . 70) (#\G . 71) (#\H . 72)
+		       (#\I . 73) (#\J . 74) (#\K . 75) (#\L . 76)
+		       (#\M . 77) (#\N . 78) (#\O . 79) (#\P . 80)
+		       (#\Q . 81) (#\R . 82) (#\S . 83) (#\T . 84)
+		       (#\U . 85) (#\V . 86) (#\W . 87) (#\X . 88)
+		       (#\Y . 89) (#\Z . 90) (#\[ . 91) (#\\ . 92)
+		       (#\] . 93) (#\^ . 94) (#\_ . 95) (#\` . 96)
+		       (#\a . 97) (#\b . 98) (#\c . 99) (#\d . 100)
+		       (#\e . 101) (#\f . 102) (#\g . 103) (#\h . 104)
+		       (#\i . 105) (#\j . 106) (#\k . 107) (#\l . 108)
+		       (#\m . 109) (#\n . 110) (#\o . 111) (#\p . 112)
+		       (#\q . 113) (#\r . 114) (#\s . 115) (#\t . 116)
+		       (#\u . 117) (#\v . 118) (#\w . 119) (#\x . 120)
+		       (#\y . 121) (#\z . 122) (#\{ . 123) (#\| . 124)
+		       (#\} . 125) (#\~ . 126))))
+
+	       (cond ((dolist (pair alist nil)
+			(when (not (= (char-code (car pair)) (cdr pair)))
+			  (return t)))
+
+		      `(progn
+			 (defconstant *char-to-card8-translation-table*
+                           ',(let ((array (make-array
+                                           (let ((max-char-code 255))
+                                             (dolist (pair alist)
+                                               (setq max-char-code
+                                                     (max max-char-code
+                                                          (char-code (car pair)))))
+                                             (1+ max-char-code))
+                                           :element-type 'card8)))
+                               (dotimes (i (length array))
+                                 (setf (aref array i) (mod i 256)))
+                               (dolist (pair alist)
+                                 (setf (aref array (char-code (car pair)))
+                                       (cdr pair)))
+                               array))
+
+			 (defconstant *card8-to-char-translation-table*
+                           ',(let ((array (make-array 256)))
+                               (dotimes (i (length array))
+                                 (setf (aref array i) (code-char i)))
+                               (dolist (pair alist)
+                                 (setf (aref array (cdr pair)) (car pair)))
+                               array))
+
+                         (progn
+  			   (defun char->card8 (char)
+			     (declare (type base-char char))
+			     #.(declare-buffun)
+			     (the card8 (aref (the (simple-array card8 (*))
+						   *char-to-card8-translation-table*)
+					      (the array-index (char-code char)))))
+
+			   (defun card8->char (card8)
+			     (declare (type card8 card8))
+			     #.(declare-buffun)
+			     (the base-char
+				  (or (aref (the simple-vector *card8-to-char-translation-table*)
+					    card8)
+				      (error "Invalid CHAR code ~D." card8))))
+			   )
+
+                         (dotimes (i 256)
+			   (unless (= i (char->card8 (card8->char i)))
+			     (warn "The card8->char mapping is not invertible through char->card8.  Info:~%~S"
+				   (list i
+					 (card8->char i)
+					 (char->card8 (card8->char i))))
+			     (return nil)))
+
+			 (dotimes (i (length *char-to-card8-translation-table*))
+			   (let ((char (code-char i)))
+			     (unless (eql char (card8->char (char->card8 char)))
+			       (warn "The char->card8 mapping is not invertible through card8->char.  Info:~%~S"
+				     (list char
+					   (char->card8 char)
+					   (card8->char (char->card8 char))))
+			       (return nil))))))
+		     (t
+		      `(progn
+			 (defun char->card8 (char)
+			   (declare (type base-char char))
+			   #.(declare-buffun)
+			   (the card8 (char-code char)))
+
+			 (defun card8->char (card8)
+			   (declare (type card8 card8))
+			   #.(declare-buffun)
+			   (the base-char (code-char card8)))
+			 ))))))
+  (char-translators))
+
+
+;;-----------------------------------------------------------------------------
+;; Process Locking
+;;
+;;	Common-Lisp doesn't provide process locking primitives, so we define
+;;	our own here, based on Zetalisp primitives.  Holding-Lock is very
+;;	similar to with-lock on The TI Explorer, and a little more efficient
+;;	than with-process-lock on a Symbolics.
+;;-----------------------------------------------------------------------------
+
+;;; MAKE-PROCESS-LOCK: Creating a process lock.
+
+(defun make-process-lock (name)
+  (mp:make-lock :name name))
+
+;;; HOLDING-LOCK: Execute a body of code with a lock held.
+
+;;; The holding-lock macro takes a timeout keyword argument.  EVENT-LISTEN
+;;; passes its timeout to the holding-lock macro, so any timeout you want to
+;;; work for event-listen you should do for holding-lock.
+
+;; If you're not sharing DISPLAY objects within a multi-processing
+;; shared-memory environment, this is sufficient
+
+(defmacro holding-lock ((lock display &optional (whostate "CLX wait") &key timeout) &body body)
+  (declare (ignore display))
+  `(mp:with-lock (,lock ,whostate ,timeout)
+     ,@body))
+
+;;; WITHOUT-ABORTS
+
+;;; If you can inhibit asynchronous keyboard aborts inside the body of this
+;;; macro, then it is a good idea to do this.  This macro is wrapped around
+;;; request writing and reply reading to ensure that requests are atomically
+;;; written and replies are atomically read from the stream.
+
+(defmacro without-aborts (&body body)
+  `(progn ,@body))
+
+;;; PROCESS-BLOCK: Wait until a given predicate returns a non-NIL value.
+;;; Caller guarantees that PROCESS-WAKEUP will be called after the predicate's
+;;; value changes.
+
+(defun process-block (whostate predicate &rest predicate-args)
+  (declare (dynamic-extent predicate-args))
+  (apply #'mp:process-wait whostate predicate predicate-args))
+
+;;; PROCESS-WAKEUP: Check some other process' wait function.
+
+(declaim (inline process-wakeup))
+
+(defun process-wakeup (process)
+  (declare (ignore process))
+  (mp:process-allow-scheduling))
+
+;;; CURRENT-PROCESS: Return the current process object for input locking and
+;;; for calling PROCESS-WAKEUP.
+
+(declaim (inline current-process))
+
+(defun current-process ()
+  (mp:get-current-process))
+
+;;; WITHOUT-INTERRUPTS -- provide for atomic operations.
+
+(defvar *without-interrupts-sic-lock*
+  (mp:make-lock :name "Lock simulating *without-interrupts*"))
+
+(defmacro without-interrupts (&body body)
+  `(mp:with-lock (*without-interrupts-sic-lock*)
+     ,@body))
+
+;;; CONDITIONAL-STORE:
+
+(defvar *conditional-store-lock*
+  (mp:make-lock :name "Conditional store lock"))
+
+(defmacro conditional-store (place old-value new-value)
+  `(mp:with-lock (*conditional-store-lock*)
+     (cond ((eq ,place ,old-value)
+            (setf ,place ,new-value)
+            t))))
+
+;;;----------------------------------------------------------------------------
+;;; IO Error Recovery
+;;;	All I/O operations are done within a WRAP-BUF-OUTPUT macro.
+;;;	It prevents multiple mindless errors when the network craters.
+;;;
+;;;----------------------------------------------------------------------------
+
+(defmacro wrap-buf-output ((buffer) &body body)
+  ;; Error recovery wrapper
+  `(unless (buffer-dead ,buffer)
+     ,@body))
+
+(defmacro wrap-buf-input ((buffer) &body body)
+  (declare (ignore buffer))
+  ;; Error recovery wrapper
+  `(progn ,@body))
+
+
+;;;----------------------------------------------------------------------------
+;;; System dependent IO primitives
+;;;	Functions for opening, reading writing forcing-output and closing
+;;;	the stream to the server.
+;;;----------------------------------------------------------------------------
+
+;;; OPEN-X-STREAM - create a stream for communicating to the appropriate X
+;;; server
+
+;;; NOTE: OPEN-UNIX-STREAM and HOST-ADDRESS implementation are borrowed from
+;;; http://www.bew.org.uk/Lisp/
+;;; Original license of UNIX Domain Socket support for LispWorks:
+;;;
+;;; Copyright 2001, Barry Wilkes <bew@bcs.org.uk>
+;;; uk.org.bew.comm-ext, an extension to the network interface for LispWorks/Linux
+;;;
+;;; uk.org.bew.comm-ext is licensed under the terms of the Lisp Lesser GNU
+;;; Public License (http://opensource.franz.com/preamble.html), known as
+;;; the LLGPL.  The LLGPL consists of a preamble (see above URL) and the
+;;; LGPL.  Where these conflict, the preamble takes precedence.
+;;; uk.org.bew.comm-ext is referenced in the preamble as the "LIBRARY."
+
+;;; NOTE: %CREATE-UNIX-DOMAIN-SOCKET implementation ideas are borrowed from
+;;; http://common-lisp.net/project/cl-net-snmp/lispworks.html
+;;; Original license of LispWorks-UDP:
+;;;
+;;; The MIT License
+;;;
+;;; Copyright (c) 2007-2008, Chun Tian (binghe)
+;;;
+;;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;;; of this software and associated documentation files (the "Software"), to deal
+;;; in the Software without restriction, including without limitation the rights
+;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;;; copies of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be included in
+;;; all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+;;; THE SOFTWARE.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant +max-unix-path-length+
+    #+darwin 104 #-darwin 108))
+
+(fli:define-c-struct %sockaddr-un
+  #+darwin (sun-len (:unsigned :byte))
+  (sun-family (:unsigned #+darwin :byte #-darwin :short))
+  (sun-path (:c-array (:unsigned :byte) #.+max-unix-path-length+)))
+
+(defun %create-unix-domain-socket (pathname error)
+  (let ((sock-fd (comm::socket comm::*socket_af_unix* comm::*socket_sock_stream* comm::*socket_pf_unspec*)))
+    (if (null sock-fd)
+        (and error (error "Failed to create unix domain socket at ~S." pathname))
+
+        (fli:with-dynamic-foreign-objects ((sock-addr (:struct %sockaddr-un)))
+          (let ((pathname-string (namestring (translate-logical-pathname (truename pathname)))))
+            (fli:fill-foreign-object sock-addr :byte 0)
+
+            (let* ((code (ef:encode-lisp-string pathname-string :utf-8))
+                   (len (length code)))
+              (fli:with-foreign-slots (#+darwin sun-len sun-family) sock-addr
+                #+darwin (setf sun-len (+ len 2))
+                (setf sun-family comm::*socket_af_unix*))
+              (fli:replace-foreign-array (fli:foreign-slot-pointer sock-addr 'sun-path)
+                                         code
+                                         :start1 0 :end1 (min len +max-unix-path-length+))
+              (setf (fli:foreign-aref (fli:foreign-slot-pointer sock-addr 'sun-path)
+                                      (min len (1- +max-unix-path-length+))) 0)))
+
+          (if (comm::connect sock-fd
+                             (fli:copy-pointer sock-addr :type '(:struct comm::sockaddr))
+                             (fli:pointer-element-size sock-addr))
+              sock-fd
+              (progn
+                (comm::close-socket sock-fd)
+                (and error (error "Failed to connect unix domain socket at ~S." pathname))))))))
+
+(defun open-unix-stream (service &key
+                                 (direction :io)
+                                 (element-type 'base-char)
+                                 (errorp t))
+  (let ((socket (%create-unix-domain-socket service errorp)))
+    (when socket
+      (make-instance 'comm:socket-stream
+                     :socket socket
+                     :element-type element-type
+                     :direction direction))))
+
+(defun open-x-stream (host display protocol)
+  (declare (ignore protocol)
+           (type (integer 0) display))
+
+  (if (or (null host) (string= host "") (string= host "unix"))
+      (open-unix-stream (unix-socket-path-from-host host display)
+                        :direction :io
+                        :element-type '(unsigned-byte 8)
+                        :errorp t)
+
+      (comm:open-tcp-stream host (+ *x-tcp-port* display)
+                            :direction :io
+                            :element-type '(unsigned-byte 8)
+                            :errorp t)))
+
+;;; BUFFER-READ-DEFAULT - read data from the X stream
+
+(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 fixnum) timeout))
+  #.(declare-buffun)
+
+  (cond ((and (eql timeout 0)
+	      (not (listen (display-input-stream display))))
+	 :timeout)
+	(t
+	 (read-sequence vector
+			(display-input-stream display)
+                        :start start
+                        :end end)
+	 nil)))
+
+;;; BUFFER-WRITE-DEFAULT - write data to the X stream
+
+(defun buffer-write-default (vector display start end)
+  (declare (type buffer-bytes vector)
+	   (type display display)
+	   (type array-index start end))
+  #.(declare-buffun)
+
+  (write-sequence vector (display-output-stream display) :start start :end end)
+  nil)
+
+;;; buffer-force-output-default - force output to the X stream
+
+(defun buffer-force-output-default (display)
+  ;; The default buffer force-output function for use with common-lisp streams
+  (declare (type display display))
+
+  (let ((stream (display-output-stream display)))
+    (declare (type (or null stream) stream))
+
+    (unless (null stream)
+      (force-output stream))))
+
+;;; BUFFER-CLOSE-DEFAULT - close the X stream
+
+(defun buffer-close-default (display &key abort)
+  ;; The default buffer close function for use with common-lisp streams
+  (declare (type display display))
+  #.(declare-buffun)
+
+  (let ((stream (display-output-stream display)))
+    (declare (type (or null stream) stream))
+
+    (unless (null stream)
+      (close stream :abort abort))))
+
+;;; BUFFER-INPUT-WAIT-DEFAULT - wait for for input to be available for the
+;;; buffer.  This is called in read-input between requests, so that a process
+;;; waiting for input is abortable when between requests.  Should return
+;;; :TIMEOUT if it times out, NIL otherwise.
+
+(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)
+	  ((eql timeout 0) :timeout)
+	  (t
+           (if (sys:wait-for-input-streams-returning-first
+                (list stream) :timeout timeout)
+               nil
+               :timeout)))))
+
+;;; BUFFER-LISTEN-DEFAULT - returns T if there is input available for the
+;;; buffer. This should never block, so it can be called from the scheduler.
+
+(defun buffer-listen-default (display)
+  (declare (type display display))
+
+  (let ((stream (display-input-stream display)))
+    (declare (type (or null stream) stream))
+
+    (if (null stream)
+	t
+        (listen stream))))
+
+
+;;;----------------------------------------------------------------------------
+;;; System dependent speed hacks
+;;;----------------------------------------------------------------------------
+
+;;
+;; WITH-STACK-LIST is used by WITH-STATE as a memory saving feature.
+;; If your lisp doesn't have stack-lists, and you're worried about
+;; consing garbage, you may want to re-write this to allocate and
+;; initialize lists from a resource.
+;;
+(defmacro with-stack-list ((var &rest elements) &body body)
+  ;; SYNTAX: (WITH-STACK-LIST (var exp1 ... expN) body)
+  ;; Equivalent to (LET ((var (MAPCAR #'EVAL '(exp1 ... expN)))) body)
+  ;; except that the list produced by MAPCAR resides on the stack and
+  ;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
+  `(let ((,var (list ,@elements)))
+     (declare (type cons ,var)
+              (dynamic-extent ,var))
+     ,@body))
+
+(defmacro with-stack-list* ((var &rest elements) &body body)
+  ;; SYNTAX: (WITH-STACK-LIST* (var exp1 ... expN) body)
+  ;; Equivalent to (LET ((var (APPLY #'LIST* (MAPCAR #'EVAL '(exp1 ... expN))))) body)
+  ;; except that the list produced by MAPCAR resides on the stack and
+  ;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
+  `(let ((,var (list* ,@elements)))
+     (declare (type cons ,var)
+              (dynamic-extent ,var))
+     ,@body))
+
+(declaim (inline buffer-replace))
+
+(defun buffer-replace (buf1 buf2 start1 end1 &optional (start2 0))
+  (declare (type buffer-bytes buf1 buf2)
+	   (type array-index start1 end1 start2))
+  (replace buf1 buf2 :start1 start1 :end1 end1 :start2 start2))
+
+(defmacro with-gcontext-bindings ((gc saved-state indexes ts-index temp-mask temp-gc)
+				  &body body)
+  (let ((local-state (gensym))
+	(resets nil))
+    (dolist (index indexes)
+      (push `(setf (svref ,local-state ,index) (svref ,saved-state ,index))
+	    resets))
+    `(unwind-protect
+	 (progn
+	   ,@body)
+       (let ((,local-state (gcontext-local-state ,gc)))
+	 (declare (type gcontext-state ,local-state))
+	 ,@resets
+	 (setf (svref ,local-state ,ts-index) 0))
+       (when ,temp-gc
+	 (restore-gcontext-temp-state ,gc ,temp-mask ,temp-gc))
+       (deallocate-gcontext-state ,saved-state))))
+
+
+;;;----------------------------------------------------------------------------
+;;; How much error detection should CLX do?
+;;; Several levels are possible:
+;;;
+;;; 1. Do the equivalent of check-type on every argument.
+;;;
+;;; 2. Simply report TYPE-ERROR.  This eliminates overhead of all the format
+;;;    strings generated by check-type.
+;;;
+;;; 3. Do error checking only on arguments that are likely to have errors
+;;;    (like keyword names)
+;;;
+;;; 4. Do error checking only where not doing so may dammage the envirnment
+;;;    on a non-tagged machine (i.e. when storing into a structure that has
+;;;    been passed in)
+;;;
+;;; 5. No extra error detection code.  On lispm's, ASET may barf trying to
+;;;    store a non-integer into a number array.
+;;;
+;;; How extensive should the error checking be?  For example, if the server
+;;; expects a CARD16, is is sufficient for CLX to check for integer, or
+;;; should it also check for non-negative and less than 65536?
+;;;----------------------------------------------------------------------------
+
+;; The +TYPE-CHECK?+ constant controls how much error checking is done.
+;; Possible values are:
+;;    NIL      - Don't do any error checking
+;;    t        - Do the equivalent of checktype on every argument
+;;    :minimal - Do error checking only where errors are likely
+
+;;; 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?+ nil)
+
+;; 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
+;; good compiler support for TYPEP.  The definitions for CARD32, CARD16, INT16, etc.
+;; 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)
+  `(typep ,object ,type))
+
+;; X-TYPE-ERROR is the function called for type errors.
+;; If you want lots of checking, but are concerned about code size,
+;; this can be made into a macro that ignores some parameters.
+
+(defun x-type-error (object type &optional error-string)
+  (x-error 'x-type-error
+	   :datum object
+	   :expected-type type
+	   :type-string error-string))
+
+
+;;-----------------------------------------------------------------------------
+;; Error handlers
+;;    Hack up KMP error signaling using zetalisp until the real thing comes
+;;    along
+;;-----------------------------------------------------------------------------
+
+(defun default-error-handler (display error-key &rest key-vals
+			      &key asynchronous &allow-other-keys)
+  (declare (type generalized-boolean asynchronous)
+	   (dynamic-extent key-vals))
+  ;; The default display-error-handler.
+  ;; It signals the conditions listed in the DISPLAY file.
+  (if asynchronous
+      (apply #'x-cerror "Ignore" error-key :display display :error-key error-key key-vals)
+      (apply #'x-error error-key :display display :error-key error-key key-vals)))
+
+(defun x-error (condition &rest keyargs)
+  (declare (dynamic-extent keyargs))
+  (apply #'error condition keyargs))
+
+(defun x-cerror (proceed-format-string condition &rest keyargs)
+  (declare (dynamic-extent keyargs))
+  (apply #'cerror proceed-format-string condition keyargs))
+
+;; version 15 of Pitman error handling defines the syntax for define-condition to be:
+;; DEFINE-CONDITION name (parent-type) [({slot}*) {option}*]
+;; Where option is one of: (:documentation doc-string) (:conc-name symbol-or-string)
+;; or (:report exp)
+
+(define-condition x-error (error) ())
+
+
+;;-----------------------------------------------------------------------------
+;;  HOST hacking
+;;-----------------------------------------------------------------------------
+
+(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))
+  (labels ((no-host-error ()
+             (error "Unknown host ~S" host))
+           (no-address-error ()
+             (error "Host ~S has no ~S address" host family)))
+    (let ((addr (comm:get-host-entry (string host) :fields '(:address))))
+      (when (not addr)
+        (no-host-error))
+      (ecase family
+        ((:internet 0)
+         (list :internet
+               (ldb (byte 8 24) addr)
+               (ldb (byte 8 16) addr)
+               (ldb (byte 8  8) addr)
+               (ldb (byte 8  0) addr)))))))
+
+
+;;-----------------------------------------------------------------------------
+;; Whether to use closures for requests or not.
+;;-----------------------------------------------------------------------------
+
+;;; If this macro expands to non-NIL, then request and locking code is
+;;; compiled in a much more compact format, as the common code is shared, and
+;;; the specific code is built into a closure that is funcalled by the shared
+;;; code.  If your compiler makes efficient use of closures then you probably
+;;; want to make this expand to T, as it makes the code more compact.
+
+(defmacro use-closures ()
+  nil)
+
+(defun clx-macroexpand (form env)
+  (macroexpand form env))
+
+
+;;-----------------------------------------------------------------------------
+;; Resource stuff
+;;-----------------------------------------------------------------------------
+
+;;; Utilities
+
+(defun getenv (name)
+  (hcl:getenv name))
+
+(defun get-host-name ()
+  "Return the same hostname as gethostname(3) would"
+  ;; machine-instance probably works on a lot of lisps, but clisp is not
+  ;; one of them
+  (machine-instance))
+
+(defun homedir-file-pathname (name)
+  (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 ()
+  (homedir-file-pathname ".Xdefaults"))
+
+;;; RESOURCES-PATHNAME - The pathname of the resources file to load after the
+;;; defaults have been loaded.
+
+(defun resources-pathname ()
+  (or (let ((string (getenv "XENVIRONMENT")))
+	(and string
+	     (pathname string)))
+      (homedir-file-pathname
+       (concatenate 'string ".Xdefaults-" (get-host-name)))))
+
+;;; AUTHORITY-PATHNAME - The pathname of the authority file.
+
+(defun authority-pathname ()
+  (or (let ((xauthority (getenv "XAUTHORITY")))
+	(and xauthority
+	     (pathname xauthority)))
+      (homedir-file-pathname ".Xauthority")))
+
+;;; this particular defaulting behaviour is typical to most Unices, I think
+
+(defun get-default-display (&optional display-name)
+  "Parse the argument DISPLAY-NAME, or the environment variable $DISPLAY
+if it is NIL.  Display names have the format
+
+  [protocol/] [hostname] : [:] displaynumber [.screennumber]
+
+There are two special cases in parsing, to match that done in the Xlib
+C language bindings
+
+ - If the hostname is ``unix'' or the empty string, any supplied
+   protocol is ignored and a connection is made using the :local
+   transport.
+
+ - If a double colon separates hostname from displaynumber, the
+   protocol is assumed to be decnet.
+
+Returns a list of (host display-number screen protocol)."
+  (let* ((name (or display-name
+		   (getenv "DISPLAY")
+		   (error "DISPLAY environment variable is not set")))
+	 (slash-i (or (position #\/ name) -1))
+	 (colon-i (position #\: name :start (1+ slash-i)))
+	 (decnet-colon-p (eql (elt name (1+ colon-i)) #\:))
+	 (host (subseq name (1+ slash-i) colon-i))
+	 (dot-i (and colon-i (position #\. name :start colon-i)))
+	 (display (when colon-i
+		    (parse-integer name
+				   :start (if decnet-colon-p
+					      (+ colon-i 2)
+					      (1+ colon-i))
+				   :end dot-i)))
+	 (screen (when dot-i
+		   (parse-integer name :start (1+ dot-i))))
+	 (protocol
+	  (cond ((or (string= host "") (string-equal host "unix")) :local)
+		(decnet-colon-p :decnet)
+		((> slash-i -1) (intern
+				 (string-upcase (subseq name 0 slash-i))
+				 :keyword))
+		(t :internet))))
+    (list host (or display 0) (or screen 0) protocol)))
+
+
+;;-----------------------------------------------------------------------------
+;; GC stuff
+;;-----------------------------------------------------------------------------
+
+(defun gc-cleanup ()
+  (declare (special *event-free-list*
+		    *pending-command-free-list*
+		    *reply-buffer-free-lists*
+		    *gcontext-local-state-cache*
+		    *temp-gcontext-cache*))
+  (setq *event-free-list* nil)
+  (setq *pending-command-free-list* nil)
+  (when (boundp '*reply-buffer-free-lists*)
+    (fill *reply-buffer-free-lists* nil))
+  (setq *gcontext-local-state-cache* nil)
+  (setq *temp-gcontext-cache* nil)
+  nil)
+
+
+;;-----------------------------------------------------------------------------
+;; DEFAULT-KEYSYM-TRANSLATE
+;;-----------------------------------------------------------------------------
+
+;;; If object is a character, char-bits are set from state.
+;;;
+;;; [the following isn't implemented (should it be?)]
+;;; If object is a list, it is an alist with entries:
+;;; (base-char [modifiers] [mask-modifiers])
+;;; When MODIFIERS are specified, this character translation
+;;; will only take effect when the specified modifiers are pressed.
+;;; MASK-MODIFIERS can be used to specify a set of modifiers to ignore.
+;;; When MASK-MODIFIERS is missing, all other modifiers are ignored.
+;;; In ambiguous cases, the most specific translation is used.
+
+(defun default-keysym-translate (display state object)
+  (declare (type display display)
+	   (type card16 state)
+	   (type t object)
+	   (ignore display state)
+	   (clx-values t))
+  object)
+
+
+;;-----------------------------------------------------------------------------
+;; Image stuff
+;;-----------------------------------------------------------------------------
+
+;;; Types
+
+(deftype pixarray-1-element-type ()
+  'bit)
+
+(deftype pixarray-4-element-type ()
+  '(unsigned-byte 4))
+
+(deftype pixarray-8-element-type ()
+  '(unsigned-byte 8))
+
+(deftype pixarray-16-element-type ()
+  '(unsigned-byte 16))
+
+(deftype pixarray-24-element-type ()
+  '(unsigned-byte 24))
+
+(deftype pixarray-32-element-type ()
+  '(unsigned-byte 32))
+
+(deftype pixarray-1  ()
+  '(array pixarray-1-element-type (* *)))
+
+(deftype pixarray-4  ()
+  '(array pixarray-4-element-type (* *)))
+
+(deftype pixarray-8  ()
+  '(array pixarray-8-element-type (* *)))
+
+(deftype pixarray-16 ()
+  '(array pixarray-16-element-type (* *)))
+
+(deftype pixarray-24 ()
+  '(array pixarray-24-element-type (* *)))
+
+(deftype pixarray-32 ()
+  '(array pixarray-32-element-type (* *)))
+
+(deftype pixarray ()
+  '(or pixarray-1 pixarray-4 pixarray-8 pixarray-16 pixarray-24 pixarray-32))
+
+(deftype bitmap ()
+  'pixarray-1)
+
+;;; WITH-UNDERLYING-SIMPLE-VECTOR
+
+#+sbcl
+(defmacro with-underlying-simple-vector
+    ((variable element-type pixarray) &body body)
+  (declare (ignore element-type))
+  `(#+cmu kernel::with-array-data #+sbcl sb-kernel:with-array-data
+    ((,variable ,pixarray) (start) (end))
+    (declare (ignore start end))
+    ,@body))
+
+#+openmcl
+(defmacro with-underlying-simple-vector ((variable element-type pixarray)
+                                         &body body)
+  (declare (ignore element-type))
+  `(let* ((,variable (ccl::array-data-and-offset ,pixarray)))
+     ,@body))
+
+;;; These are used to read and write pixels from and to CARD8s.
+
+;;; READ-IMAGE-LOAD-BYTE is used to extract 1 and 4 bit pixels from CARD8s.
+
+(defmacro read-image-load-byte (size position integer)
+  (unless +image-bit-lsb-first-p+ (setq position (- 7 position)))
+  `(the (unsigned-byte ,size)
+	(ldb (byte ,size ,position)
+             (the card8 ,integer))))
+
+;;; READ-IMAGE-ASSEMBLE-BYTES is used to build 16, 24 and 32 bit pixels from
+;;; the appropriate number of CARD8s.
+
+(defmacro read-image-assemble-bytes (&rest bytes)
+  (unless +image-byte-lsb-first-p+ (setq bytes (reverse bytes)))
+  (let ((it (first bytes))
+	(count 0))
+    (dolist (byte (rest bytes))
+      (setq it
+	    `(dpb (the card8 ,byte)
+                  (byte 8 ,(incf count 8))
+                  (the (unsigned-byte ,count) ,it))))
+    `(the (unsigned-byte ,(* (length bytes) 8)) ,it)))
+
+;;; WRITE-IMAGE-LOAD-BYTE is used to extract a CARD8 from a 16, 24 or 32 bit
+;;; pixel.
+
+(defmacro write-image-load-byte (position integer integer-size)
+  integer-size
+  (unless +image-byte-lsb-first-p+ (setq position (- integer-size 8 position)))
+  `(the card8
+	(ldb (byte 8 ,position)
+             (the (unsigned-byte ,integer-size) ,integer))))
+
+;;; WRITE-IMAGE-ASSEMBLE-BYTES is used to build a CARD8 from 1 or 4 bit
+;;; pixels.
+
+(defmacro write-image-assemble-bytes (&rest bytes)
+  (unless +image-bit-lsb-first-p+ (setq bytes (reverse bytes)))
+  (let ((size (floor 8 (length bytes)))
+	(it (first bytes))
+	(count 0))
+    (dolist (byte (rest bytes))
+      (setq it `(dpb (the (unsigned-byte ,size) ,byte)
+                     (byte ,size ,(incf count size))
+                     (the (unsigned-byte ,count) ,it))))
+    `(the card8 ,it)))
+
+;;; The following table gives the bit ordering within bytes (when accessed
+;;; sequentially) for a scanline containing 32 bits, with bits numbered 0 to
+;;; 31, where bit 0 should be leftmost on the display.  For a given byte
+;;; labelled A-B, A is for the most significant bit of the byte, and B is
+;;; for the least significant bit.
+;;;
+;;; legend:
+;;; 	1   scanline-unit = 8
+;;; 	2   scanline-unit = 16
+;;; 	4   scanline-unit = 32
+;;; 	M   byte-order = MostSignificant
+;;; 	L   byte-order = LeastSignificant
+;;; 	m   bit-order = MostSignificant
+;;; 	l   bit-order = LeastSignificant
+;;;
+;;;
+;;; format	ordering
+;;;
+;;; 1Mm	00-07 08-15 16-23 24-31
+;;; 2Mm	00-07 08-15 16-23 24-31
+;;; 4Mm	00-07 08-15 16-23 24-31
+;;; 1Ml	07-00 15-08 23-16 31-24
+;;; 2Ml	15-08 07-00 31-24 23-16
+;;; 4Ml	31-24 23-16 15-08 07-00
+;;; 1Lm	00-07 08-15 16-23 24-31
+;;; 2Lm	08-15 00-07 24-31 16-23
+;;; 4Lm	24-31 16-23 08-15 00-07
+;;; 1Ll	07-00 15-08 23-16 31-24
+;;; 2Ll	07-00 15-08 23-16 31-24
+;;; 4Ll	07-00 15-08 23-16 31-24
+
+;;; If you can write fast routines that can read and write pixarrays out of a
+;;; buffer-bytes, do it!  It makes the image code a lot faster.  The
+;;; FAST-READ-PIXARRAY, FAST-WRITE-PIXARRAY and FAST-COPY-PIXARRAY routines
+;;; return T if they can do it, NIL if they can't.
+
+;;; FAST-READ-PIXARRAY - fill part of a pixarray from a buffer of card8s
+
+#+(or cmu sbcl)
+(defun pixarray-element-size (pixarray)
+  (let ((eltype (array-element-type pixarray)))
+    (cond ((eq eltype 'bit) 1)
+	  ((and (consp eltype) (eq (first eltype) 'unsigned-byte))
+	   (second eltype))
+	  (t
+	   (error "Invalid pixarray: ~S." pixarray)))))
+
+#+sbcl
+(defun copy-bit-rect (source source-width sx sy dest dest-width dx dy
+                      height width)
+  (declare (type array-index source-width sx sy dest-width dx dy height width))
+  #.(declare-buffun)
+  (sb-kernel:with-array-data ((sdata source) (sstart) (send))
+    (declare (ignore send))
+    (sb-kernel:with-array-data ((ddata dest) (dstart) (dend))
+      (declare (ignore dend))
+      (assert (and (zerop sstart) (zerop dstart)))
+      (do ((src-idx (index+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
+			    sx (index* sy source-width))
+		    (index+ src-idx source-width))
+	   (dest-idx (index+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
+			     dx (index* dy dest-width))
+		     (index+ dest-idx dest-width))
+	   (count height (1- count)))
+	  ((zerop count))
+	(declare (type array-index src-idx dest-idx count))
+	(sb-kernel:ub1-bash-copy sdata src-idx ddata dest-idx width)))))
+
+#+sbcl
+(defun fast-read-pixarray-using-bitblt (bbuf boffset pixarray x y width height
+                                        padded-bytes-per-line bits-per-pixel)
+  (declare (type (array * 2) pixarray))
+  #.(declare-buffun)
+  (copy-bit-rect bbuf
+		 (index* padded-bytes-per-line #+cmu vm:byte-bits #+sbcl sb-vm:n-byte-bits)
+		 (index* boffset #+cmu vm:byte-bits #+sbcl sb-vm:n-byte-bits) 0
+		 pixarray
+		 (index* (array-dimension pixarray 1) bits-per-pixel)
+		 x y
+		 height
+		 (index* width bits-per-pixel))
+  t)
+
+(defun fast-read-pixarray (bbuf boffset pixarray
+			   x y width height padded-bytes-per-line
+			   bits-per-pixel
+			   unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type array-index boffset
+		 padded-bytes-per-line)
+	   (type pixarray pixarray)
+	   (type card16 x y width height)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) unit)
+	   (type generalized-boolean byte-lsb-first-p bit-lsb-first-p))
+  (progn bbuf boffset pixarray x y width height padded-bytes-per-line
+	 bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+  (or
+   (let ((function
+           (or #+(or cmu)
+               (and (index= (pixarray-element-size pixarray) bits-per-pixel)
+                    #'fast-read-pixarray-using-bitblt))))
+     (when function
+       (read-pixarray-internal
+        bbuf boffset pixarray x y width height padded-bytes-per-line
+        bits-per-pixel function
+        unit byte-lsb-first-p bit-lsb-first-p
+        +image-unit+ +image-byte-lsb-first-p+ +image-bit-lsb-first-p+)))))
+
+;;; FAST-WRITE-PIXARRAY - copy part of a pixarray into an array of CARD8s
+
+#+(or cmu sbcl)
+(defun fast-write-pixarray-24 (buffer-bbuf index array x y width height
+			       padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-24 array)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (with-underlying-simple-vector (vector pixarray-24-element-type array)
+      (do* ((h 0 (index1+ h))
+	    (y y (index1+ y))
+	    (start index (index+ start padded-bytes-per-line)))
+	   ((index>= h height))
+	(declare (type array-index y start))
+	(do* ((end (index+ start (index* width 3)))
+	      (i start (index+ i 3))
+	      (x (array-row-major-index array y x) (index1+ x)))
+	     ((index>= i end))
+	  (declare (type array-index end i x))
+	  (let ((pixel (aref vector x)))
+	    (declare (type pixarray-24-element-type pixel))
+	    (setf (aref buffer-bbuf (index+ i 0))
+		  (write-image-load-byte 0 pixel 24))
+	    (setf (aref buffer-bbuf (index+ i 1))
+		  (write-image-load-byte 8 pixel 24))
+	    (setf (aref buffer-bbuf (index+ i 2))
+		  (write-image-load-byte 16 pixel 24)))))))
+  t)
+
+#+(or cmu sbcl)
+(defun fast-write-pixarray-using-bitblt (bbuf boffset pixarray x y width height
+                                         padded-bytes-per-line bits-per-pixel)
+  #.(declare-buffun)
+  (copy-bit-rect pixarray
+		 (index* (array-dimension pixarray 1) bits-per-pixel)
+		 x y
+		 bbuf
+		 (index* padded-bytes-per-line #+cmu vm:byte-bits #+sbcl sb-vm:n-byte-bits)
+		 (index* boffset #+cmu vm:byte-bits #+sbcl sb-vm:n-byte-bits) 0
+		 height
+		 (index* width bits-per-pixel))
+  t)
+
+(defun fast-write-pixarray (bbuf boffset pixarray x y width height
+			    padded-bytes-per-line bits-per-pixel
+			    unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type pixarray pixarray)
+	   (type card16 x y width height)
+	   (type array-index boffset padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) unit)
+	   (type generalized-boolean byte-lsb-first-p bit-lsb-first-p))
+  (progn bbuf boffset pixarray x y width height padded-bytes-per-line
+	 bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+  (or
+   (let ((function
+           (or #+(or cmu)
+               (and (index= (pixarray-element-size pixarray) bits-per-pixel)
+                    #'fast-write-pixarray-using-bitblt))))
+     (when function
+       (write-pixarray-internal
+        bbuf boffset pixarray x y width height padded-bytes-per-line
+        bits-per-pixel function
+        +image-unit+ +image-byte-lsb-first-p+ +image-bit-lsb-first-p+
+        unit byte-lsb-first-p bit-lsb-first-p)))))
+
+;;; FAST-COPY-PIXARRAY - copy part of a pixarray into another
+
+(defun fast-copy-pixarray (pixarray copy x y width height bits-per-pixel)
+  (declare (type pixarray pixarray copy)
+	   (type card16 x y width height)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel))
+  (progn pixarray copy x y width height bits-per-pixel nil)
+  (or
+   #+(or cmu)
+   (let* ((pixarray-padded-pixels-per-line
+            (array-dimension pixarray 1))
+          (pixarray-padded-bits-per-line
+            (* pixarray-padded-pixels-per-line bits-per-pixel))
+          (copy-padded-pixels-per-line
+            (array-dimension copy 1))
+          (copy-padded-bits-per-line
+            (* copy-padded-pixels-per-line bits-per-pixel)))
+     #-(or cmu)
+     (when (and (= (sys:array-element-size pixarray) bits-per-pixel)
+                (zerop (index-mod pixarray-padded-bits-per-line 32))
+                (zerop (index-mod copy-padded-bits-per-line 32)))
+       (sys:bitblt boole-1 width height pixarray x y copy 0 0)
+       t)
+     #+(or cmu)
+     (when (index= (pixarray-element-size pixarray)
+                   (pixarray-element-size copy)
+                   bits-per-pixel)
+       (copy-bit-rect pixarray pixarray-padded-bits-per-line x y
+                      copy copy-padded-bits-per-line 0 0
+                      height
+                      (index* width bits-per-pixel))
+       t))))
diff --git a/src/clx/dep-openmcl.lisp b/src/clx/dep-openmcl.lisp
index 94d8670e340dc57e8dd6acd04f47c0c1978653a9..75b5fe9587ce331a65e1ecb2b95bb677041c8024 100644
--- a/src/clx/dep-openmcl.lisp
+++ b/src/clx/dep-openmcl.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: dep-openmcl.lisp,v 1.2 2009/06/17 18:22:45 rtoy Rel $")
-
 (in-package :xlib)
 
 (proclaim '(declaration array-register))
@@ -32,6 +29,17 @@
 ;;; Number of seconds to wait for a reply to a server request
 (defparameter *reply-timeout* nil) 
 
+#-(or clx-overlapping-arrays (not clx-little-endian))
+(progn
+  (defconstant +word-0+ 0)
+  (defconstant +word-1+ 1)
+
+  (defconstant +long-0+ 0)
+  (defconstant +long-1+ 1)
+  (defconstant +long-2+ 2)
+  (defconstant +long-3+ 3))
+
+#-(or clx-overlapping-arrays clx-little-endian)
 (progn
   (defconstant +word-0+ 1)
   (defconstant +word-1+ 0)
@@ -495,8 +503,12 @@
 ;;; value changes.
 
 (defun process-block (whostate predicate &rest predicate-args)
-  (declare (dynamic-extern predicate-args))
-  (apply #'ccl:process-wait whostate predicate predicate-args))
+  (declare (ignore whostate))
+  (declare (type function predicate))
+  (loop
+   (when (apply predicate predicate-args)
+     (return))
+   (ccl:process-allow-schedule)))
 
 ;;; PROCESS-WAKEUP: Check some other process' wait function.
 
@@ -672,7 +684,7 @@
   ;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
   `(let ((,var (list ,@elements)))
      (declare (type cons ,var)
-	      #+clx-ansi-common-lisp (dynamic-extent ,var))
+              (dynamic-extent ,var))
      ,@body))
 
 (defmacro with-stack-list* ((var &rest elements) &body body)
@@ -831,7 +843,7 @@
   (declare (clx-values list))
   (ecase family
     ((:internet nil 0)
-     (let* ((addr (ccl::host-as-inet-host host)))
+     (let* ((addr (ccl:lookup-hostname host)))
        (cons :internet (list
                         (ldb (byte 8 24) addr)
                         (ldb (byte 8 16) addr)
@@ -1116,7 +1128,7 @@ Returns a list of (host display-number screen protocol)."
 			    unit byte-lsb-first-p bit-lsb-first-p)
   (declare (ignore bbuf boffset pixarray x y width height
                    padded-bytes-per-line bits-per-pixel unit
-                   byte-lsb-first-p bit-lsp-first-p))
+                   byte-lsb-first-p bit-lsb-first-p))
   nil)
 
 ;;; FAST-COPY-PIXARRAY - copy part of a pixarray into another
diff --git a/src/clx/depdefs.lisp b/src/clx/depdefs.lisp
index bce7c5e7036d55792302d2bb51397ff2045ea54c..10b29acfcedafe248fd2f14af889d7489d601af3 100644
--- a/src/clx/depdefs.lisp
+++ b/src/clx/depdefs.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: depdefs.lisp,v 1.9 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 ;;;-------------------------------------------------------------------------
@@ -38,16 +35,6 @@
 	(lisp:rational x)))
   (deftype rational (&optional l u) `(lisp:rational ,l ,u)))
 
-;;; DECLAIM
-
-#-clx-ansi-common-lisp
-(defmacro declaim (&rest decl-specs)
-  (if (cdr decl-specs)
-      `(progn
-	 ,@(mapcar #'(lambda (decl-spec) `(proclaim ',decl-spec))
-		   decl-specs))
-    `(proclaim ',(car decl-specs))))
-
 ;;; CLX-VALUES value1 value2 ... -- Documents the values returned by the function.
 
 #-Genera
@@ -63,18 +50,6 @@
 #-(or lispm lcl3.0)
 (declaim (declaration arglist))
 
-;;; DYNAMIC-EXTENT var -- Tells the compiler that the rest arg var has
-;;; dynamic extent and therefore can be kept on the stack and not copied to
-;;; the heap, even though the value is passed out of the function.
-
-#-(or clx-ansi-common-lisp lcl3.0)
-(declaim (declaration dynamic-extent))
-
-;;; IGNORABLE var -- Tells the compiler that the variable might or might not be used.
-
-#-clx-ansi-common-lisp
-(declaim (declaration ignorable))
-
 ;;; INDENTATION argpos1 arginden1 argpos2 arginden2 --- Tells the lisp editor how to
 ;;; indent calls to the function or macro containing the declaration.  
 
@@ -144,7 +119,7 @@
 ;;; You must define this to match the real byte order.  It is used by
 ;;; overlapping array and image code.
 
-#+(or lispm vax little-endian Minima)
+#+(or lispm vax (and (not sbcl) little-endian) Minima)
 (eval-when (eval compile load)
   (pushnew :clx-little-endian *features*))
 
@@ -171,6 +146,10 @@
     (:big-endian)
     (:little-endian (pushnew :clx-little-endian *features*))))
 
+#+openmcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  #+little-endian-target (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
@@ -422,14 +401,7 @@ used, since NIL is the empty list.")
 (defmacro def-clx-class ((name &rest options) &body slots)
   (if (or (not (listp *def-clx-class-use-defclass*))
 	  (member name *def-clx-class-use-defclass*))
-      (let ((clos-package #+clx-ansi-common-lisp
-			  (find-package :common-lisp)
-			  #-clx-ansi-common-lisp
-			  (or (find-package :clos)
-			      (find-package :pcl)
-			      (let ((lisp-pkg (find-package :lisp)))
-				(and (find-symbol (string 'defclass) lisp-pkg)
-				     lisp-pkg))))
+      (let ((clos-package (find-package :common-lisp))
 	    (constructor t)
 	    (constructor-args t)
 	    (include nil)
@@ -601,40 +573,6 @@ used, since NIL is the empty list.")
 ;; Printing routines.
 ;;-----------------------------------------------------------------------------
 
-#-(or clx-ansi-common-lisp Genera)
-(defun print-unreadable-object-function (object stream type identity function)
-  (declare #+lispm
-	   (sys:downward-funarg function))
-  (princ "#<" stream)
-  (when type
-    (let ((type (type-of object))
-	  (pcl-package (find-package :pcl)))
-      ;; Handle pcl type-of lossage
-      (when (and pcl-package
-		 (symbolp type)
-		 (eq (symbol-package type) pcl-package)
-		 (string-equal (symbol-name type) "STD-INSTANCE"))
-	(setq type
-	      (funcall (intern (symbol-name 'class-name) pcl-package)
-		       (funcall (intern (symbol-name 'class-of) pcl-package)
-				object))))
-      (prin1 type stream)))
-  (when (and type function) (princ " " stream))
-  (when function (funcall function))
-  (when (and (or type function) identity) (princ " " stream))
-  (when identity (princ "???" stream))
-  (princ ">" stream)
-  nil)
-  
-#-(or clx-ansi-common-lisp Genera)
-(defmacro print-unreadable-object
-	  ((object stream &key type identity) &body body)
-  (if body
-      `(flet ((.print-unreadable-object-body. () ,@body))
-	 (print-unreadable-object-function
-	   ,object ,stream ,type ,identity #'.print-unreadable-object-body.))
-    `(print-unreadable-object-function ,object ,stream ,type ,identity nil)))
-
 
 ;;-----------------------------------------------------------------------------
 ;; Image stuff
@@ -680,7 +618,8 @@ used, since NIL is the empty list.")
 ;; Finding the server socket
 ;;-----------------------------------------------------------------------------
 
-;; These are here because dep-openmcl.lisp and dependent.lisp both need them
+;; These are here because dep-openmcl.lisp, dep-lispworks.lisp and
+;; dependent.lisp need them
 (defconstant +X-unix-socket-path+
   "/tmp/.X11-unix/X"
   "The location of the X socket")
@@ -691,6 +630,7 @@ nil if a network socket should be opened."
   (cond ((or (string= host "") (string= host "unix"))
 	 (format nil "~A~D" +X-unix-socket-path+ display))
 	#+darwin
-	((and (> (length host) 10) (string= host "tmp/launch" :end1 10))
+	((or (and (> (length host) 10) (string= host "tmp/launch" :end1 10))
+	     (and (> (length host) 29) (string= host "private/tmp/com.apple.launchd" :end1 29)))
 	 (format nil "/~A:~D" host display))	  
 	(t nil)))
diff --git a/src/clx/dependent.lisp b/src/clx/dependent.lisp
index 24ce80cd460992753b920dfbce94b4c59921bf7d..3d4c985cd90b313f8ac4249b055d88f9bd8f2b87 100644
--- a/src/clx/dependent.lisp
+++ b/src/clx/dependent.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: dependent.lisp,v 1.18 2009/06/17 18:28:11 rtoy Rel $")
-
 (in-package :xlib)
 
 (proclaim '(declaration array-register))
@@ -692,7 +689,8 @@
   (the short-float (* (the int16 value) #.(coerce (/ pi 180.0 64.0) 'short-float))))
 
 
-#+(or cmu sbcl clisp) (progn
+#+(or cmu sbcl clisp ecl)
+(progn
 
 ;;; This overrides the (probably incorrect) definition in clx.lisp.  Since PI
 ;;; is irrational, there can't be a precise rational representation.  In
@@ -702,13 +700,11 @@
 ;;; in the value, and see if the protocol encoding falls in the desired range
 ;;; (64'ths of a degree.)
 ;;;
-(deftype angle () '(satisfies anglep))
+  (deftype angle () '(satisfies anglep))
 
-(defun anglep (x)
-  (and (typep x 'real)
-       (<= (* -360 64) (radians->int16 x) (* 360 64))))
-
-)
+  (defun anglep (x)
+    (and (typep x 'real)
+         (<= (* -360 64) (radians->int16 x) (* 360 64)))))
 
 
 ;;-----------------------------------------------------------------------------
@@ -866,7 +862,7 @@
 
 ;;; MAKE-PROCESS-LOCK: Creating a process lock.
 
-#-(or LispM excl Minima sbcl (and cmu mp))
+#-(or LispM excl Minima sbcl (and cmu mp) (and ecl threads))
 (defun make-process-lock (name)
   (declare (ignore name))
   nil)
@@ -895,6 +891,10 @@
 (defun make-process-lock (name)
   (sb-thread:make-mutex :name name))
 
+#+(and ecl threads)
+(defun make-process-lock (name)
+  (mp:make-lock :name name :recursive t))
+
 ;;; HOLDING-LOCK: Execute a body of code with a lock held.
 
 ;;; The holding-lock macro takes a timeout keyword argument.  EVENT-LISTEN
@@ -903,7 +903,7 @@
 
 ;; If you're not sharing DISPLAY objects within a multi-processing
 ;; shared-memory environment, this is sufficient
-#-(or lispm excl lcl3.0 Minima sbcl (and CMU mp) )
+#-(or lispm excl lcl3.0 Minima sbcl (and CMU mp) (and ecl threads))
 (defmacro holding-lock ((locator display &optional whostate &key timeout) &body body)
   (declare (ignore locator display whostate timeout))
   `(progn ,@body))
@@ -946,6 +946,14 @@
   `(progn
      ,@body))
 
+#+(and ecl threads)
+(defmacro holding-lock ((lock display &optional (whostate "CLX wait")
+                              &key timeout)
+                        &body body)
+  (declare (ignore display))
+  `(mp::with-lock (,lock)
+      ,@body))
+
 #+sbcl
 (defmacro holding-lock ((lock display &optional (whostate "CLX wait")
 			      &key timeout)
@@ -1113,7 +1121,7 @@
 ;;; Caller guarantees that PROCESS-WAKEUP will be called after the predicate's
 ;;; value changes.
 
-#-(or lispm excl lcl3.0 Minima (and sb-thread sbcl) (and cmu mp))
+#-(or lispm excl lcl3.0 Minima (and sb-thread sbcl) (and cmu mp) (and ecl threads))
 (defun process-block (whostate predicate &rest predicate-args)
   (declare (ignore whostate))
   (or (apply predicate predicate-args)
@@ -1122,19 +1130,13 @@
 #+Genera
 (defun process-block (whostate predicate &rest predicate-args)
   (declare (type function predicate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent predicate)
-	   #-clx-ansi-common-lisp
-	   (sys:downward-funarg predicate))
+	   (dynamic-extent predicate))
   (apply #'process:block-process whostate predicate predicate-args))
 
 #+(and lispm (not Genera))
 (defun process-block (whostate predicate &rest predicate-args)
   (declare (type function predicate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent predicate)
-	   #-clx-ansi-common-lisp 
-	   (sys:downward-funarg predicate))
+	   (dynamic-extent predicate))
   (apply #'global:process-wait whostate predicate predicate-args))
 
 #+excl
@@ -1179,6 +1181,14 @@
      (return))
    (yield)))
 
+#+(and ecl threads)
+(defun process-block (whostate predicate &rest predicate-args)
+  (declare (ignore whostate))
+  (declare (type function predicate))
+  (loop
+   (when (apply predicate predicate-args)
+     (return))
+   (mp:process-yield)))
 
 ;;; FIXME: the below implementation for threaded PROCESS-BLOCK using
 ;;; queues and condition variables might seem better, but in fact it
@@ -1215,7 +1225,7 @@
 
 (declaim (inline process-wakeup))
 
-#-(or excl Genera Minima (and sbcl sb-thread) (and cmu mp))
+#-(or excl Genera Minima (and sbcl sb-thread) (and cmu mp) (and ecl threads))
 (defun process-wakeup (process)
   (declare (ignore process))
   nil)
@@ -1249,6 +1259,12 @@
 (defun process-wakeup (process)
   (declare (ignore process))
   (yield))
+
+#+(and ecl threads)
+(defun process-wakeup (process)
+  (declare (ignore process))
+  (mp:process-yield))
+
 #+(or)
 (defun process-wakeup (process)
   (declare (ignore process))
@@ -1267,7 +1283,7 @@
 
 ;;; Default return NIL, which is acceptable even if there is a scheduler.
 
-#-(or lispm excl lcl3.0 sbcl Minima (and cmu mp))
+#-(or lispm excl lcl3.0 sbcl Minima (and cmu mp) (and ecl threads))
 (defun current-process ()
   nil)
 
@@ -1288,7 +1304,7 @@
 (defun current-process ()
   (minima:current-process))
 
-#+(and cmu mp)
+#+(or (and cmu mp) (and ecl threads))
 (defun current-process ()
   mp:*current-process*)
 
@@ -1298,7 +1314,7 @@
 
 ;;; WITHOUT-INTERRUPTS -- provide for atomic operations.
 
-#-(or lispm excl lcl3.0 Minima cmu)
+#-(or lispm excl lcl3.0 Minima cmu sbcl)
 (defmacro without-interrupts (&body body)
   `(progn ,@body))
 
@@ -1322,6 +1338,10 @@
 (defmacro without-interrupts (&body body)
   `(system:without-interrupts ,@body))
 
+#+ecl
+(defmacro without-interrupts (&body body)
+  `(mp:without-interrupts ,@body))
+
 #+sbcl
 (defvar *without-interrupts-sic-lock*
   (sb-thread:make-mutex :name "lock simulating *without-interrupts*"))
@@ -1544,7 +1564,25 @@
 						  (cdr (host-address host)))
 			  :foreign-port (+ *x-tcp-port* display)))
 
-#+CMU
+#+(or sbcl ecl)
+(defun open-x-stream (host display protocol)  
+  (declare (ignore protocol)
+           (type (integer 0) display))
+  (socket-make-stream
+   (let ((unix-domain-socket-path (unix-socket-path-from-host host display)))
+     (if unix-domain-socket-path
+         (let ((s (make-instance 'local-socket :type :stream)))
+           (socket-connect s unix-domain-socket-path)
+           s)
+         (let ((host (car (host-ent-addresses (get-host-by-name host)))))
+           (when host
+             (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
+               (socket-connect s host (+ 6000 display))
+               s)))))
+   :element-type '(unsigned-byte 8)
+   :input t :output t :buffering :none))
+
+#+cmu
 (defun open-x-stream (host display protocol)
   (let ((stream-fd
          (ecase protocol
@@ -1585,34 +1623,6 @@
                 fd))))))
     (system:make-fd-stream stream-fd :input t :output t :element-type '(unsigned-byte 8))))
 
-#+sbcl
-(defun open-x-stream (host display protocol)  
-  (declare (ignore protocol)
-           (type (integer 0) display))
-  (let ((local-socket-path (unix-socket-path-from-host host display)))
-  (socket-make-stream 
-     (if local-socket-path
-       (let ((s (make-instance 'local-socket :type :stream)))
-	   (socket-connect s local-socket-path)
-	 s)
-       (let ((host (car (host-ent-addresses (get-host-by-name host)))))
-	 (when host
-	   (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
-	     (socket-connect s host (+ 6000 display))
-	     s))))
-   :element-type '(unsigned-byte 8)
-     :input t :output t :buffering :none)))
-
-#+ecl
-(defun open-x-stream (host display protocol)
-  (declare (ignore protocol)
-	   (type (integer 0) display))
-  (let (socket)
-    (if (or (string= host "") (string= host "unix")) ; AF_UNIX doamin socket
-	(sys::open-unix-socket-stream
-	 (format nil "~A~D" +X-unix-socket-path+ display))
-	(si::open-client-stream host (+ 6000 display)))))
-
 ;;; BUFFER-READ-DEFAULT - read data from the X stream
 
 #+(or Genera explorer)
@@ -1844,7 +1854,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 CMU sbcl clisp)
+#-(or Genera explorer excl lcl3.0 Minima CMU sbcl clisp ecl)
 (defun buffer-write-default (vector display start end)
   ;; The default buffer write function for use with common-lisp streams
   (declare (type buffer-bytes vector)
@@ -2113,7 +2123,7 @@
   ;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
   `(let ((,var (list ,@elements)))
      (declare (type cons ,var)
-	      #+clx-ansi-common-lisp (dynamic-extent ,var))
+              (dynamic-extent ,var))
      ,@body))
 
 #-lispm
@@ -2124,7 +2134,7 @@
   ;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
   `(let ((,var (list* ,@elements)))
      (declare (type cons ,var)
-	      #+clx-ansi-common-lisp (dynamic-extent ,var))
+              (dynamic-extent ,var))
      ,@body))
 
 (declaim (inline buffer-replace))
@@ -2369,31 +2379,10 @@
       (apply #'x-cerror "Ignore" error-key :display display :error-key error-key key-vals)
       (apply #'x-error error-key :display display :error-key error-key key-vals)))
 
-#+(and lispm (not Genera) (not clx-ansi-common-lisp))
-(defun x-error (condition &rest keyargs)
-  (apply #'sys:signal condition keyargs))
-
-#+(and lispm (not Genera) (not clx-ansi-common-lisp))
-(defun x-cerror (proceed-format-string condition &rest keyargs)
-  (sys:signal (apply #'zl:make-condition condition keyargs)
-	      :proceed-types proceed-format-string))
-
-#+(and Genera (not clx-ansi-common-lisp))
-(defun x-error (condition &rest keyargs)
-  (declare (dbg:error-reporter))
-  (apply #'sys:signal condition keyargs))
-
-#+(and Genera (not clx-ansi-common-lisp))
-(defun x-cerror (proceed-format-string condition &rest keyargs)
-  (declare (dbg:error-reporter))
-  (apply #'sys:signal condition :continue-format-string proceed-format-string keyargs))
-
-#+(or clx-ansi-common-lisp excl lcl3.0 clisp (and CMU mp))
 (defun x-error (condition &rest keyargs)
   (declare (dynamic-extent keyargs))
   (apply #'error condition keyargs))
 
-#+(or clx-ansi-common-lisp excl lcl3.0 CMU clisp)
 (defun x-cerror (proceed-format-string condition &rest keyargs)
   (declare (dynamic-extent keyargs))
   (apply #'cerror proceed-format-string condition keyargs))
@@ -2416,175 +2405,8 @@
 	(ext::disable-clx-event-handling disp)))
     (error condx)))
 
-#-(or lispm ansi-common-lisp excl lcl3.0 CMU sbcl clisp)
-(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 CMU sbcl clisp)
-(defun x-cerror (proceed-format-string condition &rest keyargs)
-  (cerror proceed-format-string "X-Error: ~a"
-	 (princ-to-string (apply #'make-condition condition keyargs))))
-
-;; version 15 of Pitman error handling defines the syntax for define-condition to be:
-;; DEFINE-CONDITION name (parent-type) [({slot}*) {option}*]
-;; Where option is one of: (:documentation doc-string) (:conc-name symbol-or-string)
-;; or (:report exp)
-
-#+lcl3.0 
-(defmacro define-condition (name parent-types &optional slots &rest args)
-  `(lcl:define-condition
-     ,name (,(first parent-types))
-     ,(mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
-	      slots)
-     ,@args))
-
-#+(and excl (not clx-ansi-common-lisp))
-(defmacro define-condition (name parent-types &optional slots &rest args)
-  `(excl::define-condition
-     ,name (,(first parent-types))
-     ,(mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
-	      slots)
-     ,@args))
-
-#+(and CMU (not clx-ansi-common-lisp))
-(defmacro define-condition (name parent-types &optional slots &rest args)
-  `(common-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
-	  (mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
-		  (pop options)))
-	(documentation nil)
-	(conc-name (concatenate 'string (string name) "-"))	       
-	(reporter nil))
-    (dolist (item options)
-      (ecase (first item)
-	(:documentation (setq documentation (second item)))
-	(:conc-name (setq conc-name (string (second item))))
-	(:report (setq reporter (second item)))))
-    `(within-definition (,name define-condition)
-       (zl:defflavor ,name ,slot-names ,parent-types
-	 :initable-instance-variables
-	 #-Genera
-	 (:accessor-prefix ,conc-name)
-	 #+Genera
-	 (:conc-name ,conc-name)
-	 #-Genera
-	 (:outside-accessible-instance-variables ,@slot-names)
-	 #+Genera
-	 (:readable-instance-variables ,@slot-names))
-       ,(when reporter ;; when no reporter, parent's is inherited
-	  `(zl:defmethod #-Genera (,name :report)
-	                 #+Genera (dbg:report ,name) (stream)
-	      ,(if (stringp reporter)
-		   `(write-string ,reporter stream)
-		 `(,reporter global:self stream))
-	      global:self))
-       (zl:compile-flavor-methods ,name)
-       ,(when documentation
-	  `(setf (documentation name 'type) ,documentation))
-       ',name)))
-
-#+(and lispm (not Genera) (not clx-ansi-common-lisp))
-(zl:defflavor x-error () (global:error))
-
-#+(and Genera (not clx-ansi-common-lisp))
-(scl:defflavor x-error
-	((dbg:proceed-types '(:continue))	;
-	 continue-format-string)
-	(sys:error)
-  (:initable-instance-variables continue-format-string))
-
-#+(and Genera (not clx-ansi-common-lisp))
-(scl:defmethod (scl:make-instance x-error) (&rest ignore)
-  (when (not (sys:variable-boundp continue-format-string))
-    (setf dbg:proceed-types (remove :continue dbg:proceed-types))))
-
-#+(and Genera (not clx-ansi-common-lisp))
-(scl:defmethod (dbg:proceed x-error :continue) ()
-  :continue)
-
-#+(and Genera (not clx-ansi-common-lisp))
-(sys:defmethod (dbg:document-proceed-type x-error :continue) (stream)
-  (format stream continue-format-string))
-
-#+(or clx-ansi-common-lisp excl lcl3.0 CMU sbcl clisp)
 (define-condition x-error (error) ())
 
-#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU sbcl)
-(defstruct x-error
-  report-function)
-
-#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU sbcl)
-(defmacro define-condition (name parent-types &body options)
-  ;; Define a structure that when printed displays an error message
-  (flet ((reporter-for-condition (name)
-	   (xintern "." name '-reporter.)))
-    (let ((slot-names
-	    (mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
-		    (pop options)))
-	  (documentation nil)
-	  (conc-name (concatenate 'string (string name) "-"))	       
-	  (reporter nil)
-	  (condition (gensym))
-	  (stream (gensym))
-	  (report-function (reporter-for-condition name)))
-      (dolist (item options)
-	(ecase (first item)
-	  (:documentation (setq documentation (second item)))
-	  (:conc-name (setq conc-name (string (second item))))
-	  (:report (setq reporter (second item)))))
-      (unless reporter
-	(setq report-function (reporter-for-condition (first parent-types))))
-      `(within-definition (,name define-condition)
-	 (defstruct (,name (:conc-name ,(intern conc-name))
-		     (:print-function condition-print)
-		     (:include ,(first parent-types)
-		      (report-function ',report-function)))
-	   ,@slot-names)
-	 ,(when documentation
-	    `(setf (documentation name 'type) ,documentation))
-	 ,(when reporter
-	    `(defun ,report-function (,condition ,stream)
-	       ,(if (stringp reporter)
-		    `(write-string ,reporter ,stream)
-		  `(,reporter ,condition ,stream))
-	       ,condition))
-	 ',name))))
-
-#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU sbcl clisp)
-(defun condition-print (condition stream depth)
-  (declare (type x-error condition)
-	   (type stream stream)
-	   (ignore depth))
-  (if *print-escape*
-      (print-unreadable-object (condition stream :type t))
-    (funcall (x-error-report-function condition) condition stream))
-  condition)
-  
-#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU sbcl clisp)
-(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 CMU sbcl clisp)
-(define-condition type-error (x-error)
-  ((datum :reader type-error-datum :initarg :datum)
-   (expected-type :reader type-error-expected-type :initarg :expected-type))
-  (:report
-    (lambda (condition stream)
-      (format stream "~s isn't a ~a"
-	      (type-error-datum condition)
-	      (type-error-expected-type condition)))))
-
 
 ;;-----------------------------------------------------------------------------
 ;;  HOST hacking
@@ -2738,6 +2560,9 @@
 			(si:memref-int addr 3 0 :unsigned-byte))))))
 	(ff:free-cstruct hostent)))))
 
+;#+sbcl
+;(require :sockets)
+
 #+CMU
 (defun host-address (host &optional (family :internet))
   ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
@@ -2749,24 +2574,39 @@
 	     (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))))
+    (let ((hostent #+rwi-sockets(ext:lookup-host-entry (string host))
+		   #+mna-sockets(net.sbcl.sockets:look-up-host-entry
+				 (string host)) 
+		   #+db-sockets(sockets:get-host-by-name (string host))))
       (when (not hostent)
 	(no-host-error))
       (ecase family
 	((:internet nil 0)
-	 (unless (= (ext::host-entry-addr-type hostent) 2)
+	 #+rwi-sockets(unless (= (ext::host-entry-addr-type hostent) 2)
+			(no-address-error))
+	 #+mna-sockets(unless (= (net.sbcl.sockets::host-entry-addr-type hostent) 2)
+			(no-address-error))
+	 ;; the following form is for use with SBCL and Daniel
+	 ;; Barlow's socket package
+	 #+db-sockets(unless (sockets:host-ent-address hostent)
 	   (no-address-error))
 	 (append (list :internet)
+		 #+rwi-sockets
 		 (let ((addr (first (ext::host-entry-addr-list hostent))))
 			(list (ldb (byte 8 24) addr)
 			      (ldb (byte 8 16) addr)
 			      (ldb (byte 8  8) addr)
-			      (ldb (byte 8  0) addr)))))))))
-
-;#+sbcl
-;(require :sockets)
-
-
+			      (ldb (byte 8  0) addr)))
+		 #+mna-sockets
+		 (let ((addr (first (net.sbcl.sockets::host-entry-addr-list hostent))))
+				(list (ldb (byte 8 24) addr)
+				      (ldb (byte 8 16) addr)
+				      (ldb (byte 8  8) addr)
+				      (ldb (byte 8  0) addr)))
+		 ;; the following form is for use with SBCL and Daniel
+		 ;; Barlow's socket package
+		 #+db-sockets(coerce (sockets:host-ent-address hostent)
+				     'list)))))))
 
 #+sbcl
 (defun host-address (host &optional (family :internet))
@@ -2899,10 +2739,9 @@
   "Return the same hostname as gethostname(3) would"
   ;; machine-instance probably works on a lot of lisps, but clisp is not
   ;; one of them
-  #+(or cmu sbcl) (machine-instance)
+  #+(or cmu sbcl ecl) (machine-instance)
   ;; resources-pathname was using short-site-name for this purpose
   #+excl (short-site-name)
-  #+ecl (si:getenv "HOST")
   #+clisp (let ((s (machine-instance))) (subseq s 0 (position #\Space s)))
   #-(or excl cmu sbcl ecl clisp) (error "get-host-name not implemented"))
 
@@ -3001,38 +2840,6 @@ Returns a list of (host display-number screen protocol)."
 (si:define-gc-cleanup clx-cleanup ("CLX Cleanup")
   (gc-cleanup))
 
-
-;;-----------------------------------------------------------------------------
-;; WITH-STANDARD-IO-SYNTAX equivalent, used in (SETF WM-COMMAND)
-;;-----------------------------------------------------------------------------
-
-#-(or clx-ansi-common-lisp Genera CMU sbcl)
-(defun with-standard-io-syntax-function (function)
-  (declare #+lispm
-	   (sys:downward-funarg function))
-  (let ((*package* (find-package :user))
-	(*print-array* t)
-	(*print-base* 10)
-	(*print-case* :upcase)
-	(*print-circle* nil)
-	(*print-escape* t)
-	(*print-gensym* t)
-	(*print-length* nil)
-	(*print-level* nil)
-	(*print-pretty* nil)
-	(*print-radix* nil)
-	(*read-base* 10)
-	(*read-default-float-format* 'single-float)
-	(*read-suppress* nil)
-	#+ticl (ticl:*print-structure* t)
-	#+lucid (lucid::*print-structure* t))
-    (funcall function)))
-
-#-(or clx-ansi-common-lisp Genera CMU sbcl)
-(defmacro with-standard-io-syntax (&body body)
-  `(flet ((.with-standard-io-syntax-body. () ,@body))
-     (with-standard-io-syntax-function #'.with-standard-io-syntax-body.)))
-
 
 ;;-----------------------------------------------------------------------------
 ;; DEFAULT-KEYSYM-TRANSLATE
@@ -3049,7 +2856,7 @@ Returns a list of (host display-number screen protocol)."
 ;;; When MASK-MODIFIERS is missing, all other modifiers are ignored.
 ;;; In ambiguous cases, the most specific translation is used.
 
-#-(or (and clx-ansi-common-lisp (not lispm) (not allegro)) CMU sbcl)
+#+lispm
 (defun default-keysym-translate (display state object)
   (declare (type display display)
 	   (type card16 state)
@@ -3072,7 +2879,7 @@ Returns a list of (host display-number screen protocol)."
       (setf (char-bit object :hyper) 1)))
   object)
 
-#+(or (and clx-ansi-common-lisp (not lispm) (not allegro)) CMU sbcl clisp)
+#-lispm
 (defun default-keysym-translate (display state object)
   (declare (type display display)
 	   (type card16 state)
diff --git a/src/clx/display.lisp b/src/clx/display.lisp
index c9e1ab5e45acef0467f1fb13dad947523ac9b6c6..b96357d1a34f8126bee31a00305bf92a257d5b17 100644
--- a/src/clx/display.lisp
+++ b/src/clx/display.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: display.lisp,v 1.16 2010/11/16 19:13:55 rtoy Exp $")
-
 (in-package :xlib)
 
 ;;; Authorizaton
@@ -64,7 +61,8 @@
       (if (null family-id)
           (list nil nil nil nil nil)
           (let* ((address-data (read-short-length-vector stream))
-                 (number (parse-integer (read-short-length-string stream)))
+                 (num-string (read-short-length-string stream))
+                 (number (when (string/= num-string "") (parse-integer num-string)))
                  (name (read-short-length-string stream))
                  (data (read-short-length-vector stream))
                  (family (car (rassoc family-id *protocol-families*))))
@@ -117,10 +115,8 @@
 		 (read-xauth-entry stream)
 	       (unless family (return))
 	       (when (and (eql family protocol)
-			  (or (equal host-address address)
-			      (and (eql family :local)
-				   (equal address "localhost")))
-			  (= number display)
+			  (equal host-address address)
+			  (or (null number) (= number display))
 			  (let ((pos1 (position name *known-authorizations*
 						:test #'string=)))
 			    (and pos1
@@ -328,7 +324,6 @@
 		   ,@body)))
      ,(if (and (null inline) (macroexpand '(use-closures) env))
 	  `(flet ((.with-event-queue-body. () ,@body))
-	     #+clx-ansi-common-lisp
 	     (declare (dynamic-extent #'.with-event-queue-body.))
 	     (with-event-queue-function
 	       ,display ,timeout #'.with-event-queue-body.))
@@ -344,12 +339,9 @@
   (declare (type display display)
 	   (type (or null number) timeout)
 	   (type function function)
-	   #+clx-ansi-common-lisp
 	   (dynamic-extent function)
 	   ;; FIXME: see SBCL bug #243
-	   (ignorable display timeout)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg function))
+	   (ignorable display timeout))
   (with-event-queue (display :timeout timeout :inline t)
     (funcall function)))
 
@@ -390,38 +382,38 @@ gethostname(3) - is used instead."
   ;; if any, is assumed to come from the environment somehow.
   (declare (type integer display))
   (declare (clx-values display))
-  (let ((protocol
-         (if (member host '("" "unix") :test #'equal)
-             :local
-             protocol)))
-    ;; Get the authorization mechanism from the environment.  Handle the
-    ;; special case of a host name of "" and "unix" which means the
-    ;; protocol is :local
-    (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 (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)
-	     (when (assoc "BIG-REQUESTS" (display-extension-alist disp)
-			  :test #'string=)
-	       (enable-big-requests disp))
-	     (setq ok-p t))
-	(unless ok-p (close-display disp :abort t)))
-      disp)))
+  ;; Get the authorization mechanism from the environment.  Handle the
+  ;; special case of a host name of "" and "unix" which means the
+  ;; protocol is :local
+  (when (null authorization-name)
+    (multiple-value-setq (authorization-name authorization-data)
+      (get-best-authorization host
+			      display
+			      (if (member host '("" "unix") :test #'equal)
+				  :local
+				  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 (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)
+	  (when (assoc "BIG-REQUESTS" (display-extension-alist disp)
+		       :test #'string=)
+	    (enable-big-requests disp))
+	  (setq ok-p t))
+      (unless ok-p (close-display disp :abort t)))
+    disp))
 
 (defun display-force-output (display)
   ; Output is normally buffered, this forces any buffered output to the server.
diff --git a/src/clx/excldefsys.lisp b/src/clx/excldefsys.lisp
index 379c4f971eef356fe9606b3cb718cbb1af99a475..abbc5dc7135111047aee6bc8d6d918ed37389bac 100644
--- a/src/clx/excldefsys.lisp
+++ b/src/clx/excldefsys.lisp
@@ -11,9 +11,6 @@
 ;;; implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id")
-
 (in-package :xlib :use '(:foreign-functions :lisp :excl))
 
 #+allegro
diff --git a/src/clx/excldep.lisp b/src/clx/excldep.lisp
index b5ea9c5b69a76ce22fa44868219b741c0dc78286..940a70f7cdfb642103496a8998a09e61c2c19813 100644
--- a/src/clx/excldep.lisp
+++ b/src/clx/excldep.lisp
@@ -13,9 +13,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: excldep.lisp,v 1.5 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (eval-when (compile load eval)
diff --git a/src/clx/big-requests.lisp b/src/clx/extensions/big-requests.lisp
similarity index 93%
rename from src/clx/big-requests.lisp
rename to src/clx/extensions/big-requests.lisp
index a854866a350479932e228110cf3f2bc99ccfb50b..ea566514589df07224062ce9ee57b47905a359e3 100644
--- a/src/clx/big-requests.lisp
+++ b/src/clx/extensions/big-requests.lisp
@@ -12,9 +12,6 @@
 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
-#+cmu
-(ext:file-comment "$Id: big-requests.lisp,v 1.2 2009/06/17 18:22:45 rtoy Rel $")
-
 (in-package "XLIB")
 
 ;;; No new events or errors are defined by this extension.  (Big
diff --git a/src/clx/dpms.lisp b/src/clx/extensions/dpms.lisp
similarity index 98%
rename from src/clx/dpms.lisp
rename to src/clx/extensions/dpms.lisp
index 669dd516a8c28789ae766596ad7c0eccf62a7305..6ee33bc3a391e74842c1ecc9ca511bc7e3390443 100644
--- a/src/clx/dpms.lisp
+++ b/src/clx/extensions/dpms.lisp
@@ -13,10 +13,7 @@
 ;;;;  any purpose of the information in this document.  This documentation is
 ;;;;  provided ``as is'' without express or implied warranty.
 
-#+cmu
-(ext:file-comment "$Id: dpms.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
-
-(defpackage :dpms
+(defpackage #:xlib/dpms
   (:use :common-lisp)
   (:import-from :xlib
                 "DEFINE-EXTENSION"
@@ -39,7 +36,7 @@
            "DPMS-FORCE-LEVEL"
            "DPMS-INFO"))
 
-(in-package :dpms)
+(in-package #:xlib/dpms)
 
 (define-extension "DPMS")
 
diff --git a/src/clx/gl.lisp b/src/clx/extensions/gl.lisp
similarity index 98%
rename from src/clx/gl.lisp
rename to src/clx/extensions/gl.lisp
index 1d7582d1def0ef4daac13eec9b364ce61907e20e..241c06609d2d20370ea469834789bc9a511388d9 100644
--- a/src/clx/gl.lisp
+++ b/src/clx/extensions/gl.lisp
@@ -1,9 +1,6 @@
-#+cmu
-(ext:file-comment "$Id: gl.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
-
-(defpackage :gl
+(defpackage #:xlib/gl
   (:use :common-lisp :xlib)
-  (:import-from :glx
+  (:import-from :xlib/glx
                 "*CURRENT-CONTEXT*"
                 "CONTEXT"
                 "CONTEXT-P"
@@ -1156,7 +1153,7 @@
            ))
 
 
-(in-package :gl)
+(in-package #:xlib/gl)
 
 
 
@@ -2138,6 +2135,27 @@
   value)
 
 
+#+lispworks
+(progn
+  (defun %single-float-bits (x)
+    (declare (type single-float x))
+    (fli:with-dynamic-foreign-objects ((bits :int32))
+      (fli:with-coerced-pointer (pointer :type :lisp-single-float) bits
+        (setf (fli:dereference pointer) x))
+      (fli:dereference bits)))
+
+  (declaim (notinline aset-float32))
+  (defun aset-float32 (value array index)
+    (declare (type (or short-float single-float) value)
+             (type buffer-bytes array)
+             (type array-index index))
+    #.(declare-buffun)
+    (let ((bits (%single-float-bits (coerce value 'single-float))))
+      (declare (type (unsigned-byte 32) bits))
+      (aset-card32 bits array index))
+    value))
+
+
 #+sbcl
 (defun aset-float64 (value array index)
   (declare (type double-float value)
@@ -2180,6 +2198,36 @@
   value)
 
 
+#+lispworks
+(progn
+  (fli:define-c-struct %uint64
+    (high :uint32)
+    (low :uint32))
+
+  (defun %double-float-bits (x)
+    (declare (type double-float x))
+    (fli:with-dynamic-foreign-objects ((bits %uint64))
+      (fli:with-coerced-pointer (pointer :type :lisp-double-float) bits
+        (setf (fli:dereference pointer) x))
+
+      (values (fli:foreign-slot-value bits 'low :type :uint32 :object-type '%uint64)
+              (fli:foreign-slot-value bits 'high :type :uint32 :object-type '%uint64))))
+
+  (declaim (notinline aset-float64))
+  (defun aset-float64 (value array index)
+    (declare (type double-float value)
+             (type buffer-bytes array)
+             (type array-index index))
+    #.(declare-buffun)
+    (multiple-value-bind (low high)
+        (%double-float-bits value)
+      (declare (type (unsigned-byte 32) low high))
+
+      (aset-card32 low array index)
+      (aset-card32 high array (the array-index (+ index 4))))
+    value))
+
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defun byte-width (type)
   (ecase type
@@ -2593,7 +2641,7 @@
                                   #.+convolution-width+
                                   #.+convolution-height+
                                   #.+max-convolution-width+
-                                  #.+max-convolution-width+)
+                                  #.+max-convolution-height+)
                                  1)
                                 ((#.+convolution-filter-scale+
                                   #.+convolution-filter-bias+)
@@ -2619,7 +2667,7 @@
                                 #.+convolution-width+
                                 #.+convolution-height+
                                 #.+max-convolution-width+
-                                #.+max-convolution-width+)
+                                #.+max-convolution-height+)
                                1)
                               ((#.+convolution-filter-scale+
                                 #.+convolution-filter-bias+)
diff --git a/src/clx/glx.lisp b/src/clx/extensions/glx.lisp
similarity index 99%
rename from src/clx/glx.lisp
rename to src/clx/extensions/glx.lisp
index b5c275035c51c73f4fb00c127d797871b26084be..35f723e07afe47781cbc7b262f74484459ae6b4e 100644
--- a/src/clx/glx.lisp
+++ b/src/clx/extensions/glx.lisp
@@ -1,7 +1,4 @@
-#+cmu
-(ext:file-comment "$Id: glx.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
-
-(defpackage :glx
+(defpackage #:xlib/glx
   (:use :common-lisp :xlib)
   (:import-from :xlib
                 "DEFINE-ACCESSOR"
@@ -72,11 +69,11 @@
            ))
 
 
-(in-package :glx)
-
-
-(declaim (optimize (debug 3) (safety 3)))
+(in-package #:xlib/glx)
 
+;;; Generally don't want this declamation to have load-time effects
+(eval-when (:compile-toplevel)
+  (declaim (optimize (debug 3) (safety 3))))
 
 (define-extension "GLX"
     :events (:glx-pbuffer-clobber)
@@ -599,7 +596,7 @@ Example: '(:glx-rgba (:glx-alpha-size 4) :glx-double-buffer (:glx-class 4 =)."
   (let* ((ctx *current-context*)
          (display (context-display ctx)))
     ;; Make sure all rendering commands are sent away.
-    (glx:render)
+    (render)
     (with-buffer-request (display (extension-opcode display "GLX"))
       (data +swap-buffers+)
       ;; *** GLX_CONTEXT_TAG
diff --git a/src/clx/screensaver.lisp b/src/clx/extensions/screensaver.lisp
similarity index 100%
rename from src/clx/screensaver.lisp
rename to src/clx/extensions/screensaver.lisp
diff --git a/src/clx/shape.lisp b/src/clx/extensions/shape.lisp
similarity index 98%
rename from src/clx/shape.lisp
rename to src/clx/extensions/shape.lisp
index 5804a8a34824941e38b7b1eb9d57a21961ab004d..6171c67ca1efc501fbeba24a8dc39dfe16c41794 100644
--- a/src/clx/shape.lisp
+++ b/src/clx/extensions/shape.lisp
@@ -20,9 +20,6 @@
 ;;; Use xc/doc/hardcopy/Xext/shape.PS.gz obtainable from e.g.
 ;;  ftp://ftp.xfree86.org/pub/XFree86/current/untarred/xc/hardcopy/Xext/shape.PS.gz
 
-#+cmu
-(ext:file-comment "$Id: shape.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (export '(shape-query-version
diff --git a/src/clx/xinerama.lisp b/src/clx/extensions/xinerama.lisp
similarity index 98%
rename from src/clx/xinerama.lisp
rename to src/clx/extensions/xinerama.lisp
index ee688e64b404e0d4c04317ac173337d3f83162f3..3bb404c650bc704e14c8e4be2f25ea16e10cdcd2 100644
--- a/src/clx/xinerama.lisp
+++ b/src/clx/extensions/xinerama.lisp
@@ -12,7 +12,7 @@
 ;;; This is an implementation of the XINERAMA extension. It does not
 ;;; include the obsolete PanoramiX calls.
 
-(defpackage "XLIB.XINERAMA"
+(defpackage #:xlib/xinerama
   (:use "COMMON-LISP" "XLIB")
   (:nicknames "XINERAMA")
   (:import-from "XLIB"
@@ -33,7 +33,7 @@
            "XINERAMA-QUERY-VERSION"
            "XINERAMA-IS-ACTIVE"
            "XINERAMA-QUERY-SCREENS"))
-(in-package "XINERAMA")
+(in-package #:xlib/xinerama)
 
 (define-extension "XINERAMA")
 
diff --git a/src/clx/xrender.lisp b/src/clx/extensions/xrender.lisp
similarity index 92%
rename from src/clx/xrender.lisp
rename to src/clx/extensions/xrender.lisp
index a0b3b961ba6e4a8c325309ae135b6047933a2439..6713668c01a2ba48d85461a6e904c4b7c45f0c0f 100644
--- a/src/clx/xrender.lisp
+++ b/src/clx/extensions/xrender.lisp
@@ -3,8 +3,7 @@
 ;;;     Title: The X Render Extension
 ;;;   Created: 2002-08-03
 ;;;    Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
-#+cmu
-(ext:file-comment "$Id: xrender.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
+;;;       $Id: xrender.lisp,v 1.5 2004/12/06 11:48:57 csr21 Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;
 ;;; (c) copyright 2002, 2003 by Gilbert Baumann
@@ -128,6 +127,8 @@
           render-query-version
           ;; render-query-picture-formats
           render-fill-rectangle
+          render-triangles
+          render-trapezoids
           render-composite
           render-create-glyph-set
           render-reference-glyph-set
@@ -196,6 +197,24 @@
 ;; We do away with the distinction between pict-format and
 ;; picture-format-info. That is we cache picture-format-infos.
 
+(defstruct picture-format
+  display 
+  (id   0 :type (unsigned-byte 29))
+  type
+  depth
+  red-byte
+  green-byte
+  blue-byte
+  alpha-byte
+  colormap)
+
+(def-clx-class (glyph-set (:copier nil)
+                        )
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  (plist nil :type list)                ; Extension hook
+  (format))
+
 (defstruct render-info
   major-version
   minor-version
@@ -298,17 +317,6 @@ by every function, which attempts to generate RENDER requests."
 
 ;;; picture format
 
-(defstruct picture-format
-  display 
-  (id   0 :type (unsigned-byte 29))
-  type
-  depth
-  red-byte
-  green-byte
-  blue-byte
-  alpha-byte
-  colormap)
-
 (defmethod print-object ((object picture-format) stream)
   (let ((abbrev
          (with-output-to-string (bag)
@@ -517,13 +525,15 @@ by every function, which attempts to generate RENDER requests."
   (let ((display (picture-display picture)))
     (with-buffer-request (display (extension-opcode display "RENDER"))
       (data +X-RenderFreePicture+)
-      (picture  picture))))
+      (picture  picture))
+    (deallocate-resource-id display (picture-id picture) 'picture)))
 
 (defun render-free-glyph-set (glyph-set)
   (let ((display (glyph-set-display glyph-set)))
     (with-buffer-request (display (extension-opcode display "RENDER"))
       (data +X-RenderFreeGlyphSet+)
-      (glyph-set  glyph-set))))
+      (glyph-set  glyph-set))
+    (deallocate-resource-id display (glyph-set-id glyph-set) 'glyph-set)))
 
 (defun render-query-version (display)
   (with-buffer-request-and-reply (display (extension-opcode display "RENDER") nil)
@@ -570,16 +580,16 @@ by every function, which attempts to generate RENDER requests."
     (synchronise-picture-state picture)
     (with-buffer-request (display (extension-opcode display "RENDER"))
       (data +X-RenderFillRectangles+)
-      (render-op op)                         ;op
-      (card8 0)                        ;pad
-      (card16 0)                        ;pad
+      (render-op op)
+      (pad8 0)
+      (pad16 0)
       (resource-id (picture-id picture))
       (card16 (elt color 0)) (card16 (elt color 1)) (card16 (elt color 2)) (card16 (elt color 3))
       (int16 x1) (int16 y1) (card16 w) (card16 h))))
 
 ;; fill rectangles, colors.
 
-(defun render-triangles-1 (picture op source src-x src-y format coord-sequence)
+(defun render-triangles (picture op source src-x src-y format coord-sequence)
   ;; For performance reasons we do a special typecase on (simple-array
   ;; (unsigned-byte 32) (*)), so that it'll be possible to have high
   ;; performance rasters.
@@ -587,17 +597,18 @@ by every function, which attempts to generate RENDER requests."
                '(let ((display (picture-display picture)))
                  (synchronise-picture-state picture)
                  (synchronise-picture-state source)
-                 (with-buffer-request (display (extension-opcode display "RENDER"))
-                   (data +X-RenderTriangles+)
-                   (render-op op)                       ;op
-                   (card8 0)                            ;pad
-                   (card16 0)                           ;pad
-                   (resource-id (picture-id source))
-                   (resource-id (picture-id picture))
-                   (picture-format format)
-                   (int16 src-x)
-                   (int16 src-y)
-                   ((sequence :format int32) coord-sequence) ))))
+                 (labels ((funk (x) (ash x 16)))
+                   (with-buffer-request (display (extension-opcode display "RENDER"))
+                     (data +X-RenderTriangles+)
+                     (render-op op)
+                     (pad8 0)
+                     (pad16 0)
+                     (resource-id (picture-id source))
+                     (resource-id (picture-id picture))
+                     (picture-format format)
+                     (int16 src-x)
+                     (int16 src-y)
+                     ((sequence :format int32 :transform #'funk) coord-sequence))))))
     (typecase coord-sequence
       ((simple-array (unsigned-byte 32) (*))
        (locally
@@ -694,7 +705,7 @@ by every function, which attempts to generate RENDER requests."
       (data +X-RenderSetPictureFilter+)
       (resource-id (picture-id picture))
       (card16 (length filter))
-      (card16 0)                        ;pad
+      (pad16 0)
       ((sequence :format card8) (map 'vector #'char-code filter)))))
   
 
@@ -705,25 +716,26 @@ by every function, which attempts to generate RENDER requests."
   )
 ||#
 
-(defun render-trapezoids-1 (picture op source src-x src-y mask-format coord-sequence)
+(defun render-trapezoids (picture op source src-x src-y mask-format coord-sequence)
   ;; coord-sequence is  top bottom
-  ;;                    line-1-x1 line-1-y1 line-1-x2 line-1-y2
-  ;;                    line-2-x1 line-2-y1 line-2-x2 line-2-y2 ...
+  ;;                    left-x1 left-y1 left-x2 left-y2
+  ;;                    right-x1 right-y1 right-x2 right-y2 ...
   ;;
   (let ((display (picture-display picture)))
     (synchronise-picture-state picture)
     (synchronise-picture-state source)
-    (with-buffer-request (display (extension-opcode display "RENDER"))
-      (data +X-RenderTrapezoids+)
-      (render-op op)                    ;op
-      (card8 0)                         ;pad
-      (card16 0)                        ;pad
-      (resource-id (picture-id source))
-      (resource-id (picture-id picture))
-      ((or (member :none) picture-format) mask-format)
-      (int16 src-x)
-      (int16 src-y)
-      ((sequence :format int32) coord-sequence) )))
+    (labels ((funk (x) (ash x 16)))
+      (with-buffer-request (display (extension-opcode display "RENDER"))
+        (data +X-RenderTrapezoids+)
+        (render-op op)
+        (pad8 0)
+        (pad16 0)
+        (resource-id (picture-id source))
+        (resource-id (picture-id picture))
+        ((or (member :none) picture-format) mask-format)
+        (int16 src-x)
+        (int16 src-y)
+        ((sequence :format int32 :transform #'funk) coord-sequence)))))
 
 (defun render-composite (op
                          source mask dest
@@ -735,9 +747,9 @@ by every function, which attempts to generate RENDER requests."
     (synchronise-picture-state dest)
     (with-buffer-request (display (extension-opcode display "RENDER"))
       (data +X-RenderComposite+)
-      (render-op op)                         ;op
-      (card8 0)                         ;pad
-      (card16 0)                        ;pad
+      (render-op op)
+      (pad8 0)
+      (pad16 0)
       (resource-id (picture-id source))
       (resource-id (if mask (picture-id mask) 0))
       (resource-id (picture-id dest))
@@ -750,13 +762,6 @@ by every function, which attempts to generate RENDER requests."
       (card16 width)
       (card16 height))))
 
-(def-clx-class (glyph-set (:copier nil)
-                        )
-  (id 0 :type resource-id)
-  (display nil :type (or null display))
-  (plist nil :type list)                ; Extension hook
-  (format))
-
 (defun render-create-glyph-set (format &key glyph-set)
   (let ((display (picture-format-display format)))
     (let* ((glyph-set (or glyph-set (make-glyph-set :display display)))
@@ -803,14 +808,16 @@ by every function, which attempts to generate RENDER requests."
     (with-buffer-request (display (extension-opcode display "RENDER"))
       (data +X-RenderCompositeGlyphs8+)
       (render-op alu)
-      (card8 0) (card16 0)              ;padding
+      (pad8 0)
+      (pad16 0)
       (picture source)
       (picture dest)
       ((or (member :none) picture-format) mask-format)
       (glyph-set glyph-set)
       (int16 src-x) (int16 src-y)
       (card8 (- end start)) ;length of glyph elt
-      (card8 0) (card16 0) ;padding
+      (pad8 0)
+      (pad16 0)
       (int16 dest-x) (int16 dest-y)             ;dx, dy
       ((sequence :format card8) sequence))))
 
@@ -832,7 +839,8 @@ by every function, which attempts to generate RENDER requests."
 	   (data ,opcode)
 	   (length request-length)
 	   (render-op ,alu)
-	   (card8 0) (card16 0)                        ;padding
+           (pad8 0)
+	   (pad16 0)
 	   (picture ,source)
 	   (picture ,dest)
 	   ((or (member :none) picture-format) ,mask-format)
@@ -931,17 +939,27 @@ by every function, which attempts to generate RENDER requests."
            (unit (bitmap-format-unit bitmap-format))
            (byte-lsb-first-p (display-image-lsb-first-p display))
            (bit-lsb-first-p  (bitmap-format-lsb-first-p bitmap-format)))
-      (let* ((byte-per-line (* 4 (ceiling 
-				  (* w (picture-format-depth (glyph-set-format glyph-set)))
-				  32)))
-             (request-length (+ 28
-				(* h byte-per-line))))
+      (let* ((padded-bytes-per-line
+              (index* (index-ceiling
+                       (index* w (picture-format-depth
+                                  (glyph-set-format glyph-set)))
+                       32)
+                      4))
+             (request-bytes
+              (index+ 28 (index* h padded-bytes-per-line)))
+             (max-bytes-per-request
+              (index* (index- (display-max-request-length display) 6) 4)))
+        ;; INV: we can do better – if at least one scanline of the
+        ;; image fits in the request, we may render glyph in a loop
+        ;; like it's done in a function `put-image' in `image.lisp'.
+        (when (> request-bytes max-bytes-per-request)
+          (error "Glyph won't fit in a single request"))
         (with-buffer-request (display (extension-opcode display "RENDER"))
           (data +X-RenderAddGlyphs+)
-          (length (ceiling request-length 4))
+          (length (ceiling request-bytes 4))
           (glyph-set glyph-set)
-          (card32 1) ;number glyphs
-          (card32 id) ;id
+          (card32 1)                    ;number glyphs
+          (card32 id)                   ;id
           (card16 w)
           (card16 h)
           (int16 x-origin)
@@ -952,7 +970,7 @@ by every function, which attempts to generate RENDER requests."
             (setf (buffer-boffset display) (advance-buffer-offset 28))
             (let ((im (create-image :width w :height h :depth 8 :data data)))
               (write-image-z display im 0 0 w h
-                             byte-per-line ;padded bytes per line
+                             padded-bytes-per-line
                              unit byte-lsb-first-p bit-lsb-first-p)) ))) )))
 
 (defun render-add-glyph-from-picture (glyph-set picture
@@ -1153,3 +1171,21 @@ by every function, which attempts to generate RENDER requests."
         (card16 x)
         (card16 y))
       cursor)))
+
+(defun render-create-anim-cursor (cursors delays)
+  "Create animated cursor. cursors length must be the same as delays length."
+  (let ((display (cursor-display (first cursors))))
+    (ensure-render-initialized display)
+    (let* ((cursor (make-cursor :display display))
+           (cid (allocate-resource-id display cursor 'cursor))
+           (cursors-length (length cursors))
+           (cursors-delays (make-list (* 2 (length cursors)))))
+      (setf (xlib:cursor-id cursor) cid)
+      (dotimes (i cursors-length)
+        (setf (elt cursors-delays (* 2 i)) (cursor-id (elt cursors i))
+              (elt cursors-delays (1+ (* 2 i))) (elt delays i)))
+      (xlib::with-buffer-request (display (extension-opcode display "RENDER"))
+        (data +X-RenderCreateAnimCursor+)
+        (resource-id cid)
+        ((sequence :format card32) cursors-delays))
+      cursor)))
diff --git a/src/clx/xtest.lisp b/src/clx/extensions/xtest.lisp
similarity index 98%
rename from src/clx/xtest.lisp
rename to src/clx/extensions/xtest.lisp
index 587a845b8d4b321c2d4eb113d2a5e32e044469ef..6c543e9e1303b09adf48fdec9f1a7d09549a54ab 100644
--- a/src/clx/xtest.lisp
+++ b/src/clx/extensions/xtest.lisp
@@ -10,7 +10,7 @@
 ;;; * Implement XTestSetVisualIDOfVisual and XTestDiscard
 ;;; * Add the missing (declare (type ...
 
-(defpackage :xtest
+(defpackage #:xlib/xtest
   (:use :common-lisp :xlib)
   (:import-from :xlib
                 #:data
@@ -44,7 +44,7 @@
    #:fake-key-event
    #:grab-control))
 
-(in-package :xtest)
+(in-package #:xlib/xtest)
 
 (define-extension "XTEST")
 
diff --git a/src/clx/xvidmode.lisp b/src/clx/extensions/xvidmode.lisp
similarity index 99%
rename from src/clx/xvidmode.lisp
rename to src/clx/extensions/xvidmode.lisp
index a58b38b078e274118949a86c535d8623d3877a10..783f1fa99881ff9e470d5fe5f3e5941346f948e8 100644
--- a/src/clx/xvidmode.lisp
+++ b/src/clx/extensions/xvidmode.lisp
@@ -35,9 +35,6 @@
 ;;; constructed as well as to indentify any obsolete/wrong 
 ;;; functions I made.
 
-#+cmu
-(ext:file-comment "$Id: xvidmode.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (export '(mode-info
@@ -176,6 +173,14 @@
 	(error "screen ~A not found in display ~A" screen display)
 	position)))
 
+(declaim (inline __card32->card16__))
+(defun __card32->card16__ (i)
+  (declare (type card32 i))
+  #+clx-little-endian
+  (progn (values (ldb (byte 16 0) i) (ldb (byte 32 16) i)))
+  #-clx-little-endian
+  (progn (values (ldb (byte 32 16) i) (ldb (byte 16 0) i))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;                                                                       ;;;;
 ;;;;              public XFree86-VidMode Extension routines                ;;;;
@@ -723,11 +728,3 @@ x and y keyword parameters value (zero will be theire default value)."
 		   (setf (svref v (incf index)) w1
 			 (svref v (incf index)) w2))))
       v)))
-
-(declaim (inline __card32->card16__))
-(defun __card32->card16__ (i)
-  (declare (type card32 i))
-  #+clx-little-endian
-  (progn (values (ldb (byte 16 0) i) (ldb (byte 32 16) i)))
-  #-clx-little-endian
-  (progn (values (ldb (byte 32 16) i) (ldb (byte 16 0) i))))
diff --git a/src/clx/fonts.lisp b/src/clx/fonts.lisp
index a9225fa4ddffe6b45f3166a8573e69bebc175f98..d00e4b8a7a110ffce27ad090fb7227e2e3553d23 100644
--- a/src/clx/fonts.lisp
+++ b/src/clx/fonts.lisp
@@ -16,9 +16,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: fonts.lisp,v 1.7 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 ;; The char-info stuff is here instead of CLX because of uses of int16->card16.
@@ -255,7 +252,8 @@
       (setf (display-font-cache display) (delete font (display-font-cache display)))
       ;; Close the font
       (with-buffer-request (display +x-closefont+)
-	(resource-id id)))))
+	(resource-id id))
+      (deallocate-resource-id display id 'font))))
 
 (defun list-font-names (display pattern &key (max-fonts 65535) (result-type 'list))
   (declare (type display display)
diff --git a/src/clx/gcontext.lisp b/src/clx/gcontext.lisp
index 052d16b3e1d196673095d025f8de3ace2960e26b..23d6a22ffb69ec3844eef65d742d46fbb54ea1ab 100644
--- a/src/clx/gcontext.lisp
+++ b/src/clx/gcontext.lisp
@@ -42,9 +42,6 @@
 ;;;	because they don't run in a multi-processing shared-address space
 ;;;	environment.
 
-#+cmu
-(ext:file-comment "$Id: gcontext.lisp,v 1.9 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 ;; GContext state accessors
diff --git a/src/clx/generalock.lisp b/src/clx/generalock.lisp
index 21c25705e3cec0f61bfab4872c6d3cb03101b7ff..cbf95a38a5e5502053b658d8db6c6421455394ea 100644
--- a/src/clx/generalock.lisp
+++ b/src/clx/generalock.lisp
@@ -10,9 +10,6 @@
 ;;; Symbolics, Inc. provides this software "as is" without
 ;;; express or implied warranty.
 
-#+cmu
-(ext:file-comment "$Id: generalock.lisp,v 1.5 2009/06/17 18:22:46 rtoy Rel $")
-
 (defflavor xlib::clx-lock () (simple-recursive-normal-lock)
   (:init-keywords :flavor))
 
diff --git a/src/clx/graphics.lisp b/src/clx/graphics.lisp
index b9498489ad1e56616489013dd0e0332d39fe4735..9f3f327ed8ab8b796cb9b07f6bc4e331d9858409 100644
--- a/src/clx/graphics.lisp
+++ b/src/clx/graphics.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: graphics.lisp,v 1.7 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (defvar *inhibit-appending* nil)
diff --git a/src/clx/image.lisp b/src/clx/image.lisp
index 882f8c2209a398ef69df7e217793a0d738632ff1..8eb47af3386457be4cd4a5fc0c5dcc4aa5e78f54 100644
--- a/src/clx/image.lisp
+++ b/src/clx/image.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: image.lisp,v 1.13 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (defmacro with-image-data-buffer ((buffer size) &body body)
diff --git a/src/clx/input.lisp b/src/clx/input.lisp
index 7ee2adc6cc843ffa42cc2b6f7ef29a4b6af7f901..50a448d5a119393226052c1273384841287cf7ae 100644
--- a/src/clx/input.lisp
+++ b/src/clx/input.lisp
@@ -25,9 +25,6 @@
 ;;; -------------------------------------------------------------------------------------
 ;;; 12/10/87	LGO	Created
 
-#+cmu
-(ext:file-comment "$Id: input.lisp,v 1.12 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 ;; Event Resource
@@ -391,10 +388,7 @@
 	   (type generalized-boolean force-output-p)
 	   (dynamic-extent predicate-args))
   (declare (type function predicate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent predicate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg predicate))
+	   (dynamic-extent predicate))
   (let ((reply-buffer nil)
 	(token (or (current-process) (cons nil nil))))
     (declare (type (or null reply-buffer) reply-buffer))
@@ -422,10 +416,7 @@
 			    (declare (type display display)
 				     (dynamic-extent predicate-args)
 				     (type function predicate)
-				     #+clx-ansi-common-lisp
-				     (dynamic-extent predicate)
-				     #+(and lispm (not clx-ansi-common-lisp))
-				     (sys:downward-funarg predicate))
+				     (dynamic-extent predicate))
 			    (or (apply predicate predicate-args)
 				(null (display-input-in-progress display))
 				(not (null (display-dead display)))))
@@ -766,10 +757,7 @@
 	     (declare (type display display)
 		      (type reply-buffer event))
 	     (declare (type function handler)
-		      #+clx-ansi-common-lisp
-		      (dynamic-extent handler)
-		      #+(and lispm (not clx-ansi-common-lisp))
-		      (sys:downward-funarg handler))
+		      (dynamic-extent handler))
 	     (reading-event (event :display display :sizes (8 16 ,@get-sizes))
 	       (funcall handler
 			:display display
@@ -1180,10 +1168,7 @@
 	   (type (or null number) timeout)
 	   (type generalized-boolean peek-p discard-p force-output-p))
   (declare (type t handler)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent handler)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg #+Genera * #-Genera handler))
+	   (dynamic-extent handler))
   (event-loop (display event timeout force-output-p discard-p)
     (let* ((event-code (event-code event)) ;; Event decoder defined by DECLARE-EVENT
 	   (event-decoder (and (index< event-code (length *event-handler-vector*))
@@ -1536,17 +1521,6 @@
       (when (= code (second extension))
 	(return (first extension))))))
 
-#-(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)
-   (major :reader request-error-major)
-   (minor :reader request-error-minor)
-   (sequence :reader request-error-sequence)
-   (current-sequence :reader request-error-current-sequence)
-   (asynchronous :reader request-error-asynchronous))
-  (:report report-request-error))
-
 (defun report-request-error (condition stream)
   (let ((error-key (request-error-error-key condition))
 	(asynchronous (request-error-asynchronous condition))
@@ -1561,7 +1535,6 @@
 
 ;; 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 CMU)
 (define-condition request-error (x-error)
   ((display :reader request-error-display :initarg :display)
    (error-key :reader request-error-error-key :initarg :error-key)
diff --git a/src/clx/keysyms.lisp b/src/clx/keysyms.lisp
index f63f5d09d0a3d79131ce8d7fa212f9773041dc0a..92fc5ec482b31357e4747292135ce423bb9c30bf 100644
--- a/src/clx/keysyms.lisp
+++ b/src/clx/keysyms.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: keysyms.lisp,v 1.6 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (define-keysym-set :latin-1	(keysym 0 0) (keysym 0 255))
diff --git a/src/clx/macros.lisp b/src/clx/macros.lisp
index cbf28d0c94c6cfc18044b86a74ad0b5ced349d53..8d9db3c8fbf47ee241dcb5e4636c2c9c0151b2af 100644
--- a/src/clx/macros.lisp
+++ b/src/clx/macros.lisp
@@ -25,9 +25,6 @@
 
 ;;; This is built on top of BUFFER
 
-#+cmu
-(ext:file-comment "$Id: macros.lisp,v 1.8 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (defmacro type-check (value type)
@@ -88,6 +85,7 @@
   ;; If no third body form is present, then these macros assume that
   ;; (AND (TYPEP ,thing 'type) (PUT-type ,thing)) can be generated.
   ;; these predicating puts are used by the OR accessor.
+  #-cmu
   (declare (arglist name (width) get-macro put-macro &optional predicating-put-macro))
   (when (cdddr get-put-macros)
     (error "Too many parameters to define-accessor: ~s" (cdddr get-put-macros)))
@@ -547,10 +545,7 @@
 
 (defun mask-get (index type-values body-function)
   (declare (type function body-function)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent body-function)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg body-function))
+	   (dynamic-extent body-function))
   ;; This is a function, because it must return more than one form (called by get-put-items)
   ;; Functions that use this must have a binding for %MASK
   (let* ((bit 0)
@@ -581,10 +576,7 @@
 
 (defun mask-put (index type-values body-function)
   (declare (type function body-function)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent body-function)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg body-function))
+	   (dynamic-extent body-function))
   ;; The MASK type writes a 32 bit mask with 1 bits for each non-nil value in TYPE-VALUES
   ;; A 32 bit value follows for each non-nil value.
   `((let ((%mask 0)
@@ -642,10 +634,7 @@
 
 (defun get-put-items (index type-args putp &optional body-function)
   (declare (type (or null function) body-function)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent body-function)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg body-function))
+	   (dynamic-extent body-function))
   ;; Given a lists of the form (type item item ... item)
   ;; Calls body-function with four arguments, a function name,
   ;; index, item name, and optional arguments.
@@ -715,7 +704,6 @@
 		(declare (type display .display.))
 		(with-buffer-request-internal (.display. ,opcode ,@options)
 		  ,@type-args)))
-	 #+clx-ansi-common-lisp
 	 (declare (dynamic-extent #'.request-body.))
 	 (,(if (eq (car (macroexpand '(with-buffer (buffer)) env)) 'progn)
 	       'with-buffer-request-function-nolock
@@ -755,7 +743,6 @@
 			   (type reply-buffer .reply-buffer.))
 		  (progn .display. .reply-buffer. nil)
 		  ,reply-body))
-	   #+clx-ansi-common-lisp
 	   (declare (dynamic-extent #'.request-body. #'.reply-body.))
 	   (with-buffer-request-and-reply-function
 	     ,buffer ,multiple-reply #'.request-body. #'.reply-body.))
diff --git a/src/clx/manager.lisp b/src/clx/manager.lisp
index 326223abbff20be24709a995f3867dde79c6f393..729ba00dbe6c9d56c4cc53624a01a45e0adb832a 100644
--- a/src/clx/manager.lisp
+++ b/src/clx/manager.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: manager.lisp,v 1.10 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (defun wm-name (window)
@@ -154,10 +151,11 @@
   wm-hints)
 
 (defun decode-wm-hints (vector display)
-  (declare (type (simple-vector 9) vector)
+  (declare (type (simple-vector *) vector)
 	   (type display display))
   (declare (clx-values wm-hints))
-  (let ((input-hint 0)
+  (let ((hint-mask (1- (ash 1 29)))
+	(input-hint 0)
 	(state-hint 1)
 	(icon-pixmap-hint 2)
 	(icon-window-hint 3)
@@ -182,12 +180,12 @@
       (when (logbitp icon-window-hint flags)
 	(setf (wm-hints-icon-window hints) (decode-type window (aref vector 4))))
       (when (logbitp icon-position-hint flags)
-	(setf (wm-hints-icon-x hints) (aref vector 5)
-	      (wm-hints-icon-y hints) (aref vector 6)))
+	(setf (wm-hints-icon-x hints) (logand hint-mask (aref vector 5))
+	      (wm-hints-icon-y hints) (logand hint-mask (aref vector 6))))
       (when (logbitp icon-mask-hint flags)
 	(setf (wm-hints-icon-mask hints) (decode-type pixmap (aref vector 7))))
       (when (and (logbitp window-group-hint flags) (> (length vector) 7))
-	(setf (wm-hints-window-group hints) (aref vector 8)))
+	(setf (wm-hints-window-group hints) (logand hint-mask (aref vector 8))))
       hints)))
 
 
@@ -313,8 +311,12 @@
 	(setf (wm-size-hints-width-inc hints) (aref vector 9)
 	      (wm-size-hints-height-inc hints) (aref vector 10)))
       (when (logbitp 7 flags)
-	(setf (wm-size-hints-min-aspect hints) (/ (aref vector 11) (aref vector 12))
-	      (wm-size-hints-max-aspect hints) (/ (aref vector 13) (aref vector 14))))
+        (let ((low (aref vector 12)))
+          (unless (zerop low)
+            (setf (wm-size-hints-min-aspect hints) (/ (aref vector 11) low))))
+        (let ((low (aref vector 14)))
+          (unless (zerop low)
+            (setf (wm-size-hints-max-aspect hints) (/ (aref vector 13) low)))))
       (when (> (length vector) 15)
 	;; This test is for backwards compatibility since old Xlib programs
 	;; can set a size-hints structure that is too small.  See ICCCM.
@@ -323,7 +325,13 @@
 		(wm-size-hints-base-height hints) (aref vector 16)))
 	(when (logbitp 9 flags)
 	  (setf (wm-size-hints-win-gravity hints)
-		(decode-type (member-vector +win-gravity-vector+) (aref vector 17)))))
+		;; many games don't initialize win-gravity correctly,
+		;; so we need to bring it to within the correct range
+		;; ICCCM specifies a default gravity of NorthWest
+		(let ((gravity (aref vector 17)))
+		  (if (< 0 gravity #.(length +win-gravity-vector+))
+		      (decode-type (member-vector +win-gravity-vector+) gravity)
+		      :north-west)))))
       ;; Obsolete fields
       (when (or (logbitp 0 flags) (logbitp 2 flags))
 	(setf (wm-size-hints-x hints) (card32->int32 (aref vector 1))
@@ -733,36 +741,7 @@
     (get-property root property :type type :result-type result-type
 		  :start start :end end :transform transform)))
 
-;; Implement the following:
-;; (defsetf cut-buffer (display &key (buffer 0) (type :string) (format 8)
-;;			        (transform #'char->card8) (start 0) end) (data)
-;; In order to avoid having to pass positional parameters to set-cut-buffer,
-;; We've got to do the following.  WHAT A PAIN...
-#-clx-ansi-common-lisp
-(define-setf-method cut-buffer (display &rest option-list)
-  (declare (dynamic-extent option-list))
-  (do* ((options (copy-list option-list))
-	(option options (cddr option))
-	(store (gensym))
-	(dtemp (gensym))
-	(temps (list dtemp))
-	(values (list display)))
-       ((endp option)
-	(values (nreverse temps)
-		(nreverse values)
-		(list store)
-		`(set-cut-buffer ,store ,dtemp ,@options)
-		`(cut-buffer ,@options)))
-    (unless (member (car option) '(:buffer :type :format :start :end :transform))
-      (error "Keyword arg ~s isn't recognized" (car option)))
-    (let ((x (gensym)))
-      (push x temps)
-      (push (cadr option) values)
-      (setf (cadr option) x))))
-
-(defun
-  #+clx-ansi-common-lisp (setf cut-buffer)
-  #-clx-ansi-common-lisp set-cut-buffer
+(defun (setf cut-buffer)
   (data display &key (buffer 0) (type :STRING) (format 8)
 	(start 0) end (transform #'char->card8))
   (declare (type sequence data)
diff --git a/src/clx/package.lisp b/src/clx/package.lisp
index 90665f38f8b8c064a965f9edce011ee4b270dab5..655090319847465699c8ce61ad4793baed08aea2 100644
--- a/src/clx/package.lisp
+++ b/src/clx/package.lisp
@@ -11,238 +11,26 @@
 ;;; publicity pertaining to distribution of the software without specific,
 ;;; written prior permission.
 
-#+cmu
-(ext:file-comment "$Id: package.lisp,v 1.9 2009/06/17 18:22:46 rtoy Rel $")
-
-;;; The CLtL way
-
-#-clx-ansi-common-lisp 
-(lisp:in-package :xlib :use '(:lisp))
-
-#+(and (or kcl ibcl) (not clx-ansi-common-lisp))
-(shadow 
-  '(
-    rational
-    ))
-
-#+(and CMU (not clx-ansi-common-lisp))
-(shadow '(define-condition))
-
-#+(and lispm (not clx-ansi-common-lisp))
-(import
-  '(
-    sys:arglist
-    sys:with-stack-list
-    sys:with-stack-list*
-    ))
-
-#+(and Genera (not clx-ansi-common-lisp))
-(import
-  '(
-    future-common-lisp:print-unreadable-object
-    future-common-lisp:with-standard-io-syntax
-    zwei:indentation
-    ))
-
-#+(and lcl3.0 (not clx-ansi-common-lisp))
-(import
-  '(
-    lcl:arglist
-    lcl:dynamic-extent
-    lcl:type-error
-    lucid::type-error-datum
-    lucid::type-error-expected-type
-    ))
-
-#+(and excl (not clx-ansi-common-lisp)) 
-(import
-  '(
-    excl::arglist
-    excl::dynamic-extent
-    excl::type-error
-    excl::type-error-datum
-    excl::type-error-expected-type
-    ))
-
-#+(and allegro (not clx-ansi-common-lisp))
-(import
-  '(
-    excl::without-interrupts
-    ))
-
-#-clx-ansi-common-lisp
-(export
-  '(
-    *version* access-control access-error access-hosts
-    activate-screen-saver add-access-host add-resource add-to-save-set
-    alist alloc-color alloc-color-cells alloc-color-planes alloc-error
-    allow-events angle arc-seq array-index atom-error atom-name
-    bell bit-gravity bitmap bitmap-format bitmap-format-lsb-first-p
-    bitmap-format-p bitmap-format-pad bitmap-format-unit bitmap-image
-    boole-constant boolean card16 card29 card32 card8
-    card8->char change-active-pointer-grab change-keyboard-control
-    change-keyboard-mapping change-pointer-control change-property
-    char->card8 char-ascent char-attributes char-descent
-    char-left-bearing char-right-bearing char-width character->keysyms
-    character-in-map-p circulate-window-down circulate-window-up clear-area
-    close-display close-down-mode close-font closed-display color
-    color-blue color-green color-p color-red color-rgb colormap
-    colormap-display colormap-equal colormap-error colormap-id colormap-p
-    colormap-plist colormap-visual-info connection-failure convert-selection
-    copy-area copy-colormap-and-free copy-gcontext copy-gcontext-components
-    copy-image copy-plane create-colormap create-cursor
-    create-gcontext create-glyph-cursor create-image create-pixmap
-    create-window cursor cursor-display cursor-equal cursor-error
-    cursor-id cursor-p cursor-plist cut-buffer declare-event decode-core-error
-    default-error-handler default-keysym-index default-keysym-translate
-    define-error define-extension define-gcontext-accessor
-    define-keysym define-keysym-set delete-property delete-resource
-    destroy-subwindows destroy-window device-busy device-event-mask
-    device-event-mask-class discard-current-event discard-font-info display
-    display-after-function display-authorization-data display-authorization-name
-    display-bitmap-format display-byte-order display-default-screen
-    display-display display-error-handler 
-    display-extended-max-request-length display-finish-output
-    display-force-output display-host display-image-lsb-first-p
-    display-invoke-after-function display-keycode-range display-max-keycode
-    display-max-request-length display-min-keycode display-motion-buffer-size
-    display-nscreens display-p display-pixmap-formats display-plist
-    display-protocol-major-version display-protocol-minor-version
-    display-protocol-version display-release-number
-    display-report-asynchronous-errors display-resource-id-base
-    display-resource-id-mask display-roots display-vendor
-    display-vendor-name display-xdefaults display-xid draw-arc
-    draw-arcs draw-direction draw-glyph draw-glyphs draw-image-glyph
-    draw-image-glyphs draw-line draw-lines draw-point draw-points
-    draw-rectangle draw-rectangles draw-segments drawable
-    drawable-border-width drawable-depth drawable-display drawable-equal
-    drawable-error drawable-height drawable-id drawable-p
-    drawable-plist drawable-root drawable-width drawable-x drawable-y
-    error-key event-case event-cond event-handler event-key
-    event-listen event-mask event-mask-class extension-opcode
-    find-atom font font-all-chars-exist-p font-ascent
-    font-default-char font-descent font-direction font-display
-    font-equal font-error font-id font-max-byte1 font-max-byte2
-    font-max-char font-min-byte1 font-min-byte2 font-min-char
-    font-name font-p font-path font-plist font-properties
-    font-property fontable force-gcontext-changes free-colormap
-    free-colors free-cursor free-gcontext free-pixmap gcontext
-    gcontext-arc-mode gcontext-background 
-    gcontext-cache-p gcontext-cap-style
-    gcontext-clip-mask gcontext-clip-ordering gcontext-clip-x
-    gcontext-clip-y gcontext-dash-offset gcontext-dashes gcontext-display
-    gcontext-equal gcontext-error gcontext-exposures gcontext-fill-rule
-    gcontext-fill-style gcontext-font gcontext-foreground gcontext-function
-    gcontext-id gcontext-join-style gcontext-key gcontext-line-style
-    gcontext-line-width gcontext-p gcontext-plane-mask gcontext-plist
-    gcontext-stipple gcontext-subwindow-mode gcontext-tile gcontext-ts-x
-    gcontext-ts-y generalized-boolean get-external-event-code get-image get-property
-    get-raw-image get-resource get-search-resource get-search-table
-    get-standard-colormap get-wm-class global-pointer-position grab-button
-    grab-key grab-keyboard grab-pointer grab-server grab-status
-    icon-sizes iconify-window id-choice-error illegal-request-error
-    image image-blue-mask image-depth image-green-mask image-height
-    image-name image-pixmap image-plist image-red-mask image-width
-    image-x image-x-hot image-x-p image-xy image-xy-bitmap-list
-    image-xy-p image-y-hot image-z image-z-bits-per-pixel image-z-p
-    image-z-pixarray implementation-error input-focus install-colormap
-    installed-colormaps int16 int32 int8 intern-atom invalid-font
-    keyboard-control keyboard-mapping keycode->character keycode->keysym
-    keysym keysym->character keysym->keycodes keysym-in-map-p
-    keysym-set kill-client kill-temporary-clients length-error
-    list-extensions list-font-names list-fonts list-properties
-    lookup-color lookup-error make-color make-event-handlers
-    make-event-keys make-event-mask make-resource-database make-state-keys
-    make-state-mask make-wm-hints make-wm-size-hints map-resource
-    map-subwindows map-window mapping-notify mask16 mask32
-    match-error max-char-ascent max-char-attributes max-char-descent
-    max-char-left-bearing max-char-right-bearing max-char-width
-    merge-resources min-char-ascent min-char-attributes min-char-descent
-    min-char-left-bearing min-char-right-bearing min-char-width
-    missing-parameter modifier-key modifier-mapping modifier-mask
-    motion-events name-error no-operation open-display open-font
-    pixarray pixel pixmap pixmap-display pixmap-equal
-    pixmap-error pixmap-format pixmap-format-bits-per-pixel
-    pixmap-format-depth pixmap-format-p pixmap-format-scanline-pad
-    pixmap-id pixmap-p pixmap-plist point-seq pointer-control
-    pointer-event-mask pointer-event-mask-class pointer-mapping
-    pointer-position process-event put-image put-raw-image
-    query-best-cursor query-best-stipple query-best-tile query-colors
-    query-extension query-keymap query-pointer query-tree queue-event
-    read-bitmap-file read-resources recolor-cursor rect-seq
-    remove-access-host remove-from-save-set reparent-window repeat-seq
-    reply-length-error reply-timeout request-error reset-screen-saver
-    resource-database resource-database-timestamp resource-error
-    resource-id resource-key rgb-colormaps rgb-val root-resources
-    rotate-cut-buffers rotate-properties screen screen-backing-stores
-    screen-black-pixel screen-default-colormap screen-depths
-    screen-event-mask-at-open screen-height screen-height-in-millimeters
-    screen-max-installed-maps screen-min-installed-maps screen-p
-    screen-plist screen-root screen-root-depth screen-root-visual
-    screen-root-visual-info screen-save-unders-p screen-saver
-    screen-white-pixel screen-width screen-width-in-millimeters seg-seq
-    selection-owner send-event sequence-error set-access-control
-    set-close-down-mode set-input-focus set-modifier-mapping
-    set-pointer-mapping set-screen-saver set-selection-owner
-    set-standard-colormap set-standard-properties set-wm-class
-    set-wm-properties set-wm-resources state-keysym-p state-mask-key
-    store-color store-colors stringable text-extents text-width
-    timestamp transient-for translate-coordinates translate-default
-    translation-function type-error undefine-keysym unexpected-reply
-    ungrab-button ungrab-key ungrab-keyboard ungrab-pointer
-    ungrab-server uninstall-colormap unknown-error unmap-subwindows
-    unmap-window value-error visual-info visual-info-bits-per-rgb
-    visual-info-blue-mask visual-info-class visual-info-colormap-entries
-    visual-info-display visual-info-green-mask visual-info-id visual-info-p
-    visual-info-plist visual-info-red-mask warp-pointer
-    warp-pointer-if-inside warp-pointer-relative warp-pointer-relative-if-inside
-    win-gravity window window-all-event-masks window-background
-    window-backing-pixel window-backing-planes window-backing-store
-    window-bit-gravity window-border window-class window-colormap
-    window-colormap-installed-p window-cursor window-display
-    window-do-not-propagate-mask window-equal window-error
-    window-event-mask window-gravity window-id window-map-state
-    window-override-redirect window-p window-plist window-priority
-    window-save-under window-visual window-visual-info with-display
-    with-event-queue with-gcontext with-server-grabbed with-state
-    withdraw-window wm-client-machine wm-colormap-windows wm-command
-    wm-hints wm-hints-flags wm-hints-icon-mask wm-hints-icon-pixmap
-    wm-hints-icon-window wm-hints-icon-x wm-hints-icon-y
-    wm-hints-initial-state wm-hints-input wm-hints-p wm-hints-window-group
-    wm-icon-name wm-name wm-normal-hints wm-protocols wm-resources
-    wm-size-hints wm-size-hints-base-height wm-size-hints-base-width
-    wm-size-hints-height wm-size-hints-height-inc wm-size-hints-max-aspect
-    wm-size-hints-max-height wm-size-hints-max-width wm-size-hints-min-aspect
-    wm-size-hints-min-height wm-size-hints-min-width wm-size-hints-p
-    wm-size-hints-user-specified-position-p wm-size-hints-user-specified-size-p
-    wm-size-hints-width wm-size-hints-width-inc wm-size-hints-win-gravity
-    wm-size-hints-x wm-size-hints-y wm-zoom-hints write-bitmap-file
-    write-resources xatom
-    ))
-
 
 ;;; The ANSI Common Lisp way
 
-#+(and Genera clx-ansi-common-lisp)
+#+genera
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf *readtable* si:*ansi-common-lisp-readtable*))
 
-#+clx-ansi-common-lisp
 (common-lisp:in-package :common-lisp-user)
 
-#+clx-ansi-common-lisp
-(defpackage xlib
+(defpackage #:xlib
   (:use common-lisp)
   (:size 3000)
   #+(or kcl ibcl) (:shadow rational)
-  #+allegro (:use cltl1)
   #+allegro (:import-from excl without-interrupts)
   #+excl (:import-from excl arglist)
   #+Genera (:import-from zwei indentation)
   #+lcl3.0 (:import-from lcl arglist)
   #+lispm (:import-from lisp char-bit)
   #+lispm (:import-from sys arglist with-stack-list with-stack-list*)
-  #+sbcl (:use sb-bsd-sockets)
+  #+(or sbcl ecl) (:use sb-bsd-sockets)
   (:export
     *version* access-control access-error access-hosts
     activate-screen-saver add-access-host add-resource add-to-save-set
@@ -389,108 +177,4 @@
     wm-size-hints-user-specified-position-p wm-size-hints-user-specified-size-p
     wm-size-hints-width wm-size-hints-width-inc wm-size-hints-win-gravity
     wm-size-hints-x wm-size-hints-y wm-zoom-hints write-bitmap-file
-    write-resources xatom)
-  ;; Exports from xvidmode.lisp
-  (:export mode-info
-	   mode-info-dotclock
-	   mode-info-hdisplay
-	   mode-info-hsyncstart
-	   mode-info-hsyncend
-	   mode-info-htotal
-	   mode-info-hskew
-	   mode-info-vdisplay
-	   mode-info-vsyncstart
-	   mode-info-vsyncend
-	   mode-info-vtotal
-	   mode-info-flags
-	   mode-info-privsize
-	   mode-info-private
-	   make-mode-info
-
-	   xfree86-vidmode-query-version
-	   xfree86-vidmode-set-client-version
-	   xfree86-vidmode-get-permissions
-	   xfree86-vidmode-mod-mode-line 
-	   xfree86-vidmode-get-mode-line 
-	   xfree86-vidmode-get-all-mode-lines
-	   xfree86-vidmode-add-mode-line
-	   xfree86-vidmode-delete-mode-line
-	   xfree86-vidmode-validate-mode-line
-	   xfree86-vidmode-get-gamma
-	   xfree86-vidmode-set-gamma
-	   xfree86-vidmode-get-gamma-ramp
-	   xfree86-vidmode-set-gamma-ramp     
-	   xfree86-vidmode-get-gamma-ramp-size
-	   xfree86-vidmode-lock-mode-switch
-	   xfree86-vidmode-switch-to-mode
-	   xfree86-vidmode-switch-mode
-	   xfree86-vidmode-select-next-mode
-	   xfree86-vidmode-select-prev-mode
-	   xfree86-vidmode-get-monitor
-	   xfree86-vidmode-get-viewport
-	   xfree86-vidmode-set-viewport
-	   xfree86-vidmode-get-dotclocks)
-  ;; xrender
-  (:export render-create-picture
-	   render-free-picture
-	  
-	   render-create-glyph-set
-	   render-reference-glyph-set
-	   render-free-glyph-set
-	  
-	   render-add-glyph
-	   render-add-glyph-from-picture
-	   render-free-glyph
-	   render-fill-rectangle
-
-	   picture-format-display 
-	   picture-format-id
-	   picture-format-type
-	   picture-format-depth
-	   picture-format-red-byte
-	   picture-format-green-byte
-	   picture-format-blue-byte
-	   picture-format-alpha-byte
-	   picture-format-colormap
-
-	   ;; picture object
-	   picture-repeat
-	   picture-alpha-map
-	   picture-alpha-x-origin
-	   picture-alpha-y-origin
-	   picture-clip-x-origin
-	   picture-clip-y-origin
-	   picture-clip-mask
-	   picture-graphics-exposures
-	   picture-subwindow-mode
-	   picture-poly-edge
-	   picture-poly-mode
-	   picture-dither
-	   picture-component-alpha
-	   picture-drawable
-
-	   find-matching-picture-formats
-	   find-window-picture-format
-	   render-free-picture
-	   render-free-glyph-set
-	   render-query-version
-	   ;; render-query-picture-formats
-	   render-fill-rectangle
-	   render-composite
-	   render-create-glyph-set
-	   render-reference-glyph-set
-	   render-composite-glyphs
-	   render-add-glyph
-	   render-add-glyph-from-picture
-	   render-free-glyphs
-	   render-combine)
-  ;; Shape extension
-  (:export shape-query-version
-	   shape-rectangles
-	   shape-mask
-	   shape-combine
-	   shape-offset
-	   shape-query-extents
-	   shape-select-input
-	   shape-input-selected-p
-	   shape-get-rectangles))
+    write-resources xatom))
diff --git a/src/clx/provide.lisp b/src/clx/provide.lisp
index fe59ebedcb4db07626fddc343ecd093341d6e3c9..208e42d69755d78bb21bef8c66607ac9bb801544 100644
--- a/src/clx/provide.lisp
+++ b/src/clx/provide.lisp
@@ -14,24 +14,12 @@
 ;;;			(require :clx <pathname-of-this-file>)
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: provide.lisp,v 1.5 2009/06/17 18:22:46 rtoy Rel $")
-
-#+cmu
-(cl:provide "CLX")
-
-#-cmu
-(progn
-
-#-clx-ansi-common-lisp 
-(in-package :user)
-
-#+clx-ansi-common-lisp
 (in-package :common-lisp-user)
 
-#-clx-ansi-common-lisp
 (provide :clx)
 
+#-cmu
+(progn
 (defvar *clx-source-pathname*
 	(pathname "/src/local/clx/*.l"))
 
@@ -63,4 +51,4 @@
 (if *compile-clx*
     (compile-clx *clx-source-pathname* *clx-binary-pathname*)
   (load-clx *clx-binary-pathname*))
-)
+)
\ No newline at end of file
diff --git a/src/clx/requests.lisp b/src/clx/requests.lisp
index 49aeb3edfefb5a624ba522f1535c9a29fff82e7e..e802919977f96241e326e1fdbdc972dc11123383 100644
--- a/src/clx/requests.lisp
+++ b/src/clx/requests.lisp
@@ -16,9 +16,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: requests.lisp,v 1.9 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (defun create-window (&key
@@ -120,8 +117,10 @@
 
 (defun destroy-window (window)
   (declare (type window window))
-  (with-buffer-request ((window-display window) +x-destroywindow+)
-    (window window)))
+  (let ((display (window-display window)))
+    (with-buffer-request (display +x-destroywindow+)
+      (window window))
+    (deallocate-resource-id display (window-id window) 'window)))
 
 (defun destroy-subwindows (window)
   (declare (type window window))
diff --git a/src/clx/resource.lisp b/src/clx/resource.lisp
index f5c1e5b18ee6389733bbd39e74543c9bb487c6e0..980e22a000e505a593ff948d87cdc3ad94b858c0 100644
--- a/src/clx/resource.lisp
+++ b/src/clx/resource.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: resource.lisp,v 1.12 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 ;; The C version of this uses a 64 entry hash table at each entry.
@@ -409,20 +406,14 @@
   ;; FUNCTION is called with arguments (name-list value . args)
   (declare (type resource-database database)
 	   (type (function (list t &rest t) t) function)
-	   #+clx-ansi-common-lisp
 	   (dynamic-extent function)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg function)
 	   (dynamic-extent args))
   (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)
 		      (type list name)
-		      #+clx-ansi-common-lisp
-		      (dynamic-extent function)
-		      #+(and lispm (not clx-ansi-common-lisp))
-		      (sys:downward-funarg function))		      
+		      (dynamic-extent function))
 	     (let ((tight (resource-database-tight database))
 		   (loose (resource-database-loose database)))
 	       (declare (type list tight loose))
diff --git a/src/clx/sockcl.lisp b/src/clx/sockcl.lisp
index b5e2ca5e1e6b00658fc93ce8df6aed40622fda04..26c0eda348242d4b888ca3d4efb1e610a922ae8b 100644
--- a/src/clx/sockcl.lisp
+++ b/src/clx/sockcl.lisp
@@ -23,9 +23,6 @@
 ;;; Compile this file with compile-file.
 ;;; Load it with (si:faslink "sockcl.o" "socket.o -lc")
 
-#+cmu
-(ext:file-comment "$Id: sockcl.lisp,v 1.4 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 ;;; The cmpinclude.h file does not have this type definition from
diff --git a/src/clx/text.lisp b/src/clx/text.lisp
index 6e3b0a478baa96fc547510fcadb72e1cfa746a7f..dcac2723315b8caea67fa2385172ca2e4f800c21 100644
--- a/src/clx/text.lisp
+++ b/src/clx/text.lisp
@@ -18,9 +18,6 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: text.lisp,v 1.9 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 ;; Strings are broken up into chunks of this size
@@ -117,10 +114,7 @@
   (declare (type sequence sequence)
 	   (type (or font gcontext) font))
   (declare (type (or null translation-function) translate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent translate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg #+Genera * #-Genera translate))
+	   (dynamic-extent translate))
   (declare (clx-values width ascent descent left right
 		  font-ascent font-descent direction
 		  (or null array-index)))
@@ -224,10 +218,7 @@
 	   (type array-index start)
 	   (type (or null array-index) end))
   (declare (type (or null translation-function) translate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent translate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg #+Genera * #-Genera translate))
+	   (dynamic-extent translate))
   (declare (clx-values integer (or null integer)))
   (when (type? font 'gcontext)
     (force-gcontext-changes font)
@@ -468,10 +459,7 @@
 	   (type (or null int32) width)
 	   (type index-size size))
   (declare (type (or null translation-function) translate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent translate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg #+Genera * #-Genera translate))
+	   (dynamic-extent translate))
   (declare (clx-values generalized-boolean (or null int32)))
   (let* ((display (gcontext-display gcontext))
 	 (result t)
@@ -519,10 +507,7 @@
 	   (type (or null int32) width)
 	   (type index-size size))
   (declare (type (or null translation-function) translate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent translate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg #+Genera * #-Genera translate))
+	   (dynamic-extent translate))
   (declare (clx-values (or null array-index) (or null int32)))
   (unless end (setq end (length sequence)))
   (ecase size
@@ -543,10 +528,7 @@
 	   (type (or null int32) width))
   (declare (clx-values (or null array-index) (or null int32)))
   (declare (type translation-function translate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent translate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg translate)) 
+	   (dynamic-extent translate))
   (let* ((src-start start)
 	 (src-end (or end (length sequence)))
 	 (next-start nil)
@@ -645,10 +627,7 @@
 	   (type (or null int32) width))
   (declare (clx-values (or null array-index) (or null int32)))
   (declare (type translation-function translate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent translate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg translate))
+	   (dynamic-extent translate))
   (let* ((src-start start)
 	 (src-end (or end (length sequence)))
 	 (next-start nil)
@@ -747,10 +726,7 @@
 	   (type (or null int32) width)
 	   (type index-size size))
   (declare (type (or null translation-function) translate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent translate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg #+Genera * #-Genera translate))
+	   (dynamic-extent translate))
   (declare (clx-values generalized-boolean (or null int32)))
   (let* ((display (gcontext-display gcontext))
 	 (result t)
@@ -803,10 +779,7 @@
 	   (type (or null int32) width)
 	   (type index-size size))
   (declare (type (or null translation-function) translate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent translate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg #+Genera * #-Genera translate))
+	   (dynamic-extent translate))
   (declare (clx-values (or null array-index) (or null int32)))
   (setf end (index-min (index+ start 255) (or end (length sequence))))
   (ecase size
@@ -831,10 +804,7 @@
 	   (type (or null array-index) end)
 	   (type (or null int32) width)) 
   (declare (type (or null translation-function) translate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent translate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg translate))
+	   (dynamic-extent translate))
   (declare (clx-values (or null array-index) (or null int32)))
   (do* ((display (gcontext-display gcontext))
 	(length (index- end start))
@@ -896,10 +866,7 @@
 	   (type (or null array-index) end)
 	   (type (or null int32) width))
   (declare (type (or null translation-function) translate)
-	   #+clx-ansi-common-lisp
-	   (dynamic-extent translate)
-	   #+(and lispm (not clx-ansi-common-lisp))
-	   (sys:downward-funarg translate))
+	   (dynamic-extent translate))
   (declare (clx-values (or null array-index) (or null int32)))
   (do* ((display (gcontext-display gcontext))
 	(length (index- end start))
diff --git a/src/clx/translate.lisp b/src/clx/translate.lisp
index 1c015c7e70edcc927b79c8c2257b2870085d7d0b..0b0d7a8c8c55ce8ddf1e9c70d9c2647d9c737821 100644
--- a/src/clx/translate.lisp
+++ b/src/clx/translate.lisp
@@ -16,19 +16,22 @@
 ;;; express or implied warranty.
 ;;;
 
-#+cmu
-(ext:file-comment "$Id: translate.lisp,v 1.6 2009/06/17 18:22:46 rtoy Rel $")
-
 (in-package :xlib)
 
 (defvar *keysym-sets* nil) ;; Alist of (name first-keysym last-keysym)
 
 (defun define-keysym-set (set first-keysym last-keysym)
   ;; Define all keysyms from first-keysym up to and including
-  ;; last-keysym to be in SET (returned from the keysym-set function).
-  ;; Signals an error if the keysym range overlaps an existing set.
- (declare (type keyword set)
-	  (type keysym first-keysym last-keysym))
+  ;; last-keysym to be in the keysym set named SET.  SET is a keyword
+  ;; (i.e., a symbol in the package named KEYWORD).  When the function
+  ;; KEYSYM-SET is called with a keysym, the SET of the keysym set to
+  ;; which the keysym belongs is returned.
+  ;;
+  ;; If the range of keysyms defined by first-keysym and last-keysym
+  ;; overlaps the range of an existing keysym set, then an error is
+  ;; signaled.
+  (declare (type keyword set)
+	   (type keysym first-keysym last-keysym))
   (when (> first-keysym last-keysym)
     (rotatef first-keysym last-keysym))
   (setq *keysym-sets* (delete set *keysym-sets* :key #'car))
@@ -113,10 +116,10 @@
 	     (logand #xff (lognot (make-state-mask :lock))))
   "Default keysym state mask to use during keysym-translation.")
 
-(defun define-keysym (object keysym &key lowercase translate modifiers mask display)	              
+(defun define-keysym (object keysym &key lowercase translate modifiers mask display)
   ;; Define the translation from keysym/modifiers to a (usually
-  ;; character) object.  ANy previous keysym definition with
-  ;; KEYSYM and MODIFIERS is deleted before adding the new definition.
+  ;; character) object.  Any previous keysym definition with KEYSYM
+  ;; and MODIFIERS is deleted before the new definition is added.
   ;;
   ;; MODIFIERS is either a modifier-mask or list containing intermixed
   ;; keysyms and state-mask-keys specifying when to use this
diff --git a/src/tools/clxcom.lisp b/src/tools/clxcom.lisp
index 90afb2bea155d593785615a763d179bd96bba89b..cae5982df1ca2c5d45ab196239c4e29fee6416b0 100644
--- a/src/tools/clxcom.lisp
+++ b/src/tools/clxcom.lisp
@@ -68,16 +68,16 @@
       (comf "target:clx/manager" :load t)
       (comf "target:clx/image" :load t)
       (comf "target:clx/resource" :load t)
-      (comf "target:clx/shape" :load t)
-      (comf "target:clx/big-requests" :load t)
-      (comf "target:clx/xvidmode" :load t)
-      (comf "target:clx/xrender" :load t)
-      (comf "target:clx/glx" :load t)
-      (comf "target:clx/gl" :load t)
-      (comf "target:clx/dpms" :load t)
-      (comf "target:clx/screensaver" :load t)
-      (comf "target:clx/xinerama" :load t)
-      (comf "target:clx/xtest" :load t))
+      (comf "target:clx/extensions/shape" :load t)
+      (comf "target:clx/extensions/big-requests" :load t)
+      (comf "target:clx/extensions/xvidmode" :load t)
+      (comf "target:clx/extensions/xrender" :load t)
+      (comf "target:clx/extensions/glx" :load t)
+      (comf "target:clx/extensions/gl" :load t)
+      (comf "target:clx/extensions/dpms" :load t)
+      (comf "target:clx/extensions/screensaver" :load t)
+      (comf "target:clx/extensions/xinerama" :load t)
+      (comf "target:clx/extensions/xtest" :load t))
     (comf "target:code/clx-ext")
     (comf "target:hemlock/charmacs" :load t)
     (comf "target:hemlock/key-event" :load t)
@@ -109,16 +109,16 @@
  "target:clx/manager"
  "target:clx/image"
  "target:clx/resource"
- "target:clx/shape"
- "target:clx/big-requests"
- "target:clx/xvidmode"
- "target:clx/xrender"
- "target:clx/glx"
- "target:clx/gl"
- "target:clx/dpms"
- "target:clx/screensaver"
- "target:clx/xinerama"
- "target:clx/xtest"
+ "target:clx/extensions/shape"
+ "target:clx/extensions/big-requests"
+ "target:clx/extensions/xvidmode"
+ "target:clx/extensions/xrender"
+ "target:clx/extensions/glx"
+ "target:clx/extensions/gl"
+ "target:clx/extensions/dpms"
+ "target:clx/extensions/screensaver"
+ "target:clx/extensions/xinerama"
+ "target:clx/extensions/xtest"
  "target:code/clx-ext"
  "target:hemlock/charmacs"
  "target:hemlock/key-event"