diff --git a/motif/lisp/callbacks.lisp b/motif/lisp/callbacks.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..2eb5dabc6f0f09ce7190d02dea2bfa4180a37c4c
--- /dev/null
+++ b/motif/lisp/callbacks.lisp
@@ -0,0 +1,457 @@
+;;;; -*- Mode: Lisp ; Package: Toolkit -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; This file contains all the functions which handle callbacks dispatched
+;;; from the C server.
+;;;
+
+(in-package "TOOLKIT")
+
+
+
+;;;; Functions for registering deferred actions
+
+(defvar *callback-deferred-action* nil)
+
+(defmacro with-callback-deferred-actions (&body forms)
+  `(setf *callback-deferred-action* #'(lambda () ,@forms)))
+
+(declaim (inline invoke-deferred-actions))
+(defun invoke-deferred-actions ()
+  (when *callback-deferred-action*
+    (let ((action *callback-deferred-action*))
+      (setf *callback-deferred-action* nil)
+      (funcall action))))
+
+
+
+;;;; Functions which track all registered callbacks
+;;;
+;;; The actual toolkit functions are provided by functions
+;;; %add-callback, %remove-callback, etc.
+;;;
+;;; The callback hash table is keyed on:
+;;;      (widget-id . callback-name)
+;;; The callback data is (fn . client-data)
+
+(defun add-callback (widget sym-name fn &rest args)
+  "Registers a callback function on the specified widget."
+  (declare (type widget widget)
+	   (type (or symbol function) fn)
+	   (keyword sym-name))
+  (let* ((name (symbol-resource sym-name))
+	 (table (motif-connection-callback-table *motif-connection*))
+	 (key (cons (widget-id widget) name))
+	 (data (cons fn args)))
+
+    (unless (member sym-name (widget-callbacks widget))
+      (%add-callback widget name)
+      (push sym-name (widget-callbacks widget)))
+    (setf (gethash key table) (cons data (gethash key table)))))
+
+
+;; The 'args' list must be EQUAL to the args passed when the callback was
+;; created for this callback to be removed.
+
+(defun remove-callback (widget sym-name fn &rest args)
+  "Removes a callback function from the specified widget."
+  (declare (type widget widget)
+	   (type (or symbol function) fn)
+	   (keyword sym-name))
+  (let* ((name (symbol-resource sym-name))
+	 (table (motif-connection-callback-table *motif-connection*))
+	 (key (cons (widget-id widget) name))
+	 (data (cons fn args))
+	 (new-list (delete data (gethash key table) :test #'equal)))
+
+    (setf (gethash key table) new-list)
+    (unless new-list
+      (%remove-callback widget name)
+      (setf (widget-callbacks widget)
+	    (delete sym-name (widget-callbacks widget) :test #'eq)))))
+
+(defun remove-all-callbacks (widget sym-name)
+  "Removes all callback functions on the specified widget."
+  (declare (type widget widget)
+	   (keyword sym-name))
+  (let* ((name (symbol-resource sym-name))
+	 (table (motif-connection-callback-table *motif-connection*))
+	 (key (cons (widget-id widget) name)))
+    (%remove-callback widget name)
+    (setf (gethash key table) nil)
+    (setf (widget-callbacks widget)
+	  (delete sym-name (widget-callbacks widget) :test #'eq))))
+
+(defun handle-callback (reply)
+  (unwind-protect
+      (let* ((widget (toolkit-read-value reply))
+	     (name (toolkit-read-value reply))
+	     (table (motif-connection-callback-table *motif-connection*))
+	     (calldata (read-callback-info widget reply)))
+	;; Invoke the callback function
+	(dolist (callback (gethash (cons (widget-id widget) name) table))
+	  (apply (car callback)
+		 widget
+		 calldata
+		 (cdr callback))))
+    (unless (motif-connection-terminated *motif-connection*)
+      (terminate-callback)
+      (invoke-deferred-actions))
+    (destroy-message reply)))
+
+
+
+;;;; Functions which deal with protocol callbacks
+;;;
+;;; The protocol table is keyed on:
+;;;           (widget property protocol)
+;;; The data stored in the table is:
+;;;           (fn . call-data)
+
+(defun add-protocol-callback (widget property protocol fn &rest args)
+  "Registers a protocol callback function on the specified widget."
+  (declare (type widget widget)
+	   (type keyword property protocol)
+	   (type (or symbol function) fn))
+  (let* ((table (motif-connection-protocol-table *motif-connection*))
+	 (key (list (widget-id widget) property protocol))
+	 (data (cons fn args)))
+
+    (let ((entry (cons property protocol)))
+      (unless (member entry (widget-protocols widget))
+	(push entry (widget-protocols widget))
+	(%add-protocol-callback widget property protocol)))
+    (setf (gethash key table) (cons data (gethash key table)))))
+
+(defun remove-protocol-callback (widget property protocol fn &rest args)
+  "Removes a protocol callback function on the specified widget."
+  (declare (type widget widget)
+	   (type keyword property protocol)
+	   (type (or symbol function) fn))
+  (let* ((table (motif-connection-protocol-table *motif-connection*))
+	 (key (list (widget-id widget) property protocol))
+	 (data (cons fn args))
+	 (new-list (delete data (gethash key table) :test #'equal)))
+    (setf (gethash key table) new-list)
+    (unless new-list
+      (%remove-protocol-callback widget property protocol)
+      (setf (widget-protocols widget)
+	    (delete (cons property protocol) (widget-protocols widget)
+		    :test #'equal)))))
+
+;; (declaim (inline add-wm-protocol-callback remove-wm-protocol-callback))
+(defun add-wm-protocol-callback (widget protocol fn &rest args)
+  "Registers a window manager protocol callback function on the specified
+   widget."
+  (declare (type widget widget)
+	   (keyword protocol)
+	   (type (or symbol function) fn))
+  (apply #'add-protocol-callback widget :wm-protocols protocol fn args))
+
+(defun remove-wm-protocol-callback (widget protocol fn &rest args)
+  "Removes a window manager protocol callback function on the specified
+   widget."
+  (declare (type widget widget)
+	   (keyword protocol)
+	   (type (or symbol function) fn))
+  (apply #'remove-protocol-callback widget :wm-protocols protocol fn args))
+
+(defun handle-protocol (reply)
+  (unwind-protect
+      (let* ((widget (toolkit-read-value reply))
+	     (property (toolkit-read-value reply))
+	     (protocol (toolkit-read-value reply))
+	     (event (toolkit-read-value reply))
+	     (table (motif-connection-protocol-table *motif-connection*))
+	     (calldata (make-any-callback :reason :cr-protocols :event event)))
+	(dolist (callback (gethash (list (widget-id widget) property protocol)
+				   table))
+	  (apply (car callback)
+		 widget
+		 calldata
+		 (cdr callback))))
+    (unless (motif-connection-terminated *motif-connection*)
+      (terminate-callback)
+      (invoke-deferred-actions))
+    (destroy-message reply)))
+
+				   
+
+;;;; Functions for dealing with call-data info
+
+;;; These structures are used to hold the various callback information.
+;;; When the server begins processing a callback, it will dump the callback
+;;; data into the message in slot order.  The client will unpack the data
+;;; and create a callback structure which will be passed to the Lisp
+;;; callback as the call-data.  It reason field, possibly together with the
+;;; widget class, will be enough to determine what callback structure is
+;;; appropriate.  The event slot is the (XEvent *) received in C.  If the
+;;; client wants access to the event, there will be some sort of macro such
+;;; as (with-event-info ((<callback-struct>) ... <slots to bind>)  ....) or
+;;; something.  This will be added later.
+(defstruct (any-callback
+	    (:print-function print-callback))
+  (reason :cr-none :type keyword)
+  (event  0 :type (unsigned-byte 32)))
+
+(defun print-callback (callback stream d)
+  (declare (ignore d)
+	   (stream stream))
+  (format stream "#<Motif Callback -- ~a>" (any-callback-reason callback)))
+
+(defstruct (button-callback
+	    (:include any-callback)
+	    (:print-function print-callback)
+	    (:constructor make-button-callback (reason event click-count)))
+  (click-count 0 :type fixnum))
+
+(defstruct (drawing-area-callback
+	    (:include any-callback)
+	    (:print-function print-callback)
+	    (:constructor make-drawing-area-callback (reason event window)))
+  window)
+
+(defstruct (drawn-button-callback
+	    (:include any-callback)
+	    (:print-function print-callback)
+	    (:constructor make-drawn-button-callback
+			  (reason event window click-count)))
+  window
+  (click-count 0 :type fixnum))
+
+;;; RowColumnCallbackStruct is weird and probably not necessary
+
+(defstruct (scroll-bar-callback
+	    (:include any-callback)
+	    (:print-function print-callback)
+	    (:constructor make-scroll-bar-callback (reason event value pixel)))
+  (value 0 :type fixnum)
+  (pixel 0 :type fixnum))
+
+(defstruct (toggle-button-callback
+	    (:include any-callback)
+	    (:print-function print-callback)
+	    (:constructor make-toggle-button-callback (reason event set)))
+  (set nil :type (member t nil)))
+
+;;; ListCallbackStruct is fairly complex
+(defstruct (list-callback
+	    (:include any-callback)
+	    (:print-function print-callback)
+	    (:constructor make-list-callback (reason event item item-position)))
+  (item nil :type (or null xmstring))
+  (item-position 0 :type fixnum)
+  (selected-items nil :type list)  ;; a list of strings (maybe array?)
+  (selected-item-positions nil :type list) ;; of integers
+  (selection-type 0 :type fixnum))
+
+;; used for selection-box and command callbacks
+(defstruct (selection-callback
+	    (:include any-callback)
+	    (:print-function print-callback)
+	    (:constructor make-selection-callback (reason event value)))
+  (value nil :type (or null xmstring)))
+
+(defstruct (file-selection-callback
+	    (:include selection-callback)
+	    (:print-function print-callback)
+	    (:constructor make-file-selection-callback
+			  (reason event value mask dir pattern)))
+  (mask nil :type (or null xmstring))
+  (dir nil :type (or null xmstring))
+  (pattern nil :type (or null xmstring)))
+
+(defstruct (scale-callback
+	    (:include any-callback)
+	    (:print-function print-callback)
+	    (:constructor make-scale-callback (reason event value)))
+  (value 0 :type fixnum))
+
+(defstruct (text-callback
+	    (:include any-callback)
+	    (:print-function print-callback)
+	    (:constructor make-text-callback
+			  (reason event)))
+  (doit t :type (member t nil))
+  (curr-insert 0 :type fixnum)
+  (new-insert 0 :type fixnum)
+  (start-pos 0 :type fixnum)
+  (end-pos 0 :type fixnum)
+  (text "" :type simple-string)
+  format ;; ***** Don't yet know what this is
+)
+
+(defun read-callback-info (widget reply)
+  (let* ((reason (toolkit-read-value reply))
+	 (event (toolkit-read-value reply)))
+    (case (widget-type widget)
+      ((:arrow-button :arrow-button-gadget :push-button :push-button-gadget)
+       (make-button-callback reason event (toolkit-read-value reply)))
+      (:drawing-area
+       (make-drawing-area-callback reason event (toolkit-read-value reply)))
+      (:drawn-button
+       (let* ((window (toolkit-read-value reply))
+	      (count (toolkit-read-value reply)))
+	 (make-drawn-button-callback reason event window count)))
+      (:scroll-bar
+       (let* ((value (toolkit-read-value reply))
+	      (pixel (toolkit-read-value reply)))
+	 (make-scroll-bar-callback reason event value pixel)))
+      ((:toggle-button :toggle-button-gadget)
+       (make-toggle-button-callback reason event (toolkit-read-value reply)))
+      (:list
+       (let* ((item (toolkit-read-value reply))
+	      (item-position (toolkit-read-value reply))
+	      (info (make-list-callback reason event item item-position)))
+	 (when (or (eq reason :cr-multiple-select)
+		   (eq reason :cr-extended-select))
+	   (setf (list-callback-selected-items info)
+		 (toolkit-read-value reply))
+	   (setf (list-callback-selected-item-positions info)
+		 (toolkit-read-value reply))
+	   (setf (list-callback-selection-type info)
+		 (toolkit-read-value reply)))
+	 info))
+      (:text
+       (let ((info (make-text-callback reason event)))
+	 (when (member reason '(:cr-losing-focus :cr-modifying-text-value
+						 :cr-moving-insert-cursor))
+	   (setf (text-callback-doit info) (toolkit-read-value reply))
+	   (setf (text-callback-curr-insert info) (toolkit-read-value reply))
+	   (setf (text-callback-new-insert info) (toolkit-read-value reply))
+	   
+	   (case reason
+	     (:cr-losing-focus
+	      (setf (text-callback-start-pos info) (toolkit-read-value reply))
+	      (setf (text-callback-end-pos info) (toolkit-read-value reply)))
+	     (:cr-modifying-text-value
+	      (setf (text-callback-start-pos info) (toolkit-read-value reply))
+	      (setf (text-callback-end-pos info) (toolkit-read-value reply))
+	      (setf (text-callback-text info) (toolkit-read-value reply))
+	      (setf (text-callback-format info) (toolkit-read-value reply))
+	      )))
+	 info))
+      ((:selection-box :command)
+       (make-selection-callback reason event (toolkit-read-value reply)))
+      (:file-selection-box
+       (let* ((value (toolkit-read-value reply))
+	      (mask (toolkit-read-value reply))
+	      (dir (toolkit-read-value reply))
+	      (pattern (toolkit-read-value reply)))
+	 (make-file-selection-callback reason event
+				       value mask dir pattern)))
+      (:scale
+       (make-scale-callback reason event (toolkit-read-value reply)))
+      (t nil))))
+
+(defmacro with-callback-event ((event cback) &body forms)
+  `(let ((,event (transport-event (any-callback-event ,cback))))
+     ,@forms))
+
+
+
+;;;; Action table support
+
+(defmacro with-action-event ((event handle) &body forms)
+  `(let ((,event (transport-event ,handle)))
+     ,@forms))
+
+(defun handle-action (reply)
+  (let* ((widget (toolkit-read-value reply))
+	 (event-handle (toolkit-read-value reply))
+	 (fun-name (toolkit-read-value reply)))
+    (unwind-protect
+	(funcall (read-from-string fun-name) widget event-handle)
+      (unless (motif-connection-terminated *motif-connection*)
+	(terminate-callback)
+	(invoke-deferred-actions))
+      (destroy-message reply))))
+
+
+
+;;;; Functions for managing event handlers
+
+(defun add-event-handler (widget event-mask non-maskable function &rest args)
+  "Registers an event handler function on the specified widget."
+  (declare (type widget widget)
+	   (type (or symbol list) event-mask)
+	   (type (member t nil) non-maskable)
+	   (type (or symbol function) function))
+  (when (symbolp event-mask)
+    (setf event-mask (list event-mask)))
+  (let ((table (motif-connection-event-table *motif-connection*))
+	(data (cons function args)))
+    (dolist (event-class event-mask)
+      (let ((mask (xlib:make-event-mask event-class))
+	    (key (cons (widget-id widget) event-class)))
+
+	(unless (member data (gethash key table) :test #'equal)
+	  (push data (gethash key table)))
+	(unless (member event-class (widget-events widget))
+	  (push event-class (widget-events widget))
+	  (%add-event-handler widget mask nil))))
+    (when non-maskable
+      (let ((mask 0) ; NoEventMask
+	    (key (cons (widget-id widget) :non-maskable-mask)))
+	(unless (member data (gethash key table) :test #'equal)
+	  (push data (gethash key table)))
+	(unless (member :non-maskable-mask (widget-events widget))
+	  (push :non-maskable-mask (widget-events widget))
+	  (%add-event-handler widget mask t))))))
+
+(defun remove-event-handler (widget event-mask non-maskable function &rest args)
+  "Removes an event handler function on the specified widget."
+  (declare (type widget widget)
+	   (type (or symbol list) event-mask)
+	   (type (member t nil) non-maskable)
+	   (type (or symbol function) function))
+  (when (symbolp event-mask)
+    (setf event-mask (list event-mask)))
+  (let ((table (motif-connection-event-table *motif-connection*))
+	(data (cons function args)))
+    (dolist (event-class event-mask)
+      (let* ((mask (xlib:make-event-mask event-class))
+	     (key (cons (widget-id widget) event-class))
+	     (new-list (delete data (gethash key table) :test #'equal)))
+	(unless new-list
+	  (setf (widget-events widget)
+		(delete event-class (widget-events widget)))
+	  (%remove-event-handler widget mask nil))))
+    (when non-maskable
+      (let* ((mask 0) ; NoEventMask
+	     (key (cons (widget-id widget) :non-maskable-mask))
+	     (new-list (delete data (gethash key table) :test #'equal)))
+	(unless new-list
+	  (setf (widget-events widget)
+		(delete :non-maskable-mask (widget-events widget)))
+	  (%remove-event-handler widget mask t))))))
+
+(defun handle-event (reply)
+  (unwind-protect
+      (let* ((widget (toolkit-read-value reply))
+	     (mask (toolkit-read-value reply))
+	     (nonmaskable (toolkit-read-value reply))
+	     (event (toolkit-read-value reply))
+	     (table (motif-connection-event-table *motif-connection*))
+	     (event-class))
+
+	(setf event-class (if nonmaskable
+			      :non-maskable-mask
+			      (car (xlib:make-event-keys mask))))
+	(dolist (handler (gethash (cons (widget-id widget) event-class) table))
+	  (apply (car handler)
+		 widget
+		 event
+		 (cdr handler))))
+    (unless (motif-connection-terminated *motif-connection*)
+      (terminate-callback)
+      (invoke-deferred-actions))
+    (destroy-message reply)))
diff --git a/motif/lisp/conversion.lisp b/motif/lisp/conversion.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..f2a5e22bf67f2a7bf0dc42e71fb503d33890b7b0
--- /dev/null
+++ b/motif/lisp/conversion.lisp
@@ -0,0 +1,364 @@
+;;;; -*- Mode: Lisp ; Package: Toolkit-Internals -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; These are the functions necessary for reading/writing Lisp data objects
+;;; into messages for communicating with the C server.
+;;;
+
+(in-package "TOOLKIT-INTERNALS")
+
+
+
+;;;; Type definitions
+
+;;; This table maps normal type tags into the symbol for their type.
+;;; Symbol types include :xid, :int, :widget, etc.
+(defvar *type-table* (make-array 80 :element-type 'cons))
+
+(defvar *enum-table* (make-hash-table :test #'eq))
+
+
+
+;;;; Functions for extracting/creating typed data in messages
+
+(declaim (inline combine-type-and-data))
+(defun combine-type-and-data (type data)
+  (declare (type (unsigned-byte 24) data)
+	   (keyword type))
+  (let ((tag (get type :xtk-type-tag)))
+    (declare (type (unsigned-byte 8) tag))
+    (logior (ash tag 24) data)))
+
+(declaim (inline extract-type-and-data))
+(defun extract-type-and-data (stuff)
+  (declare (type (unsigned-byte 32) stuff))
+  (let ((tag (ash stuff -24))
+	(data (logand stuff #x00FFFFFF)))
+    (declare (type (unsigned-byte 8) tag)
+	     (type (unsigned-byte 24) data))
+    (values tag data)))
+
+
+
+;;;; Interface functions for transporting resource values
+
+;;; In non-CMU Lisps, this can be converted into a (declaim (inline ...))
+;;; and add a (declaim (notinline ..)) after the function.
+; (declaim (maybe-inline toolkit-write-value))
+
+(defun toolkit-write-value (message value &optional (type t))
+  (typecase value
+    (widget (message-write-widget message value))
+    (motif-object (message-write-motif-object message value))
+    (simple-string 
+     (if (eq type :atom)
+	 (message-write-atom message value)
+	 (message-write-string message value)))
+    (xlib:font (message-write-xid message (xlib:font-id value) :font))
+    (xlib:cursor (message-write-xid message (xlib:cursor-id value) :cursor))
+    ((unsigned-byte 24)
+     (message-put-dblword message (combine-type-and-data :short value)))
+    ((signed-byte 32)
+     (message-put-dblword message (combine-type-and-data :int 0))
+     (message-put-dblword message value))
+    ((member t nil)
+     (if (eq type t)
+	 (message-write-boolean message value)
+	 ;; It's a null list
+	 (message-put-dblword message
+			      (combine-type-and-data type 0))))
+    (list
+     (case type
+       (:resource-list (message-write-resource-list message value))
+       (:resource-names (message-write-resource-names message value))
+       (:widget-list (message-write-widget-list message value))
+       (:xm-string-table (message-write-xmstring-table message value))
+       (:string-table (message-write-string-table message value))
+       (:int-list (message-write-int-list message value))
+       (t (toolkit-error "Illegal list type -- ~a for ~s" type value))))
+    (symbol
+     (cond
+      ((eq type :atom) (message-write-atom message value))
+      ((get value :widget-class) (message-write-widget-class message value))
+      ((get value :enum-value) (message-write-enum message value))
+      (t (message-write-function message value))))
+    (function (message-write-function message value))
+    (xlib:color (message-write-color message value))
+    (t
+     (toolkit-error "Unsupported argument type -- ~a for ~a"
+		    (type-of value) value))))
+
+(declaim (inline lookup-function))
+(defun lookup-function (fid)
+  (aref (motif-connection-function-table *motif-connection*) fid))
+
+(defun toolkit-read-value (message)
+  (multiple-value-bind (tag data)
+		       (extract-type-and-data (message-get-dblword message))
+    (declare (type (unsigned-byte 8) tag)
+	     (type (unsigned-byte 24) data))
+    (let ((type (cdr (svref *type-table* tag))))
+      (case type
+	(:widget (find-widget (message-get-dblword message)))
+	(:xm-string (find-motif-object (message-get-dblword message) type))
+	(:short  data)
+	(:atom (xlib:atom-name *x-display* (message-get-dblword message)))
+	(:boolean (not (zerop data)))
+	(:int (message-get-dblword message))
+	(:xid (get-xresource (message-get-dblword message) tag))
+	(:function (lookup-function data))
+	(:string-token (svref *toolkit-string-table* data))
+	((:resource-list :xm-string-table :string-table :int-list)
+	 (message-read-list message data))
+	(:widget-list (break "Shouldn't be reading WidgetList."))
+	(:string (message-read-string message data))
+	(:translation-table
+	 (find-motif-object (message-get-dblword message) type))
+	(:accelerator-table
+	 (find-motif-object (message-get-dblword message) type))
+	(:font-list (find-motif-object (message-get-dblword message) type))
+	(:event (construct-event message))
+	(:float (vm::make-single-float (message-get-dblword message)))
+	(:color (message-read-color message data))
+	(t  ;; assume an enumerated value
+	 (let ((table (gethash type *enum-table*)))
+	   (unless table
+	     (toolkit-error "Unknown or illegal value type -- ~a" type))
+	   (cdr (assoc data table))))))))
+
+
+
+;;;; Functions for reading/writing strings
+
+(defun packet-write-string (packet string start length)
+  (declare (simple-string string)
+	   (fixnum start length))
+  (kernel:copy-to-system-area string
+			      (+ (the fixnum (* start vm:byte-bits))
+				 (the fixnum
+				      (* vm:vector-data-offset vm:word-bits)))
+			      (packet-head packet)
+			      (* (packet-fill packet) vm:byte-bits)
+			      (* length vm:byte-bits))
+  (incf (packet-fill packet) length)
+  (incf (packet-length packet) length))
+
+(defun packet-read-string (packet string start length)
+  (declare (simple-string string)
+	   (fixnum start length))
+  (kernel:copy-from-system-area (packet-head packet)
+				(* (packet-fill packet) vm:byte-bits)
+				string
+				(+ (the fixnum (* start vm:byte-bits))
+				   (the fixnum
+					(* vm:vector-data-offset vm:word-bits)))
+				(* length vm:byte-bits))
+  (incf (packet-fill packet) length))
+
+(defun message-read-string (message length)
+  (declare (fixnum length))
+  ;; length includes the '\0'
+  (let ((string (make-string (1- length) :initial-element #\Space)))
+    (declare (simple-string string))
+    ;;
+    ;; ***** This is of course a gross oversimplification !!!
+    (packet-read-string (message-fill-packet message)
+			string 0 length)
+    (let ((packet (message-fill-packet message)))
+      (let ((pad (- 4 (mod (packet-fill packet) 4))))
+      (unless (> pad 3)
+	(dotimes (i pad)
+	  (packet-get-byte packet))))
+    string)))
+
+(defun message-write-string (message string)
+  (declare (simple-string string))
+  (let ((token (position string *toolkit-string-table* :test #'string=)))
+    (if token
+	(message-put-dblword message
+			     (combine-type-and-data :string-token token))
+	(let ((length (1+ (length string))))
+	  ;; We put the type header here so that we'll spill over into a new
+	  ;; packet if necessary
+	  (message-put-dblword message (combine-type-and-data :string length))
+	  (let ((packet (message-fill-packet message)))
+	    (cond
+	     ((< (+ length (packet-length packet)) *packet-size*)
+	      (packet-write-string packet string 0 length))
+	     ((< length (- *packet-size* *header-size*))
+	      (message-add-packet message)
+	      (setf packet (message-fill-packet message))
+	      (packet-write-string (message-fill-packet message)
+				   string 0 length))
+	     (t
+	      (break "Attempt to write a string larger than *packet-size*.
+		      Come back later to get this to work.")))
+	    (let ((pad (- 4 (mod (packet-fill packet) 4))))
+	      (unless (> pad 3)
+		(dotimes (i pad)
+		  (packet-put-byte packet 0)))))))))
+
+
+
+;;;; Functions for writing most other types
+
+(defun message-write-widget (message widget)
+  (message-put-dblword message (combine-type-and-data :widget 0))
+  (message-put-dblword message (widget-id widget)))
+
+(defun message-write-widget-list (message list)
+  (declare (list list))
+  (let ((length (length list)))
+    (message-put-dblword message
+			 (combine-type-and-data :widget-list length))
+    (dolist (widget list)
+      (message-write-widget message widget))))
+
+(defun message-write-widget-class (message widget-class)
+  (let ((val (get widget-class :widget-class)))
+    (message-put-dblword message
+			 (combine-type-and-data :widget-class val))))
+
+(defun message-write-xid (message id type)
+  (message-put-dblword message (combine-type-and-data type 0))
+  (message-put-dblword message id))
+
+(defun message-write-atom (message atom)
+  (declare (type xlib:xatom atom))
+  (let ((id (xlib:find-atom *x-display* atom)))
+    (unless id
+      (setf id (xlib:intern-atom *x-display* atom))
+      (xlib:display-force-output *x-display*))
+    (message-put-dblword message (combine-type-and-data :atom 0))
+    (message-put-dblword message id)))
+
+(defun message-write-enum (message enum)
+  (let ((val (get enum :enum-value)))
+    (message-put-dblword message (combine-type-and-data :enum val))))
+
+(defun message-write-boolean (message value)
+  (let ((intval (if value 1 0)))
+    (message-put-dblword message (combine-type-and-data :boolean intval))))
+
+(defun message-write-function (message fn)
+  (let ((fn-id (find-function-id fn)))
+    (message-put-dblword message (combine-type-and-data :function fn-id))))
+
+(defun message-write-motif-object (message obj)
+  (message-put-dblword message
+		       (combine-type-and-data (motif-object-type obj) 0))
+  (message-put-dblword message (motif-object-id obj)))
+
+(defun message-write-int-list (message list)
+  (declare (list list))
+  (let ((length (length list)))
+    (message-put-dblword message
+			 (combine-type-and-data :int-list length))
+    (dolist (int list)
+      (message-put-dblword message (combine-type-and-data :int 0))
+      (message-put-dblword message int))))
+
+(defun message-write-xmstring-table (message list)
+  (declare (list list))
+  (let ((length (length list)))
+    (message-put-dblword message
+			 (combine-type-and-data :xm-string-table length))
+    (dolist (string list)
+      (typecase string
+	(simple-string (message-write-string message string))
+	(xmstring (message-write-motif-object message string))
+	(t (toolkit-error "Invalid entry in XmStringTable -- ~s" string))))))
+
+(defun message-write-string-table (message list)
+  (declare (list list))
+  (let ((length (length list)))
+    (message-put-dblword message
+			 (combine-type-and-data :string-table length))
+    (dolist (string list)
+      (message-write-string message string))))
+
+(defun  message-write-resource-names (message list)
+  (declare (list list))
+  (let ((length (length list)))
+    (message-put-dblword message
+			 (combine-type-and-data :resource-names length))
+    (dolist (name list)
+      (message-write-string message name))))
+
+(defun message-write-resource-list (message list)
+  (declare (list list))
+  (let ((length (length list)))
+    (unless (zerop (mod length 2))
+      (toolkit-error "Resource list of odd length -- ~a" list))
+    (message-put-dblword message
+			 (combine-type-and-data :resource-list length))
+    (loop
+      (let ((name (first list))
+	    (value (second list))
+	    (rest (cddr list)))
+	(message-write-string message name)
+	(toolkit-write-value message value)
+	(unless rest (return))
+	(setf list rest)))))
+
+(defun message-read-list (message length)
+  (declare (fixnum length))
+  (let ((list))
+    (dotimes (i length)
+      (push (toolkit-read-value message) list))
+    (nreverse list)))
+
+(defun message-read-color (message red)
+  (let* ((green (message-get-word message))
+	 (blue (message-get-word message)))
+    (xlib:make-color :blue (the single-float (/ blue 65535.0))
+		     :red (the single-float (/ red 65535.0))
+		     :green (the single-float (/ green 65535.0)))))
+
+(defun message-write-color (message color)
+  (let ((green (round (* (xlib:color-green color) 65535)))
+	(red (round (* (xlib:color-red color) 65535)))
+	(blue (round (* (xlib:color-blue color)) 65535)))
+    (declare (type (unsigned-byte 16) green red blue))
+    (message-put-dblword message
+			 (combine-type-and-data :color red))
+    (message-put-word message green)
+    (message-put-word message blue)))
+		     
+
+
+;;;; Functions for handling resource ID's
+
+(defun find-function-id (fn)
+  (declare (type (or symbol function) fn))
+  (let* ((fn-table (motif-connection-function-table *motif-connection*))
+	 (pos (position fn fn-table)))
+    (declare (vector fn-table))
+    (unless pos
+      (setf pos (vector-push-extend fn fn-table)))
+    pos))
+
+(defun get-xresource (xid tag)
+  (let ((kind (car (svref *type-table* tag))))
+    (case kind
+      (:window (xlib::lookup-window *x-display* xid))
+      (:pixmap (xlib::lookup-pixmap *x-display* xid))
+      (:cursor (xlib::lookup-cursor *x-display* xid))
+      (:colormap (xlib::lookup-colormap *x-display* xid))
+      (:font (xlib::lookup-font *x-display* xid))
+      (t
+       (toolkit-error "Unknown X resource type -- ~a" kind)))))
+
+(defun construct-event (message)
+  (let ((packet (message-fill-packet message)))
+    (alien:sap-alien (system:sap+ (packet-head packet)
+				  (packet-fill packet))
+		     xevent)))
diff --git a/motif/lisp/events.lisp b/motif/lisp/events.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..b16323413cc7a1e69b5bf4fe57973daa03349700
--- /dev/null
+++ b/motif/lisp/events.lisp
@@ -0,0 +1,876 @@
+;;;; -*- Mode: Lisp ; Package: Toolkit-Internals -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; Alien definitions for all the various XEvent structures.
+;;;
+
+(in-package "TOOLKIT-INTERNALS")
+
+
+
+;;;; Definitions of the various XEvent structures
+;;; We never include the (Display *) because it would be useless in Lisp and
+;;; we add the HANDLE field so that we can pass this event back to C.
+
+(def-alien-type xid (unsigned 32))
+(def-alien-type window xid)
+(def-alien-type colormap xid)
+(def-alien-type drawable xid)
+(def-alien-type atom (unsigned 32))
+(def-alien-type bool (boolean 32))
+(def-alien-type time (unsigned 32))
+
+(def-alien-type x-key-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (root window)
+    (subwindow window)
+    (time time)
+    (x int)
+    (y int)
+    (x-root int)
+    (y-root int)
+    (state unsigned-int)
+    (keycode unsigned-int)
+    (same-screen bool)))
+
+(def-alien-type x-button-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (root window)
+    (subwindow window)
+    (time time)
+    (x int)
+    (y int)
+    (x-root int)
+    (y-root int)
+    (state unsigned-int)
+    (button unsigned-int)
+    (same-screen bool)))
+
+(def-alien-type x-motion-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (root window)
+    (subwindow window)
+    (time time)
+    (x int)
+    (y int)
+    (x-root int)
+    (y-root int)
+    (state unsigned-int)
+    (is-hint char)
+    (same-screen bool)))
+
+(def-alien-type x-crossing-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (root window)
+    (subwindow window)
+    (time time)
+    (x int)
+    (y int)
+    (x-root int)
+    (y-root int)
+    (mode int)
+    (detail int)
+    (same-screen bool)
+    (focus bool)
+    (state unsigned-int)))
+
+(def-alien-type x-focus-change-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (mode int)
+    (detail int)))
+
+(def-alien-type x-keymap-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (key-vector (array char 32))))
+
+(def-alien-type x-expose-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (x int)
+    (y int)
+    (width int)
+    (height int)
+    (count int)))
+
+(def-alien-type x-graphics-expose-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (drawable drawable)
+    (x int)
+    (y int)
+    (width int)
+    (height int)
+    (count int)
+    (major-code int)
+    (minor-code int)))
+
+(def-alien-type x-no-expose-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (drawable drawable)
+    (major-code int)
+    (minor-code int)))
+
+(def-alien-type x-visibility-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (state int)))
+
+(def-alien-type x-create-window-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (parent window)
+    (window window)
+    (x int)
+    (y int)
+    (width int)
+    (height int)
+    (override-redirect bool)))
+
+(def-alien-type x-destroy-window-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (event window)
+    (window window)))
+
+(def-alien-type x-unmap-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (event window)
+    (window window)
+    (from-configure bool)))
+
+(def-alien-type x-map-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (event window)
+    (window window)
+    (override-redirect bool)))
+
+(def-alien-type x-map-request-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (parent window)
+    (window window)))
+
+(def-alien-type x-reparent-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (event window)
+    (parent window)
+    (x int)
+    (y int)
+    (override-redirect bool)))
+
+(def-alien-type x-configure-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (event window)
+    (window window)
+    (x int)
+    (y int)
+    (width int)
+    (height int)
+    (border-width int)
+    (above window)
+    (override-redirect bool)))
+
+(def-alien-type x-gravity-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (event window)
+    (window window)
+    (x int)
+    (y int)))
+
+(def-alien-type x-resize-request-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (width int)
+    (height int)))
+
+(def-alien-type x-configure-request-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (parent window)
+    (window window)
+    (x int)
+    (y int)
+    (width int)
+    (height int)
+    (border-width int)
+    (above window)
+    (detail int)
+    (value-mask unsigned-long)))
+
+(def-alien-type x-circulate-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (event window)
+    (window window)
+    (place int)))
+
+(def-alien-type x-circulate-request-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (parent window)
+    (window window)
+    (place int)))
+
+(def-alien-type x-property-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (atom atom)
+    (time time)
+    (state int)))
+
+(def-alien-type x-selection-clear-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (selection atom)
+    (time time)))
+
+(def-alien-type x-selection-request-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (owner window)
+    (requestor window)
+    (selection atom)
+    (target atom)
+    (property atom)
+    (time time)))
+
+(def-alien-type x-selection-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (requestor window)
+    (selection atom)
+    (target atom)
+    (property atom)
+    (time time)))
+
+(def-alien-type x-colormap-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (colormap colormap)
+    (new bool)
+    (state int)))
+
+(def-alien-type x-client-message-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (message-type atom)
+    (format int)
+    (data (union nil
+		 (b (array char 20))
+		 (s (array short 10))
+		 (l (array long 5))))))
+
+(def-alien-type x-mapping-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)
+    (request int)
+    (first-keycode int)
+    (count int)))
+
+(def-alien-type x-any-event
+  (struct nil
+    (handle unsigned-long)
+    (type int)
+    (serial unsigned-long)
+    (send-event bool)
+    (window window)))
+
+(def-alien-type xevent
+  (union nil
+    (xany x-any-event)
+    (xkey x-key-event)
+    (xbutton x-button-event)
+    (xmotion x-motion-event)
+    (xcrossing x-crossing-event)
+    (xfocus x-focus-change-event)
+    (xexpose x-expose-event)
+    (xgraphicsexpose x-graphics-expose-event)
+    (xnoexpose x-no-expose-event)
+    (xvisibility x-visibility-event)
+    (xcreatewindow x-create-window-event)
+    (xdestroywindow x-destroy-window-event)
+    (xunmap x-unmap-event)
+    (xmap x-map-event)
+    (xmaprequest x-map-request-event)
+    (xreparent x-reparent-event)
+    (xconfigure x-configure-event)
+    (xgravity x-gravity-event)
+    (xresizerequest x-resize-request-event)
+    (xconfigurerequest x-configure-request-event)
+    (xcirculate x-circulate-event)
+    (xcirculaterequest x-circulate-request-event)
+    (xproperty x-property-event)
+    (xselectionclear x-selection-clear-event)
+    (xselectionrequest x-selection-request-event)
+    (xselection x-selection-event)
+    (xcolormap x-colormap-event)
+    (xclient x-client-message-event)
+    (xmapping x-mapping-event)
+    (xkeymap x-keymap-event)))
+
+(deftype toolkit-event () '(alien xevent))
+
+
+
+;;;; Functions for accessing the common fields of all XEvents
+
+(eval-when (compile eval)
+  (defmacro def-event-access (name union-slot slot)
+    `(defun ,name (event)
+       (declare (type toolkit-event event))
+       (alien:slot (alien:slot event ,union-slot) ,slot)))
+  
+  (defmacro def-event-window-access (name union-slot slot)
+    `(defun ,name (event)
+       (declare (type toolkit-event event))
+       (xlib::lookup-window
+	*x-display*
+	(alien:slot (alien:slot event ,union-slot) ,slot))))
+  
+  (defmacro def-event-drawable-access (name union-slot slot)
+    `(defun ,name (event)
+       (declare (type toolkit-event event))
+       (xlib::lookup-drawable
+	*x-display*
+	(alien:slot (alien:slot event ,union-slot) ,slot))))
+  
+  (defmacro def-event-colormap-access (name union-slot slot)
+    `(defun ,name (event)
+       (declare (type toolkit-event event))
+       (xlib::lookup-colormap
+	*x-display*
+	(alien:slot (alien:slot event ,union-slot) ,slot))))
+  
+  (defmacro def-event-atom-access (name union-slot slot)
+    `(defun ,name (event)
+       (declare (type toolkit-event event))
+       (xlib::atom-name *x-display*
+			(alien:slot (alien:slot event ,union-slot) ,slot))))
+) ;; EVAL-WHEN
+
+(declaim (inline event-handle event-serial event-send-event event-window
+		 event-type))
+
+(def-event-access event-handle 'xany 'handle)
+(def-event-access event-serial 'xany 'serial)
+(def-event-access event-send-event 'xany 'send-event)
+(def-event-window-access event-window 'xany 'window)
+(defun event-type (event)
+  (declare (type toolkit-event event))
+  (svref xlib::*event-key-vector*
+	 (alien:slot (alien:slot event 'xany) 'type)))
+
+
+;;;; Functions for accessing the fields of XButton events
+
+(declaim (inline button-event-root button-event-subwindow button-event-time
+		 button-event-x button-event-y button-event-x-root
+		 button-event-y-root button-event-state
+		 button-event-same-screen button-event-button))
+
+(def-event-window-access button-event-root 'xbutton 'root)
+(def-event-window-access button-event-subwindow 'xbutton 'subwindow)
+(def-event-access button-event-time 'xbutton 'time)
+(def-event-access button-event-x 'xbutton 'x)
+(def-event-access button-event-y 'xbutton 'y)
+(def-event-access button-event-x-root 'xbutton 'x-root)
+(def-event-access button-event-y-root 'xbutton 'y-root)
+(def-event-access button-event-state 'xbutton 'state)
+(def-event-access button-event-button 'xbutton 'button)
+(def-event-access button-event-same-screen 'xbutton 'same-screen)
+
+
+
+;;;; Functions for accessing the fields of XKey events
+
+(declaim (inline key-event-root key-event-subwindow key-event-time
+		 key-event-x key-event-y key-event-x-root key-event-y-root
+		 key-event-state key-event-keycode key-event-same-screen))
+
+(def-event-window-access key-event-root 'xkey 'root)
+(def-event-window-access key-event-subwindow 'xkey 'subwindow)
+(def-event-access key-event-time 'xkey 'time)
+(def-event-access key-event-x 'xkey 'x)
+(def-event-access key-event-y 'xkey 'y)
+(def-event-access key-event-x-root 'xkey 'x-root)
+(def-event-access key-event-y-root 'xkey 'y-root)
+(def-event-access key-event-state 'xkey 'state)
+(def-event-access key-event-keycode 'xkey 'keycode)
+(def-event-access key-event-same-screen 'xkey 'same-screen)
+
+
+
+;;;; Functions for accessing XMotion event slots
+
+(declaim (inline motion-event-root motion-event-subwindow motion-event-time
+		 motion-event-x motion-event-y motion-event-x-root
+		 motion-event-y-root motion-event-state motion-event-is-hint
+		 motion-event-same-screen))
+
+(def-event-window-access motion-event-root 'xmotion 'root)
+(def-event-window-access motion-event-subwindow 'xmotion 'subwindow)
+(def-event-access motion-event-time 'xmotion 'time)
+(def-event-access motion-event-x 'xmotion 'x)
+(def-event-access motion-event-y 'xmotion 'y)
+(def-event-access motion-event-x-root 'xmotion 'x-root)
+(def-event-access motion-event-y-root 'xmotion 'y-root)
+(def-event-access motion-event-state 'xmotion 'state)
+(def-event-access motion-event-is-hint 'xmotion 'is-hint)
+(def-event-access motion-event-same-screen 'xmotion 'same-screen)
+
+
+
+;;;; Functions for accessing XCrossingEvent slots
+
+(declaim (inline crossing-event-root crossing-event-subwindow
+		 crossing-event-time crossing-event-x crossing-event-y
+		 crossing-event-x-root crossing-event-y-root
+		 crossing-event-mode crossing-event-detail
+		 crossing-event-same-screen crossing-event-focus
+		 crossing-event-state))
+
+(def-event-window-access crossing-event-root 'xcrossing 'root)
+(def-event-window-access crossing-event-subwindow 'xcrossing 'subwindow)
+(def-event-access crossing-event-time 'xcrossing 'time)
+(def-event-access crossing-event-x 'xcrossing 'x)
+(def-event-access crossing-event-y 'xcrossing 'y)
+(def-event-access crossing-event-x-root 'xcrossing 'x-root)
+(def-event-access crossing-event-y-root 'xcrossing 'y-root)
+(def-event-access crossing-event-mode 'xcrossing 'mode)
+(def-event-access crossing-event-detail 'xcrossing 'detail)
+(def-event-access crossing-event-same-screen 'xcrossing 'same-screen)
+(def-event-access crossing-event-focus 'xcrossing 'focus)
+(def-event-access crossing-event-state 'xcrossing 'state)
+
+
+
+;;;; Functions for accessing XFocusChangeEvent slots
+
+(declaim (inline focus-change-event-mode focus-change-event-detail))
+
+(def-event-access focus-change-event-mode 'xfocus 'mode)
+(def-event-access focus-change-event-detail 'xfocus 'detail)
+
+
+
+;;;; Functions for accessing XKeymapEvent slots
+
+;; **** These need to be added
+
+
+
+;;;; Functions for accessing XExposeEvent slots
+
+(declaim (inline expose-event-x expose-event-y expose-event-width
+		 expose-event-height expose-event-count))
+
+(def-event-access expose-event-x 'xexpose 'x)
+(def-event-access expose-event-y 'xexpose 'y)
+(def-event-access expose-event-width 'xexpose 'width)
+(def-event-access expose-event-height 'xexpose 'height)
+(def-event-access expose-event-count 'xexpose 'count)
+
+
+
+;;;; Functions for accessing XGraphicsExposeEvent structures
+
+(declaim (inline graphics-expose-event-drawable graphics-expose-event-x
+		 graphics-expose-event-y graphics-expose-event-width
+		 graphics-expose-event-height graphics-expose-event-count
+		 graphics-expose-event-major-code
+		 graphics-expose-event-minor-code))
+
+(def-event-drawable-access graphics-expose-event-drawable
+			   'xgraphicsexpose 'drawable)
+(def-event-access graphics-expose-event-x 'xgraphicsexpose 'x)
+(def-event-access graphics-expose-event-y 'xgraphicsexpose 'y)
+(def-event-access graphics-expose-event-width 'xgraphicsexpose 'width)
+(def-event-access graphics-expose-event-height 'xgraphicsexpose 'height)
+(def-event-access graphics-expose-event-count 'xgraphicsexpose 'count)
+(def-event-access graphics-expose-event-major-code
+		  'xgraphicsexpose 'major-code)
+(def-event-access graphics-expose-event-minor-code
+		  'xgraphicsexpose 'minor-code)
+
+
+
+;;;; Functions for accessing XNoExposeEvent slots
+
+(declaim (inline no-expose-event-drawable no-expose-event-major-code
+		 no-expose-event-minor-code))
+
+(def-event-drawable-access no-expose-event-drawable 'xnoexpose 'drawable)
+(def-event-access no-expose-event-major-code 'xnoexpose 'major-code)
+(def-event-access no-expose-event-minor-code 'xnoexpose 'minor-code)
+
+
+
+;;;; Functions for accesssing XVisibilityEvent slots
+
+(declaim (inline visibility-event-state))
+
+(def-event-access visibility-event-state 'xvisibility 'state)
+
+
+
+;;;; Function for accessing XCreateWindowEvent data
+
+(declaim (inline create-window-event-parent create-window-event-window
+		 create-window-event-x create-window-event-y
+		 create-window-event-width create-window-event-height
+		 create-window-event-override-redirect))
+
+(def-event-window-access create-window-event-parent 'xcreatewindow 'parent)
+(def-event-window-access create-window-event-window 'xcreatewindow 'window)
+(def-event-access create-window-event-x 'xcreatewindow 'x)
+(def-event-access create-window-event-y 'xcreatewindow 'y)
+(def-event-access create-window-event-width 'xcreatewindow 'width)
+(def-event-access create-window-event-height 'xcreatewindow 'height)
+(def-event-access create-window-event-override-redirect
+		  'xcreatewindow 'override-redirect)
+
+
+
+;;;; Functions for accessing XDestroyWindowEvent slots
+
+(declaim (inline destroy-window-event-event destroy-window-event-window))
+
+(def-event-window-access destroy-window-event-event 'xdestroywindow 'event)
+(def-event-window-access destroy-window-event-window 'xdestroywindow 'window)
+
+
+
+;;;; Functions for accessing XUnmapEvent structures
+
+(declaim (inline unmap-event-event unmap-event-window
+		 unmap-event-from-configure))
+
+(def-event-window-access unmap-event-event 'xunmap 'event)
+(def-event-window-access unmap-event-window 'xunmap 'window)
+(def-event-access unmap-event-from-configure 'xunmap 'from-configure)
+
+
+
+;;;; Functions for accessing XMapRequestEvent slots
+
+(declaim (inline map-request-event-parent map-request-event-window))
+
+(def-event-window-access map-request-event-parent 'xmaprequest 'parent)
+(def-event-window-access map-request-event-window 'xmaprequest 'window)
+
+
+
+;;;; Functions to access XReparentEvent structures
+
+(declaim (inline reparent-event-event reparent-event-parent
+		 reparent-event-x reparent-event-y
+		 reparent-event-override-redirect))
+
+(def-event-window-access reparent-event-event 'xreparent 'event)
+(def-event-window-access reparent-event-parent 'xreparent 'parent)
+(def-event-access reparent-event-x 'xreparent 'x)
+(def-event-access reparent-event-y 'xreparent 'y)
+(def-event-access reparent-event-override-redirect
+		  'xreparent 'override-redirect)
+
+
+
+;;;; Functions to access XConfigureEvent slots
+
+(declaim (inline configure-event-event configure-event-window
+		 configure-event-x configure-event-y configure-event-width
+		 configure-event-height configure-event-border-width
+		 configure-event-above configure-event-override-redirect))
+
+(def-event-window-access configure-event-event 'xconfigure 'event)
+(def-event-window-access configure-event-window 'xconfigure 'window)
+(def-event-access configure-event-x 'xconfigure 'x)
+(def-event-access configure-event-y 'xconfigure 'y)
+(def-event-access configure-event-width 'xconfigure 'width)
+(def-event-access configure-event-height 'xconfigure 'height)
+(def-event-access configure-event-border-width 'xconfigure 'border-width)
+(def-event-window-access configure-event-above 'xconfigure 'above)
+(def-event-access configure-event-override-redirect
+		  'xconfigure 'override-redirect)
+
+
+
+;;;; Functions for accessing XGravityEvent slots
+
+(declaim (inline gravity-event-event gravity-event-window gravity-event-x
+		 gravity-event-y))
+
+(def-event-window-access gravity-event-event 'xgravity 'event)
+(def-event-window-access gravity-event-window 'xgravity 'window)
+(def-event-access gravity-event-x 'xgravity 'x)
+(def-event-access gravity-event-y 'xgravity 'y)
+
+
+
+;;;; Functions for accessing XResizeRequestEvent structures
+
+(declaim (inline resize-request-event-width resize-request-event-height))
+
+(def-event-access resize-request-event-width 'xresizerequest 'width)
+(def-event-access resize-request-event-height 'xresizerequest 'height)
+
+
+
+;;;; Functions for accessing XConfigureRequestEvent structures
+
+(declaim (inline configure-request-event-parent
+		 configure-request-event-window configure-request-event-x
+		 configure-request-event-y configure-request-event-width
+		 configure-request-event-height
+		 configure-request-event-border-width
+		 configure-request-event-above configure-request-event-detail
+		 configure-request-event-value-mask))
+
+(def-event-window-access configure-request-event-parent
+			 'xconfigurerequest 'parent)
+(def-event-window-access configure-request-event-window
+			 'xconfigurerequest 'window)
+(def-event-access configure-request-event-x 'xconfigurerequest 'x)
+(def-event-access configure-request-event-y 'xconfigurerequest 'y)
+(def-event-access configure-request-event-width 'xconfigurerequest 'width)
+(def-event-access configure-request-event-height 'xconfigurerequest 'height)
+(def-event-access configure-request-event-border-width
+		  'xconfigurerequest 'border-width)
+(def-event-window-access configure-request-event-above
+			 'xconfigurerequest 'above)
+(def-event-access configure-request-event-detail 'xconfigurerequest 'detail)
+(def-event-access configure-request-value-mask 'xconfigurerequest 'value-mask)
+
+
+
+;;;; Functions for accessing XCirculateEvent structures
+
+(declaim (inline circulate-event-event circulate-event-window
+		 circulate-event-place))
+
+(def-event-window-access circulate-event-event 'xcirculate 'event)
+(def-event-window-access circulate-event-window 'xcirculate 'window)
+(def-event-access circulate-event-place 'xcirculate 'place)
+
+
+
+;;;; Functions for accessing XCirculateRequestEvent slots
+
+(declaim (inline circulate-request-event-parent
+		 circulate-request-event-window circulate-request-event-place))
+
+(def-event-window-access circulate-request-event-parent
+			 'xcirculaterequest 'parent)
+(def-event-window-access circulate-request-event-window
+			 'xcirculaterequest 'window)
+(def-event-access circulate-request-event-place 'xcirculaterequest 'place)
+
+
+
+;;;; Functions for accessing XPropertyEvent slots
+
+(declaim (inline property-event-atom property-event-time property-event-state))
+
+(def-event-atom-access property-event-atom 'xproperty 'atom)
+(def-event-access property-event-time 'xproperty 'time)
+(def-event-access property-event-state 'xproperty 'state)
+
+
+
+;;;; Functions for accessing XSelectionClearEvent slots
+
+(declaim (inline selection-clear-event-selection selection-clear-event-time))
+
+(def-event-atom-access selection-clear-event-selection
+		       'xselectionclear 'selection)
+(def-event-access selection-clear-event-time 'xselectionclear 'time)
+
+
+
+;;;; Functions for accessing XSelectionRequestEvent slots
+
+(declaim (inline selection-request-event-owner
+		 selection-request-event-requestor
+		 selection-request-event-selection
+		 selection-request-event-target
+		 selection-request-event-property selection-request-event-time))
+
+(def-event-window-access selection-request-event-owner
+			 'xselectionrequest 'owner)
+(def-event-window-access selection-request-event-requestor
+			 'xselectionrequest 'requestor)
+(def-event-atom-access selection-request-event-selection
+		       'xselectionrequest 'selection)
+(def-event-atom-access selection-request-event-target
+		       'xselectionrequest 'target)
+(def-event-atom-access selection-request-event-property
+		       'xselectionrequest 'property)
+(def-event-access selection-request-event-time 'xselectionrequest 'time)
+
+
+
+;;;; Functions for accessing XSelectionEvent structures
+
+(declaim (inline selection-event-requestor selection-event-selection
+		 selection-event-target selection-event-property
+		 selection-event-time))
+
+(def-event-window-access selection-event-requestor 'xselection 'requestor)
+(def-event-atom-access selection-event-selection 'xselection 'selection)
+(def-event-atom-access selection-event-target 'xselection 'target)
+(def-event-atom-access selection-event-property 'xselection 'property)
+(def-event-access selection-event-time 'xselection 'time)
+
+
+
+;;;; Functions for accessing XColormapEvent structures
+
+(declaim (inline colormap-event-colormap colormap-event-new
+		 colormap-event-state))
+
+(def-event-colormap-access colormap-event-colormap 'xcolormap 'colormap)
+(def-event-access colormap-event-new 'xcolormap 'new)
+(def-event-access colormap-event-state 'xcolormap 'state)
+
+
+
+;;;; Functions for accessing XClientMessageEvent structures
+
+(declaim (inline client-message-event-message-type client-message-event-format))
+
+(def-event-atom-access client-message-event-message-type
+		       'xclient 'message-type)
+(def-event-access client-message-event-format 'xclient 'format)
+;; ***** Need to access client-msg data
+
+
+
+;;;; Functions for accessing XMappingEvent slots
+
+(declaim (inline mapping-event-request mapping-event-first-keycode
+		 mapping-event-count))
+
+(def-event-access mapping-event-request 'xmapping 'request)
+(def-event-access mapping-event-first-keycode 'xmapping 'first-keycode)
+(def-event-access mapping-event-count 'xmapping 'count)
diff --git a/motif/lisp/initial.lisp b/motif/lisp/initial.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..6ee8bbe59577d0a7b960df4b8528edd11fa02895
--- /dev/null
+++ b/motif/lisp/initial.lisp
@@ -0,0 +1,226 @@
+;;;; -*- Mode: Lisp ; Package: User -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; This file is the initial startup code for the Motif Toolkit
+;;;
+
+(in-package  "USER")
+
+
+
+;;;; Set up Lisp for the loading of the Motif toolkit
+
+(defpackage "TOOLKIT-INTERNALS"
+  (:nicknames "XTI")
+  (:use "COMMON-LISP" "EXTENSIONS" "ALIEN" "C-CALL")
+  (:export "*MOTIF-CONNECTION*" "*X-DISPLAY*" "MOTIF-CONNECTION"
+	   "MAKE-MOTIF-CONNECTION" "MOTIF-CONNECTION-FD"
+	   "MOTIF-CONNECTION-DISPLAY-NAME" "MOTIF-CONNECTION-DISPLAY"
+	   "MOTIF-CONNECTION-SERIAL" "MOTIF-CONNECTION-WIDGET-TABLE"
+	   "MOTIF-CONNECTION-FUNCTION-TABLE"
+	   "MOTIF-CONNECTION-CALLBACK-TABLE" "MOTIF-CONNECTION-CLOSE-HOOK"
+	   "MOTIF-CONNECTION-PROTOCOL-TABLE" "MOTIF-CONNECTION-TERMINATED"
+	   "MOTIF-CONNECTION-EVENT-TABLE" "TOOLKIT-ERROR"
+	   "TOOLKIT-CERROR" "TOOLKIT-EOF-ERROR" "CONNECT-TO-HOST"
+	   "WAIT-FOR-INPUT" "WAIT-FOR-INPUT-OR-TIMEOUT" "WIDGET"
+	   "MAKE-WIDGET" "WIDGET-ID" "WIDGET-TYPE" "WIDGET-PARENT"
+	   "WIDGET-CHILDREN" "WIDGET-CALLBACKS" "WIDGET-PROTOCOLS"
+	   "WIDGET-EVENTS" "WIDGET-USER-DATA" "MOTIF-OBJECT" "FONT-LIST"
+	   "XMSTRING" "TRANSLATIONS" "ACCELERATORS" "SYMBOL-RESOURCE"
+	   "SYMBOL-CLASS" "SYMBOL-ATOM" "WIDGET-ADD-CHILD" "CREATE-MESSAGE"
+	   "DESTROY-MESSAGE" "TRANSMIT-MESSAGE" "RECEIVE-MESSAGE"
+	   "CREATE-NEXT-MESSAGE" "PREPARE-REQUEST" "*TYPE-TABLE*"
+	   "*ENUM-TABLE*" "TOOLKIT-READ-VALUE" "TOOLKIT-WRITE-VALUE"
+	   "TOOLKIT-EVENT" "EVENT-HANDLE" "EVENT-SERIAL" "EVENT-SEND-EVENT"
+	   "EVENT-WINDOW" "EVENT-TYPE" "BUTTON-EVENT-ROOT"
+	   "BUTTON-EVENT-SUBWINDOW" "BUTTON-EVENT-TIME" "BUTTON-EVENT-X"
+	   "BUTTON-EVENT-Y" "BUTTON-EVENT-X-ROOT" "BUTTON-EVENT-Y-ROOT"
+	   "BUTTON-EVENT-STATE" "BUTTON-EVENT-SAME-SCREEN"
+	   "BUTTON-EVENT-BUTTON" "KEY-EVENT-ROOT" "KEY-EVENT-SUBWINDOW"
+	   "KEY-EVENT-TIME" "KEY-EVENT-X" "KEY-EVENT-Y" "KEY-EVENT-X-ROOT"
+	   "KEY-EVENT-Y-ROOT" "KEY-EVENT-STATE" "KEY-EVENT-KEYCODE"
+	   "KEY-EVENT-SAME-SCREEN" "MOTION-EVENT-ROOT"
+	   "MOTION-EVENT-SUBWINDOW" "MOTION-EVENT-TIME" "MOTION-EVENT-X"
+	   "MOTION-EVENT-Y" "MOTION-EVENT-X-ROOT" "MOTION-EVENT-Y-ROOT"
+	   "MOTION-EVENT-STATE" "MOTION-EVENT-IS-HINT"
+	   "MOTION-EVENT-SAME-SCREEN" "CROSSING-EVENT-ROOT"
+	   "CROSSING-EVENT-SUBWINDOW" "CROSSING-EVENT-TIME"
+	   "CROSSING-EVENT-X" "CROSSING-EVENT-Y" "CROSSING-EVENT-X-ROOT"
+	   "CROSSING-EVENT-Y-ROOT" "CROSSING-EVENT-MODE"
+	   "CROSSING-EVENT-DETAIL" "CROSSING-EVENT-FOCUS"
+	   "CROSSING-EVENT-SAME-SCREEN" "CROSSING-EVENT-STATE"
+	   "FOCUS-CHANGE-EVENT-MODE" "FOCUS-CHANGE-EVENT-DETAIL"
+	   "EXPOSE-EVENT-X" "EXPOSE-EVENT-Y" "EXPOSE-EVENT-WIDTH"
+	   "EXPOSE-EVENT-HEIGHT" "EXPOSE-EVENT-COUNT"
+	   "GRAPHICS-EXPOSE-EVENT-X" "GRAPHICS-EXPOSE-EVENT-DRAWABLE"
+	   "GRAPHICS-EXPOSE-EVENT-Y" "GRAPHICS-EXPOSE-EVENT-WIDTH"
+	   "GRAPHICS-EXPOSE-EVENT-HEIGHT" "GRAPHICS-EXPOSE-EVENT-COUNT"
+	   "GRAPHICS-EXPOSE-EVENT-MAJOR-CODE"
+	   "GRAPHICS-EXPOSE-EVENT-MINOR-CODE" "NO-EXPOSE-EVENT-MINOR-CODE"
+	   "NO-EXPOSE-EVENT-DRAWABLE" "NO-EXPOSE-EVENT-MAJOR-CODE"
+	   "VISIBILITY-EVENT-STATE" "CREATE-WINDOW-EVENT-PARENT"
+	   "CREATE-WINDOW-EVENT-WINDOW" "CREATE-WINDOW-EVENT-X"
+	   "CREATE-WINDOW-EVENT-Y" "CREATE-WINDOW-EVENT-WIDTH"
+	   "CREATE-WINDOW-EVENT-HEIGHT"
+	   "CREATE-WINDOW-EVENT-OVERRIDE-REDIRECT"
+	   "DESTROY-WINDOW-EVENT-EVENT" "DESTROY-WINDOW-EVENT-WINDOW"
+	   "UNMAP-EVENT-EVENT" "UNMAP-EVENT-WINDOW"
+	   "UNMAP-EVENT-FROM-CONFIGURE" "MAP-REQUEST-EVENT-PARENT"
+	   "MAP-REQUEST-EVENT-WINDOW" "REPARENT-EVENT-EVENT"
+	   "REPARENT-EVENT-PARENT" "REPARENT-EVENT-X" "REPARENT-EVENT-Y"
+	   "REPARENT-EVENT-OVERRIDE-REDIRECT" "CONFIGURE-EVENT-EVENT"
+	   "CONFIGURE-EVENT-WINDOW" "CONFIGURE-EVENT-X" "CONFIGURE-EVENT-Y"
+	   "CONFIGURE-EVENT-WIDTH" "CONFIGURE-EVENT-HEIGHT"
+	   "CONFIGURE-EVENT-BORDER-WIDTH" "CONFIGURE-EVENT-ABOVE"
+	   "CONFIGURE-EVENT-OVERRIDE-REDIRECT" "GRAVITY-EVENT-EVENT"
+	   "GRAVITY-EVENT-WINDOW" "GRAVITY-EVENT-X" "GRAVITY-EVENT-Y"
+	   "RESIZE-REQUEST-EVENT-WIDTH" "RESIZE-REQUEST-EVENT-HEIGHT"
+	   "CONFIGURE-REQUEST-EVENT-PARENT"
+	   "CONFIGURE-REQUEST-EVENT-WINDOW" "CONFIGURE-REQUEST-EVENT-X"
+	   "CONFIGURE-REQUEST-EVENT-Y" "CONFIGURE-REQUEST-EVENT-WIDTH"
+	   "CONFIGURE-REQUEST-EVENT-HEIGHT" "CONFIGURE-REQUEST-EVENT-ABOVE"
+	   "CONFIGURE-REQUEST-EVENT-BORDER-WIDTH"
+	   "CONFIGURE-REQUEST-EVENT-DETAIL"
+	   "CONFIGURE-REQUEST-EVENT-VALUE-MASK" "CIRCULATE-EVENT-EVENT"
+	   "CIRCULATE-EVENT-WINDOW" "CIRCULATE-EVENT-PLACE"
+	   "CIRCULATE-REQUEST-EVENT-EVENT" "CIRCULATE-REQUEST-EVENT-WINDOW"
+	   "CIRCULATE-REQUEST-EVENT-PLACE" "PROPERTY-EVENT-ATOM"
+	   "PROPERTY-EVENT-TIME" "PROPERTY-EVENT-STATE"
+	   "SELECTION-CLEAR-EVENT-SELECTION" "SELECTION-CLEAR-EVENT-TIME"
+	   "SELECTION-REQUEST-EVENT-OWNER"
+	   "SELECTION-REQUEST-EVENT-REQUESTOR"
+	   "SELECTION-REQUEST-EVENT-SELECTION"
+	   "SELECTION-REQUEST-EVENT-TARGET"
+	   "SELECTION-REQUEST-EVENT-PROPERTY"
+	   "SELECTION-REQUEST-EVENT-TIME" "SELECTION-EVENT-REQUESTOR"
+	   "SELECTION-EVENT-SELECTION" "SELECTION-EVENT-TARGET"
+	   "SELECTION-EVENT-PROPERTY" "SELECTION-EVENT-TIME"
+	   "COLORMAP-EVENT-COLORMAP" "COLORMAP-EVENT-NEW"
+	   "COLORMAP-EVENT-STATE" "MAPPING-EVENT-REQUEST"
+	   "MAPPING-EVENT-FIRST-KEYCODE" "MAPPING-EVENT-COUNT"))
+
+(defpackage "TOOLKIT"
+  (:nicknames "XT")
+  (:use "COMMON-LISP" "EXTENSIONS" "TOOLKIT-INTERNALS")
+  (:export "ADD-CALLBACK" "REMOVE-CALLBACK" "REMOVE-ALL-CALLBACKS"
+	   "ADD-PROTOCOL-CALLBACK" "REMOVE-PROTOCOL-CALLBACK"
+	   "ADD-WM-PROTOCOL-CALLBACK" "REMOVE-WM-PROTOCOL-CALLBACK"
+	   "WITH-CALLBACK-EVENT" "WITH-ACTION-EVENT" "ADD-EVENT-HANDLER"
+	   "REMOVE-EVENT-HANDLER" "ANY-CALLBACK" "ANY-CALLBACK-REASON"
+	   "ANY-CALLBACK-EVENT" "BUTTON-CALLBACK" "DRAWING-AREA-CALLBACK"
+	   "BUTTON-CALLBACK-CLICK-COUNT" "DRAWING-AREA-CALLBACK-WINDOW"
+	   "DRAWN-BUTTON-CALLBACK" "DRAWN-BUTTON-CALLBACK-WINDOW"
+	   "DRAWN-BUTTON-CALLBACK-CLICK-COUNT" "SCROLL-BAR-CALLBACK"
+	   "SCROLL-BAR-CALLBACK-VALUE" "SCROLL-BAR-CALLBACK-PIXEL"
+	   "TOGGLE-BUTTON-CALLBACK" "TOGGLE-BUTTON-CALLBACK-SET"
+	   "LIST-CALLBACK" "LIST-CALLBACK-ITEM"
+	   "LIST-CALLBACK-ITEM-POSITION" "LIST-CALLBACK-SELECTED-ITEMS"
+	   "LIST-CALLBACK-SELECTED-ITEM-POSITIONS"
+	   "LIST-CALLBACK-SELECTION-TYPE" "SELECTION-CALLBACK"
+	   "SELECTION-CALLBACK-VALUE" "FILE-SELECTION-CALLBACK"
+	   "FILE-SELECTION-CALLBACK-VALUE" "FILE-SELECTION-CALLBACK-MASK"
+	   "FILE-SELECTION-CALLBACK-DIR" "FILE-SELECTION-CALLBACK-PATTERN"
+	   "SCALE-CALLBACK" "SCALE-CALLBACK-VALUE" "TEXT-CALLBACK"
+	   "TEXT-CALLBACK-DOIT" "TEXT-CALLBACK-CURR-INSERT"
+	   "TEXT-CALLBACK-NEW-INSERT" "TEXT-CALLBACK-START-POS"
+	   "TEXT-CALLBACK-END-POS" "TEXT-CALLBACK-TEXT" "WITH-ACTION-EVENT"
+	   "TEXT-CALLBACK-FORMAT" "*DEBUG-MODE*" "*DEFAULT-SERVER-HOST*"
+	   "*CLM-BINARY-DIRECTORY*" "*CLM-BINARY-NAME*"
+	   "*DEFAULT-DISPLAY*" "QUIT-APPLICATION" "WITH-MOTIF-CONNECTION"
+	   "RUN-MOTIF-APPLICATION" "WITH-CLX-REQUESTS"
+	   "BUILD-SIMPLE-FONT-LIST" "BUILD-FONT-LIST" "*MOTIF-CONNECTION*"
+	   "*X-DISPLAY*" "WIDGET" "XMSTRING" "FONT-LIST" "SET-VALUES"
+	   "GET-VALUES" "CREATE-MANAGED-WIDGET" "CREATE-WIDGET"
+	   "CREATE-POPUP-SHELL" "CREATE-APPLICATION-SHELL" "DESTROY-WIDGET"
+	   "*CONVENIENCE-AUTO-MANAGE*" "MANAGE-CHILDREN"
+	   "UNMANAGE-CHILDREN" "WITH-RESOURCE-VALUES" "MENU-POSITION"
+	   "CREATE-ARROW-BUTTON" "CREATE-ARROW-BUTTON-GADGET"
+	   "CREATE-BULLETIN-BOARD" "CREATE-CASCADE-BUTTON"
+	   "CREATE-CASCADE-BUTTON-GADGET" "CREATE-COMMAND"
+	   "CREATE-DIALOG-SHELL" "CREATE-DRAWING-AREA"
+	   "CREATE-DRAWN-BUTTON" "CREATE-FILE-SELECTION-BOX" "CREATE-FORM"
+	   "CREATE-FRAME" "CREATE-LABEL" "CREATE-LABEL-GADGET"
+	   "CREATE-LIST" "CREATE-MAIN-WINDOW" "CREATE-MENU-SHELL"
+	   "CREATE-MESSAGE-BOX" "CREATE-PANED-WINDOW" "CREATE-PUSH-BUTTON"
+	   "CREATE-PUSH-BUTTON-GADGET" "CREATE-ROW-COLUMN" "CREATE-SCALE"
+	   "CREATE-SCROLL-BAR" "CREATE-SCROLLED-WINDOW"
+	   "CREATE-SELECTION-BOX" "CREATE-SEPARATOR"
+	   "CREATE-SEPARATOR-GADGET" "CREATE-TEXT" "CREATE-TOGGLE-BUTTON"
+	   "CREATE-TOGGLE-BUTTON-GADGET" "CREATE-MENU-BAR"
+	   "CREATE-OPTION-MENU" "CREATE-RADIO-BOX" "CREATE-WARNING-DIALOG"
+	   "CREATE-BULLETIN-BOARD-DIALOG" "CREATE-ERROR-DIALOG"
+	   "CREATE-FILE-SELECTION-DIALOG" "CREATE-FORM-DIALOG"
+	   "CREATE-INFORMATION-DIALOG" "CREATE-MESSAGE-DIALOG"
+	   "CREATE-POPUP-MENU" "CREATE-PROMPT-DIALOG"
+	   "CREATE-PULLDOWN-MENU" "CREATE-QUESTION-DIALOG"
+	   "CREATE-SCROLLED-LIST" "CREATE-SCROLLED-TEXT"
+	   "CREATE-SELECTION-DIALOG" "CREATE-WORKIG-DIALOG"
+	   "REALIZE-WIDGET" "UNREALIZE-WIDGET" "MAP-WIDGET" "UNMAP-WIDGET"
+	   "SET-SENSITIVE" "POPUP" "POPDOWN" "MANAGE-CHILD"
+	   "UNMANAGE-CHILD" "PARSE-TRANSLATION-TABLE"
+	   "AUGMENT-TRANSLATIONS" "OVERRIDE-TRANSLATIONS"
+	   "UNINSTALL-TRANSLATIONS" "PARSE-ACCELERATOR-TABLE"
+	   "INSTALL-ACCELERATORS" "INSTALL-ALL-ACCELERATORS" "IS-MANAGED"
+	   "POPUP-SPRING-LOADED" "IS-REALIZED" "WIDGET-WINDOW" "WIDGET-NAME"
+	   "IS-SENSITIVE" "COMMAND-APPEND-VALUE" "COMMAND-ERROR"
+	   "COMMAND-SET-VALUE" "SCALE-GET-VALUE" "SCALE-SET-VALUE"
+	   "TOGGLE-BUTTON-GET-STATE" "TOGGLE-BUTTON-SET-STATE"
+	   "LIST-ADD-ITEM" "LIST-ADD-ITEM-UNSELECTED" "LIST-DELETE-ITEM"
+	   "LIST-DELETE-POS" "LIST-DESELECT-ALL-ITEMS" "LIST-DESELECT-ITEM"
+	   "LIST-DESELECT-POS" "LIST-SELECT-ITEM" "LIST-SELECT-POS"
+	   "LIST-SET-BOTTOM-ITEM" "LIST-SET-BOTTOM-POS"
+	   "LIST-SET-HORIZ-POS" "LIST-SET-ITEM" "LIST-SET-POS"
+	   "ADD-TAB-GROUP" "REMOVE-TAB-GROUP" "PROCESS-TRAVERSAL"
+	   "FONT-LIST-ADD" "FONT-LIST-CREATE" "FONT-LIST-FREE"
+	   "COMPOUND-STRING-BASELINE" "COMPOUND-STRING-BYTE-COMPARE"
+	   "COMPOUND-STRING-COMPARE" "COMPOUND-STRING-CONCAT"
+	   "COMPOUND-STRING-COPY" "COMPOUND-STRING-CREATE"
+	   "COMPOUND-STRING-CREATE-LTOR" "COMPOUND-STRING-CREATE-SIMPLE"
+	   "COMPOUND-STRING-CREATE-EMPTY" "COMPOUND-STRING-CREATE-EXTENT"
+	   "COMPOUND-STRING-FREE" "COMPOUND-STRING-HAS-SUBSTRING"
+	   "COMPOUND-STRING-HEIGHT" "COMPOUND-STRING-LENGTH"
+	   "COMPOUND-LINE-COUNT" "COMPOUND-STRING-NCONCAT"
+	   "COMPOUND-STRING-NCOPY" "COMPOUND-STRING-SEPARATOR-CREATE"
+	   "COMPOUND-STRING-WIDTH" "TEXT-CLEAR-SELECTION" "TEXT-COPY"
+	   "TEXT-CUT" "TEXT-GET-BASELINE" "TEXT-GET-EDITABLE"
+	   "TEXT-GET-INSERTION-POINT" "TEXT-GET-LAST-POSITION"
+	   "TEXT-GET-MAX-LENGTH" "TEXT-GET-SELECTION"
+	   "TEXT-GET-SELECTION-POSITION" "TEXT-GET-STRING"
+	   "TEXT-GET-TOP-CHARACTER" "TEXT-INSERT" "TEXT-PASTE"
+	   "TEXT-POS-TO-XY" "TEXT-REMOVE" "TEXT-REPLACE" "TEXT-SCROLL"
+	   "TEXT-SET-ADD-MODE" "TEXT-SET-EDITABLE" "TEXT-SET-HIGHLIGHT"
+	   "TEXT-SET-INSERTION-POSITION" "TEXT-SET-MAX-LENGTH"
+	   "TEXT-SET-SELECTION" "TEXT-SET-STRING" "TEXT-SET-TOP-CHARACTER"
+	   "TEXT-SHOW-POSITION" "TEXT-XY-TO-POS" "MESSAGE-BOX-GET-CHILD"
+	   "SELECTION-BOX-GET-CHILD" "FILE-SELECTION-BOX-GET-CHILD"
+	   "COMMAND-GET-CHILD" "UPDATE-DISPLAY" "IS-MOTIF-WM-RUNNING"
+	   "LIST-ADD-ITEMS" "LIST-DELETE-ALL-ITEMS" "LIST-DELETE-ITEMS"
+	   "LIST-DELETE-ITEMS-POS" "LIST-ITEM-EXISTS" "LIST-ITEM-POS"
+	   "LIST-REPLACE-ITEMS" "LIST-REPLACE-ITEMS-POS"
+	   "LIST-SET-ADD-MODE" "TRANSLATE-COORDS" "SCROLL-BAR-GET-VALUES"
+	   "SCROLL-BAR-SET-VALUES" "COMPOUND-STRING-GET-LTOR"
+	   "TRACKING-LOCATE" "SCROLLED-WINDOW-SET-AREAS" "CREATE-FONT-CURSOR"
+	   "LIST-GET-SELECTED-POS" "QUIT-APPLICATION-CALLBACK"
+	   "DESTROY-CALLBACK" "MANAGE-CALLBACK" "UNMANAGE-CALLBACK"
+	   "POPUP-CALLBACK" "POPDOWN-CALLBACK" "SET-ITEMS" "GET-ITEMS"
+	   "WITH-CALLBACK-DEFERRED-ACTIONS"))
+
+
+
+;;;; Set up the tables used in defining interface components.
+
+(in-package "TOOLKIT")
+
+(defvar *request-table* (make-array 50 :element-type 'simple-string
+				    :adjustable t :fill-pointer 0))
+(defvar *class-table* (make-array 40 :element-type 'cons
+				  :adjustable t :fill-pointer 0))
+(defvar next-type-tag)
diff --git a/motif/lisp/interface-build.lisp b/motif/lisp/interface-build.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..e1578e232d8754f7b28bb1969ebae7abb6aab337
--- /dev/null
+++ b/motif/lisp/interface-build.lisp
@@ -0,0 +1,89 @@
+;;;; -*- Mode: Lisp ; Package: Toolkit -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; Interface Builder
+;;;
+;;; This defines functions to crunch through the information generated
+;;; about the various request operations and automatically generate the
+;;; interface files for the C server.
+
+(in-package "TOOLKIT")
+
+
+
+;;;; Files where interface information will be stored
+
+(defconstant *string-table-file* "target:motif/server/StringTable.h")
+(defconstant *class-file* "target:motif/server/ClassTable.h")
+(defconstant *interface-file* "target:motif/server/Interface.h")
+(defconstant *type-file* "target:motif/server/TypeTable.h")
+
+
+
+;;;; Functions for building the C interface files
+
+(defun build-class-file (out)
+  (declare (stream out))
+  (write-line "WidgetClass *class_table[] = {" out)
+  (dotimes (index (length *class-table*))
+    (let ((entry (aref *class-table* index)))
+      (format out "  (WidgetClass *)(&~a),~%" (cdr entry))))
+  (format out "  NULL~%};~%~%#define CLASS_TABLE_SIZE ~a~%"
+	  (length *class-table*)))
+
+(defun build-type-file (out)
+  (declare (stream out))
+  (write-line "type_entry type_table[] = {" out)
+  (dotimes (index next-type-tag)
+    (let* ((stuff (svref *type-table* index))
+	   (name (car stuff))
+	   (kind (cdr stuff)))
+      (if (and (eq kind name) (gethash kind *enum-table*))
+	  (setf kind (symbol-atom :enum))
+	  (setf kind (symbol-atom kind)))
+      (format out "  {\"~a\",message_write_~(~a~),message_read_~(~a~)},~%"
+	      (symbol-class name) kind kind)))
+  (format out "  {NULL,NULL,NULL}~%};~%~%#define TYPE_TABLE_SIZE ~a~%"
+	  next-type-tag))
+
+(defun build-interface-file (out)
+  (declare (stream out))
+  (write-line "request_f request_table[] = {" out)
+  (dotimes (index (length *request-table*))
+    (format out "  ~a,~%" (aref *request-table* index)))
+  (format out "  NULL~%};~%"))
+
+(defun build-toolkit-interface ()
+  (with-open-file (out *class-file*
+		       :direction :output :if-exists :supersede
+		       :if-does-not-exist :create)
+    (build-class-file out))
+  (with-open-file (out *type-file*
+		       :direction :output :if-exists :supersede
+		       :if-does-not-exist :create)
+    (build-type-file out))
+  (with-open-file (out *interface-file*
+		       :direction :output :if-exists :supersede
+		       :if-does-not-exist :create)
+    (build-interface-file out)))
+
+(defun build-string-table ()
+  (with-open-file (out *string-table-file*
+		       :direction :output :if-exists :supersede
+		       :if-does-not-exist :create)
+    (declare (stream out))
+    (let ((table xti::*toolkit-string-table*))
+      (declare (simple-vector table))
+      (write-line "String string_table[] = {" out)
+      (dotimes (index (length table))
+	(format out "  \"~a\",~%" (svref table index)))
+      (format out "  NULL~%};~%~%")
+      (format out "#define STRING_TABLE_SIZE ~a~%" (length table)))))
diff --git a/motif/lisp/interface-glue.lisp b/motif/lisp/interface-glue.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..a2605f739a832f498d8dde50b4bdc1c87672fe29
--- /dev/null
+++ b/motif/lisp/interface-glue.lisp
@@ -0,0 +1,213 @@
+;;;; -*- Mode: Lisp ; Package: Toolkit -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; Functions which provide the glue for the interface between the C server
+;;; and the Lisp client.
+
+(in-package "TOOLKIT")
+
+
+
+;;;; Functions for handling server requests
+
+(defvar reply-table
+  (vector :confirm :values :callback :event :error :warning :protocol :action))
+
+(defun wait-for-server-reply (fd)
+  (wait-for-input fd)
+  (loop
+    (let ((reply (dispatch-server-reply fd)))
+      (when reply (return reply)))))
+
+(defun dispatch-server-reply (fd)
+  (let* ((reply (receive-message fd))
+	 (kind (svref reply-table (xti::message-get-dblword reply))))
+    (case kind
+      ((:confirm :values) reply)
+      (:callback (handle-callback reply))
+      (:protocol (handle-protocol reply))
+      (:action   (handle-action reply))
+      (:event    (handle-event reply))
+      (:error
+       (let ((errmsg (toolkit-read-value reply)))
+	 (destroy-message reply)
+	 (toolkit-error "Toolkit Server -- ~a" errmsg)))
+      (:warning
+       (let ((errmsg (toolkit-read-value reply)))
+	 (destroy-message reply)
+	 (warn "Toolkit Server -- ~a" errmsg)
+	 ;; Point out that this was not really a reply
+	 nil))
+      (t 
+       (destroy-message reply)
+       (toolkit-error "Invalid reply type: ~d" kind)))))
+
+(defun send-request-to-server (message options)
+  (let ((fd (motif-connection-fd *motif-connection*)))
+    (unwind-protect
+	(transmit-message message fd)
+      (destroy-message message))
+    (when (eq options :confirm) (wait-for-server-reply fd))))
+
+
+
+;;;; Functions for handling server connections
+
+(defvar *default-server-host* nil
+  "Name of machine where the Motif server resides.  Using the value NIL
+   causes a local connection to be made.")
+
+(defvar *default-display* nil
+  "If non-nil, the display which will be opened.  Otherwise, the DISPLAY
+   environment variable is consulted.")
+
+(defvar *debug-mode* nil
+  "Controls whether the client is in debugging mode.")
+
+(defvar *active-handlers* nil
+  "An alist of (fd . handler) for active X toolkit connections.")
+
+(defvar *default-timeout-interval* 15
+  "Default time, in seconds, which the Lisp process will wait for input on
+   the toolkit connection before assuming a timeout has occured.")
+
+(defvar *clm-binary-directory* "library:"
+  "Directory in which the Motif server resides.")
+
+(defvar *clm-binary-name* "motifd"
+  "Name of the Motif server executable.")
+
+(defun add-toolkit-handler (conn)
+  (let ((fd (motif-connection-fd conn)))
+    (when (assoc fd *active-handlers*)
+      (break "There is already a handler for fd=~d " fd))
+    (push (cons fd
+		(system:add-fd-handler
+		 fd :input
+		 #'(lambda (this-fd)
+		     (declare (ignore this-fd))
+		     (toolkit-handler conn))))
+	  *active-handlers*)))
+
+(defun remove-toolkit-handler (fd)
+  (let ((handler (cdr (assoc fd *active-handlers*))))
+    (unless handler
+      (toolkit-error "Cannot remove handler (fd=~d) because there is none." fd))
+    (system:remove-fd-handler handler)
+    (setf *active-handlers* (remove fd *active-handlers*
+				    :key #'car :test #'=))))
+
+(defvar *local-motif-server* nil)
+
+(defun local-server-status-hook (process)
+  (let ((status (ext:process-status process)))
+    (when (or (eq status :exited)
+	      (eq status :signaled))
+      (setf *local-motif-server* nil))))
+
+(defun verify-local-server-exists ()
+  (when (or (not *local-motif-server*)
+	    (and *local-motif-server*
+		 (not (ext:process-alive-p *local-motif-server*))))
+    (let ((process (ext:run-program (merge-pathnames *clm-binary-name*
+						     *clm-binary-directory*)
+				    '()
+				    :wait nil
+				    :status-hook #'local-server-status-hook)))
+      (unless (and process (ext:process-alive-p process))
+	(toolkit-error "Could not start local Motif server process."))
+      ;;
+      ;; Wait until the server has started up
+      (loop
+	(when (probe-file (format nil "/tmp/.motif_socket-u~a"
+				  (unix:unix-getuid)))
+	  (return))
+	(sleep 1))
+      (setf *local-motif-server* process))))
+
+(defun open-motif-connection (host dpy-name app-name app-class &optional pid)
+  (declare (simple-string app-name app-class))
+  (unless (or host pid)
+    (verify-local-server-exists))
+  (let* ((socket (connect-to-host host pid))
+	 (tmp (system:allocate-system-memory 4))
+	 (conn (make-motif-connection socket))
+	 (display (or dpy-name (cdr (assoc :display *environment-list*))))
+	 (clx-dpy (open-clx-display display))
+	 (greeting (create-message 0)))
+
+    (unless display
+      (toolkit-error "No display name available."))
+
+    ;;
+    ;; Fairly gross means of sending the swap information to the server
+    (setf (system:sap-ref-16 tmp 0) 1)
+    (unwind-protect
+	(unix:unix-write socket tmp 0 2)
+      (system:deallocate-system-memory tmp 4))
+
+    (toolkit-write-value greeting display)
+    (toolkit-write-value greeting app-name)
+    (toolkit-write-value greeting app-class)
+    (transmit-message greeting socket)
+    (destroy-message greeting)
+
+    (setf (motif-connection-display-name conn) display)
+    (setf (motif-connection-display conn) clx-dpy)
+    (add-toolkit-handler conn)
+    conn))
+
+(defun close-motif-connection (connection)
+  (unless (motif-connection-terminated connection)
+    (let ((fd (motif-connection-fd connection))
+	  (hook (motif-connection-close-hook connection)))
+      (when hook
+	(funcall hook connection))
+      (setf (motif-connection-terminated connection) t)
+      (remove-toolkit-handler fd)
+      (close-socket fd)
+      (xlib:close-display (motif-connection-display connection)))))
+
+(defmacro with-motif-connection ((connection) &body forms)
+  `(let ((*motif-connection* ,connection)
+	 (*x-display* (motif-connection-display ,connection)))
+     (handler-case
+	 (restart-case
+	     (progn ,@forms)
+	   (continue ()
+	             :report "Ignore problem and continue."
+	     ())
+	   (kill-app ()
+ 	             :report "Close current application."
+	     (quit-server)     
+	     (close-motif-connection ,connection)))
+       (toolkit-eof-error (cond)
+	 (format t "~%Connection to server broken: ~a" cond)
+         (close-motif-connection ,connection)
+	 (signal cond)))))
+
+(defmacro with-clx-requests (&body forms)
+  `(unwind-protect
+       (progn ,@forms)
+     (xlib:display-force-output *x-display*)))
+
+;;; This is the functions which listens for input from the server and calls
+;;; the dispatcher when it detects incoming data.
+(defun toolkit-handler (connection)
+  (unless (motif-connection-terminated connection)
+    (with-motif-connection (connection)
+      (let ((fd (motif-connection-fd connection)))
+	(cond
+	 ((wait-for-input-or-timeout fd *default-timeout-interval*)
+	  (dispatch-server-reply fd))
+	 (t
+	  (warn "Got timeout on fd=~d" fd)))
+	(xlib:display-force-output *x-display*)))))
diff --git a/motif/lisp/internals.lisp b/motif/lisp/internals.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..fcdebae7df7706fc2107358c66f28acaa70f1e06
--- /dev/null
+++ b/motif/lisp/internals.lisp
@@ -0,0 +1,214 @@
+;;;; -*- Mode: Lisp ; Package: Toolkit-Internals -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; This file contains internal functions required to support the Motif
+;;; toolkit in Lisp.
+;;;
+
+(in-package "TOOLKIT-INTERNALS")
+
+
+
+;;;; Special TOOLKIT-ERROR
+
+(define-condition toolkit-error (error)
+  ((format-string)
+   (format-arguments))
+  (:documentation "An error has occurred in the X Toolkit code.")
+  (:report (lambda (condition stream)
+	     (declare (stream stream))
+	     (format stream "A Toolkit error has occurred.~%~?"
+		     (toolkit-error-format-string condition)
+		     (toolkit-error-format-arguments condition)))))
+
+(define-condition toolkit-eof-error (toolkit-error)
+  ((string))
+  (:report (lambda (condition stream)
+	     (write-line (toolkit-eof-error-string condition) stream))))
+
+;;; TOOLKIT-ERROR  -- Internal
+;;; TOOLKIT-CERROR -- Internal
+;;;
+;;; These functions act just like ERROR and CERROR except that they signal
+;;; a TOOLKIT-ERROR instead of a SIMPLE-ERROR.  This is mainly intended for
+;;; a graphical debugger which must stop attempting graphical interaction
+;;; when a toolkit error occurs.
+;;;
+(declaim (inline toolkit-error toolkit-cerror))
+(defun toolkit-error (string &rest args)
+  (error 'toolkit-error :format-string string :format-arguments args))
+
+(defun toolkit-cerror (continue-string string &rest args)
+  (cerror continue-string 'toolkit-error
+	  :format-string string :format-arguments args))
+
+
+
+;;;; Internal communication functions
+
+(defvar *xt-tcp-port* 8000)
+
+(defun connect-to-host (host pid)
+  (declare (type (or null simple-string) host))
+  (handler-case
+      (if host
+	  (handler-case
+	      (ext:connect-to-inet-socket host *xt-tcp-port*)
+	    (error ()
+	      (ext:connect-to-inet-socket host (+ *xt-tcp-port*
+						  (unix:unix-getuid)))))
+	  (handler-case
+	      (ext::connect-to-unix-socket
+	       (if pid
+		   (format nil "/tmp/.motif_socket-p~a" pid)
+		   (format nil "/tmp/.motif_socket-u~a" (unix:unix-getuid))))
+	    (error ()
+	      (ext:connect-to-unix-socket "/tmp/.motif_socket"))))
+    (error ()
+      (toolkit-error "Unable to connect to Motif server."))))
+
+(declaim (inline wait-for-input wait-for-input-or-timeout))
+(defun wait-for-input (fd)
+  (system:wait-until-fd-usable fd :input))
+
+(defun wait-for-input-or-timeout (fd interval)
+  (system:wait-until-fd-usable fd :input interval))
+
+
+
+;;;; Toolkit connection stuff
+
+;;; These will be dynamically bound in the context of the event handlers.
+(defvar *motif-connection*)
+(defvar *x-display*)
+
+(defstruct (motif-connection
+	    (:print-function print-motif-connection)
+	    (:constructor make-motif-connection (fd)))
+  fd
+  (display-name "" :type simple-string)
+  display
+  (serial 1 :type fixnum)
+  (terminated nil :type (member t nil))
+  (close-hook nil :type (or symbol function))
+  ;;
+  ;; This maps widget ids (unsigned-byte 32)'s into widget structures
+  (widget-table (make-hash-table :test #'eq) :type hash-table)
+  (function-table (make-array 32 :element-type '(or symbol function)
+			      :adjustable t :fill-pointer 0))
+  (callback-table (make-hash-table :test #'equal) :type hash-table)
+  (protocol-table (make-hash-table :test #'equal) :type hash-table)
+  (event-table (make-hash-table :test #'equal) :type hash-table)
+  ;; This table tracks all the misc. id's we get from the server
+  ;; ie. xm-strings, translations, accelerators, font-lists
+  (id-table (make-hash-table :test #'eq) :type hash-table))
+
+(defun print-motif-connection (c stream d)
+  (declare (ignore d)
+	   (stream stream))
+  (format stream "#<X Toolkit Connection, fd=~a>"
+	  (motif-connection-fd c)))
+
+
+
+;;;; Internal structure definitions
+
+(defstruct (widget
+	    (:print-function print-widget)
+	    (:constructor make-widget (id)))
+  (id          0 :type (unsigned-byte 32))
+  (type      nil :type symbol)
+  (parent    nil :type widget)
+  (children  nil :type list)
+  (callbacks nil :type list)
+  (protocols nil :type list)
+  (events    nil :type list)
+  (user-data nil))
+
+;; A toolkit object is simply a wrapper for a pointer passed from the server
+;; process.  The TYPE field allows us to discriminate the type of the pointer
+;; but still treat all pointers in the same way (ie. instead of having separate
+;; tables for xmstring, font-list, etc.)
+;;
+(defstruct (motif-object
+	    (:print-function print-motif-object)
+	    (:constructor make-motif-object (id)))
+  (id 0 :type (unsigned-byte 32))
+  (type nil :type symbol))
+
+(defun print-widget (w stream d)
+  (declare (ignore d)
+	   (stream stream))
+  (format stream "#<X Toolkit Widget: ~A ~X>" (widget-type w) (widget-id w)))
+
+(defun print-motif-object (obj stream d)
+  (declare (ignore d)
+	   (stream stream))
+  (format stream "#<Motif object: ~A ~X>"
+	  (motif-object-type obj) (motif-object-id obj)))
+
+;;; Some handy type abbreviations for motif-object
+(deftype xmstring () 'motif-object)
+(deftype font-list () 'motif-object)
+(deftype translations () 'motif-object)
+(deftype accelerators () 'motif-object)
+
+
+
+;;;; Tables for tracking stuff
+
+(defvar *toolkit-string-table* (make-array 350 :element-type 'simple-string
+					   :adjustable t :fill-pointer 0))
+
+(defun find-widget (id)
+  (declare (type (unsigned-byte 32) id))
+  (let* ((widget-table (motif-connection-widget-table *motif-connection*))
+	 (widget (gethash id widget-table)))
+    (unless widget
+      (setf widget (make-widget id))
+      (setf (gethash id widget-table) widget))
+    widget))
+
+(defun find-motif-object (id type)
+  (declare (type (unsigned-byte 32) id)
+	   (symbol type))
+  (let* ((table (motif-connection-id-table *motif-connection*))
+	 (object (gethash id table)))
+    (unless object
+      (setf object (make-motif-object id))
+      (setf (gethash id table) object))
+    (setf (motif-object-type object) type)
+    object))
+
+
+
+;;;; Various helpful goodies
+
+;;; Converts a symbol into a resource class
+;;;    ex.  :label-string ===> LabelString
+(defun symbol-class (symbol)
+  (delete #\- (string-capitalize (symbol-name symbol))))
+
+;;; Converts a symbol into a resource base-name.
+;;;    ex.  :label-string ===> labelString
+(defun symbol-resource (symbol)
+  (let ((resource (symbol-class symbol)))
+    (setf (schar resource 0) (char-downcase (schar resource 0)))
+    resource))
+
+;;; Converts a symbol into an atom.
+(defun symbol-atom (symbol)
+  (substitute #\_ #\- (symbol-name symbol)))
+
+(defun widget-add-child (parent child)
+  (declare (type widget parent child))
+  (setf (widget-parent child) parent)
+  (push child (widget-children parent)))
diff --git a/motif/lisp/main.lisp b/motif/lisp/main.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..a9e96dae039addcf5e578cd85d4cff15b234b258
--- /dev/null
+++ b/motif/lisp/main.lisp
@@ -0,0 +1,108 @@
+;;;; -*- Mode: Lisp ; Package: Toolkit -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; Various high-level interface functions for use with the Motif toolkit.
+;;;
+
+(in-package "TOOLKIT")
+
+
+
+;;; These are just randomly placed here at the moment.
+(defconstant string-default-charset ""
+  "The default character set used in building Motif compound strings.")
+
+(defun font-list-add-component (flist charset font-spec)
+  (let ((font (xlib:open-font *x-display* font-spec)))
+    (xlib:display-force-output *x-display*)
+    (font-list-add flist font charset)))
+
+(defun build-simple-font-list (name font-spec)
+  (let ((font (xlib:open-font *x-display* font-spec)))
+    (xlib:display-force-output *x-display*)
+    (font-list-create font name)))
+
+
+(defun build-font-list (specs)
+  (let* ((first (car specs))
+	 (flist (build-simple-font-list (car first) (cadr first)))
+	 (specs (cdr specs)))
+    (dolist (spec specs)
+      (setf flist (font-list-add-component flist (car spec) (cadr spec))))
+    flist))
+
+
+
+;;;; Some standard useful callbacks
+
+(defun quit-application ()
+  "Standard function for quitting an X Toolkit application."
+  (quit-server)
+  (close-motif-connection *motif-connection*)
+  (throw 'lisp::top-level-catcher nil))
+
+(defun quit-application-callback (widget call-data)
+  "Standard callback for quitting an X Toolkit application."
+  (declare (ignore widget call-data))
+  (quit-application))
+
+(defun destroy-callback (widget call-data &rest targets)
+  (declare (ignore call-data))
+  (if targets
+      (dolist (target targets)
+	(destroy-widget target))
+      (destroy-widget widget)))
+
+(defun manage-callback (widget call-data &rest targets)
+  (declare (ignore call-data))
+  (if targets
+      (apply #'manage-children targets)
+      (manage-child widget)))
+
+(defun unmanage-callback (widget call-data &rest targets)
+  (declare (ignore call-data))
+  (if targets
+      (apply #'unmanage-children targets)
+      (unmanage-child widget)))
+
+(defun popup-callback (widget call-data kind &rest targets)
+  (declare (ignore call-data))
+  (if targets
+      (dolist (target targets)
+	(popup target kind))
+      (popup widget kind)))
+
+(defun popdown-callback (widget call-data &rest targets)
+  (declare (ignore call-data))
+  (if targets
+      (dolist (target targets)
+	(popdown target))
+      (popdown widget)))
+
+
+
+;;;; A convenient (and CLM compatible) way to start Motif applications
+
+(defun run-motif-application (init-function
+			      &key
+			      (init-args nil)
+			      (application-class "Lisp")
+			      (application-name "lisp")
+			      (server-host *default-server-host*)
+			      (display *default-display*)
+			      (sync-clx *debug-mode*))
+  (declare (ignore sync-clx))
+  (let ((connection (open-motif-connection server-host display
+					   application-name
+					   application-class)))
+    (with-motif-connection (connection)
+      (apply init-function init-args))
+    connection))
diff --git a/motif/lisp/prototypes.lisp b/motif/lisp/prototypes.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..c6dfe8680abfbccac0d44ab28da0916808ba5606
--- /dev/null
+++ b/motif/lisp/prototypes.lisp
@@ -0,0 +1,800 @@
+;;;; -*- Mode: Lisp, Fill ; Package: Toolkit -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; This file contains the prototyping code for RPC requests between the
+;;; Lisp client and the C server.
+;;;
+
+(in-package "TOOLKIT")
+
+(declaim (vector *request-table*))
+(eval-when (compile) (setf (fill-pointer *request-table*) 0))
+
+
+
+;;;; Macros for defining toolkit request operations
+
+(eval-when (compile eval)
+(defmacro def-toolkit-request (string-name symbol-name options
+			       doc-string args return &body forms)
+  (declare (simple-string string-name doc-string)
+	   (list args return))
+  (let ((arg-list (mapcar #'car args))
+	(type-list (mapcar #'cadr args))
+	(code (fill-pointer *request-table*)))
+    (vector-push-extend (format nil "R~a" string-name) *request-table*)
+    `(defun ,symbol-name ,arg-list
+       ,doc-string
+       ;; *** This generates lots of warnings at the moment
+       ;; (declare (inline toolkit-write-value))
+       ,(cons 'declare
+	      (mapcar #'(lambda (arg type) (list 'type type arg))
+		      arg-list type-list))
+       (let ((message (prepare-request ,code ,options ,(length args))))
+	 ,(cons 'progn
+		(mapcar #'(lambda (arg)
+			    (let ((name (first arg))
+				  (type (third arg)))
+			      (if type
+				  (list 'toolkit-write-value 'message name type)
+				  (list 'toolkit-write-value 'message name))))
+			args))
+	 (let ((reply (send-request-to-server message ,options)))
+	   ,(if (eq options :confirm)
+		`(multiple-value-prog1
+		     ,(ecase (length return)
+			(0)
+			(1 `(let ((result (toolkit-read-value reply)))
+			      ,@forms
+			      result))
+			(2 `(let* ((first (toolkit-read-value reply))
+				   (second (toolkit-read-value reply)))
+			      ,@forms
+			      (values first second)))
+			(3 `(let* ((first (toolkit-read-value reply))
+				   (second (toolkit-read-value reply))
+				   (third (toolkit-read-value reply)))
+			      ,@forms
+			      (values first second third)))
+			(4 `(let* ((first (toolkit-read-value reply))
+				   (second (toolkit-read-value reply))
+				   (third (toolkit-read-value reply))
+				   (fourth (toolkit-read-value reply)))
+			      ,@forms
+			      (values first second third fourth))))
+		   (destroy-message reply))
+		'(declare (ignore reply))))))))
+) ;; EVAL-WHEN
+
+;;; This is for sending commands to the server, not requesting Motif
+;;; services.  These calls take no arguments and return a value indicating
+;;; whether they were successful.
+(eval-when (compile eval)
+  (defmacro def-toolkit-command (symbol-name options &body forms)
+    (let ((string-name (symbol-class symbol-name))
+	  (code (fill-pointer *request-table*)))
+      (vector-push-extend string-name *request-table*)
+      `(defun ,symbol-name ()
+	 (let* ((message (prepare-request ,code ,options 0))
+		(reply (send-request-to-server message ,options)))
+	   ,(if (eq options :confirm)
+		`(let ((result (toolkit-read-value reply)))
+		   (destroy-message reply)
+		   ,@forms
+		   result)
+		'(declare (ignore reply))))))))
+
+
+
+;;;; Direct commands to server
+
+(def-toolkit-command quit-server :no-confirm)
+
+(def-toolkit-command terminate-callback :no-confirm)
+
+
+
+
+;;;; Request definitions for Xt Intrinsic functions
+
+(def-toolkit-request "TransportEvent" transport-event :confirm
+  ""
+  ((event-handle (unsigned-byte 32))) ((alien xevent)))
+
+(def-toolkit-request "XtAppCreateShell" %create-application-shell :confirm
+  ""
+  ((resources list :resource-list))
+  (widget)
+  (setf (widget-type result) :application-shell))
+
+(def-toolkit-request "XtRealizeWidget" realize-widget :no-confirm
+  "Realizes the given widget."
+  ((widget widget)) ())
+
+(def-toolkit-request "XtCreateManagedWidget" %create-managed-widget :confirm
+  ""
+  ((name simple-string) (widget-class keyword) (parent widget)
+   (resources list :resource-list))
+  (widget)
+  (setf (widget-type result) widget-class)
+  (widget-add-child parent result))
+
+(def-toolkit-request "XtCreateWidget" %create-widget :confirm
+  ""
+  ((name simple-string) (widget-class keyword) (parent widget)
+   (resources list :resource-list))
+  (widget)
+  (setf (widget-type result) widget-class)
+  (widget-add-child parent result))
+
+(def-toolkit-request "XtAddCallback" %add-callback :no-confirm
+  ""
+  ((widget widget) (name simple-string)) ())
+
+(def-toolkit-request "XtRemoveCallback"  %remove-callback :no-confirm
+  ""
+  ((widget widget) (name simple-string)) ())
+
+(def-toolkit-request "XtSetValues" %set-values :no-confirm
+  ""
+  ((widget widget) (resources list :resource-list)) ())
+
+(def-toolkit-request "XtGetValues" %get-values :confirm
+  ""
+  ((widget widget) (resource-names list :resource-names))
+  (list))
+
+(def-toolkit-request "XtUnrealizeWidget" unrealize-widget :no-confirm
+  "Unrealizes the given widget."
+  ((widget widget)) ())
+
+(def-toolkit-request "XtDestroyWidget" %destroy-widget :no-confirm
+  ""
+  ((widget widget)) ())
+
+(def-toolkit-request "XtMapWidget" map-widget :no-confirm
+  "Maps the X window associated with the given widget."
+  ((widget widget)) ())
+
+(def-toolkit-request "XtUnmapWidget" unmap-widget :no-confirm
+  "Unmaps the X window associated with the given widget."
+  ((widget widget)) ())
+
+(def-toolkit-request "XtSetSensitive" set-sensitive :no-confirm
+  "Sets the event sensitivity of the given widget."
+  ((widget widget) (sensitivep (member t nil))) ())
+
+(def-toolkit-request "XtCreatePopupShell" %create-popup-shell :confirm
+  ""
+  ((name simple-string) (class keyword)
+   (parent widget) (resources list :resource-list))
+  (widget)
+  (setf (widget-type result) class)
+  (widget-add-child parent result))
+
+(def-toolkit-request "XtPopup" popup :no-confirm
+  "Pops up a popup dialog shell."
+  ((shell widget) (grab-kind keyword)) ())
+
+(def-toolkit-request "XtPopdown" popdown :no-confirm
+  "Pops down a popup dialog shell."
+  ((shell widget)) ())
+
+(def-toolkit-request "XtManageChild" manage-child :no-confirm
+  "Manages the given child widget."
+  ((child widget)) ())
+
+(def-toolkit-request "XtUnmanageChild" unmanage-child :no-confirm
+  "Unmanages the given child widget."
+  ((child widget)) ())
+
+(def-toolkit-request "XtManageChildren" %manage-children :no-confirm
+  ""
+  ((child-list list :widget-list)) ())
+
+(def-toolkit-request "XtUnmanageChildren" %unmanage-children :no-confirm
+  ""
+  ((child-list list :widget-list)) ())
+
+(def-toolkit-request "XtParseTranslationTable" parse-translation-table :confirm
+  "Compiles a translation table string into its internal representation."
+  ((table simple-string)) (translations))
+
+(def-toolkit-request "XtAugmentTranslations" augment-translations :no-confirm
+  "Augments the translation table of the specified widget with the given
+   translations."
+  ((w widget) (table translations)) ())
+
+(def-toolkit-request "XtOverrideTranslations" override-translations :no-confirm
+  "Overrides the translation table of the specified widget with the given
+   translations."
+  ((w widget) (table translations)) ())
+
+(def-toolkit-request "XtUninstallTranslations" uninstall-translations
+		     :no-confirm
+  "Unintalls all translations on the given widget."
+  ((w widget)) ())
+
+(def-toolkit-request "XtParseAcceleratorTable" parse-accelerator-table :confirm
+  "Parses an accelerator string into its internal representation."
+  ((source simple-string)) (accelerators))
+
+(def-toolkit-request "XtInstallAccelerators" install-accelerators :no-confirm
+  "Installs accelerators from the source widget into the destination widget."
+  ((dest widget) (src widget)) ())
+
+(def-toolkit-request "XtInstallAllAccelerators" install-all-accelerators
+		     :no-confirm
+  "Installs all accelerators from the source widget into the destination
+   widget."
+  ((dest widget) (src widget)) ())
+
+(def-toolkit-request "XtIsManaged" is-managed :confirm
+  "Returns a value indicating whether the specified widget is managed or not."
+  ((widget widget)) ((member t nil)))
+
+(def-toolkit-request "XtPopupSpringLoaded" popup-spring-loaded :no-confirm
+  "Pops up a spring loaded popup dialog shell."
+  ((shell widget)) ())
+
+(def-toolkit-request "XtIsRealized" is-realized :confirm
+  "Returns a value indicating whether the specified widget is realized or not."
+  ((widget widget)) ((member t nil)))
+
+(def-toolkit-request "XtWindow" widget-window :confirm
+  "Returns the X window associated with the given widget."
+  ((widget widget)) (xlib:window))
+
+(def-toolkit-request "XtName" widget-name :confirm
+  "Returns the name of the given widget."
+  ((widget widget)) (string))
+
+(def-toolkit-request "XtIsSensitive" is-sensitive :confirm
+  "Returns the sensitivity state of the given widget."
+  ((widget widget)) ((member t nil)))
+
+(def-toolkit-request "XtAddEventHandler" %add-event-handler :no-confirm
+  ""
+  ((widget widget) (mask (unsigned-byte 32)) (nonmaskable_p (member t nil)))
+  ())
+
+(def-toolkit-request "XtRemoveEventHandler" %remove-event-handler :no-confirm
+  ""
+  ((widget widget) (mask (unsigned-byte 32)) (nonmaskable_p (member t nil)))
+  ())
+
+(def-toolkit-request "XtTranslateCoords" translate-coords :confirm
+  "Translates coordinates (x,y) in the window of the given widget into the
+   corresponding coordinates in the root window."
+  ((widget widget) (x fixnum) (y fixnum))
+  (fixnum fixnum))
+
+(def-toolkit-request "XCreateFontCursor" create-font-cursor :confirm
+  "Creates an X cursor from the standard cursor font."
+  ((shape fixnum))
+  (xlib:cursor))
+
+
+
+;;;; Request definitions for Motif functions
+
+;; We will ask for confirmation here just to resync things
+(def-toolkit-request "XmUpdateDisplay" update-display :confirm
+  "Processes all pending exposure events and synchronizes with the server."
+  ((w widget)) ())
+
+(def-toolkit-request "XmIsMotifWMRunning" is-motif-wm-running :confirm
+  "Specifies if the MWM window manager is running."
+  ((shell widget)) ((member t nil)))
+
+(def-toolkit-request "XmMenuPosition" %menu-position :no-confirm
+  ""
+  ((widget widget) (event-handle (unsigned-byte 32) :event)) ())
+
+(def-toolkit-request "XmCreateMenuBar" %create-menu-bar :confirm
+  ""
+  ((parent widget) (name simple-string) (resources list :resource-list))
+  (widget)
+  (setf (widget-type result) :row-column)
+  (widget-add-child parent result))
+
+(def-toolkit-request "XmCreateOptionMenu" %create-option-menu :confirm
+  ""
+  ((parent widget) (name simple-string) (resources list :resource-list))
+  (widget)
+  (setf (widget-type result) :row-column)
+  (widget-add-child parent result))
+
+(def-toolkit-request "XmCreateRadioBox" %create-radio-box :confirm
+  ""
+  ((parent widget) (name simple-string) (resources list :resource-list))
+  (widget)
+  (setf (widget-type result) :row-column)
+  (widget-add-child parent result))
+
+(macrolet ((def-double-widget-stub (name parent-class child-class)
+	     (let ((strname (format nil "Xm~a"(symbol-class name)))
+		   (fn-name (read-from-string
+			     (format nil "%~a" name))))
+	       `(def-toolkit-request ,strname ,fn-name :confirm
+		  ""
+		  ((parent widget) (name simple-string)
+		   (resources list :resource-list))
+		  (widget widget)
+		  (setf (widget-type second) ,parent-class)
+		  (setf (widget-type first) ,child-class)
+		  (widget-add-child parent second)
+		  (widget-add-child second first)))))
+  
+  (def-double-widget-stub create-warning-dialog :dialog-shell :message-box)
+  (def-double-widget-stub create-bulletin-board-dialog :dialog-shell
+    :bulletin-board)
+  (def-double-widget-stub create-error-dialog :dialog-shell :message-box)
+  (def-double-widget-stub create-file-selection-dialog :dialog-shell
+    :file-selection-box)
+  (def-double-widget-stub create-form-dialog :dialog-shell :form)
+  (def-double-widget-stub create-information-dialog :dialog-shell
+    :message-box)
+  (def-double-widget-stub create-message-dialog :dialog-shell :message-box)
+  (def-double-widget-stub create-popup-menu :menu-shell :row-column)
+  (def-double-widget-stub create-prompt-dialog :dialog-shell :selection-box)
+  (def-double-widget-stub create-pulldown-menu :menu-shell :row-column)
+  (def-double-widget-stub create-question-dialog :dialog-shell :message-box)
+  (def-double-widget-stub create-scrolled-list :scrolled-window :list)
+  (def-double-widget-stub create-scrolled-text :scrolled-window :text)
+  (def-double-widget-stub create-selection-dialog :dialog-shell
+    :selection-box)
+  (def-double-widget-stub create-working-dialog :dialog-shell :message-box))
+
+(def-toolkit-request "XmCommandAppendValue" command-append-value :no-confirm
+  "Appends the given string to the end of the string displayed in the
+   command area of the widget."
+  ((w widget) (command (or simple-string xmstring))) ())
+
+(def-toolkit-request "XmCommandError" command-error :no-confirm
+  "Displays an error message in the Command widget."
+  ((w widget) (error (or simple-string xmstring))) ())
+
+(def-toolkit-request "XmCommandSetValue" command-set-value :no-confirm
+  "Replaces the displayed string in a Command widget."
+  ((w widget) (c (or simple-string xmstring))) ())
+
+(def-toolkit-request "XmScaleGetValue" scale-get-value :confirm
+  "Returns the current slider position."
+  ((w widget)) (fixnum))
+
+(def-toolkit-request "XmScaleSetValue" scale-set-value :no-confirm
+  "Sets the current slider position."
+  ((w widget) (val fixnum)) ())
+
+(def-toolkit-request "XmToggleButtonGetState" toggle-button-get-state :confirm
+  "Obtains the state of a ToggleButton."
+  ((w widget)) ((member t nil)))
+
+(def-toolkit-request "XmToggleButtonSetState" toggle-button-set-state
+		     :no-confirm
+  "Sets the state of a ToggleButton."
+  ((w widget) (state (member t nil)) (notify (member t nil))) ())
+
+(def-toolkit-request "XmListAddItem" list-add-item :no-confirm
+  "Adds an item to the given List widget."
+  ((w widget) (item (or simple-string xmstring)) (pos fixnum)) ())
+
+(def-toolkit-request "XmListAddItemUnselected" list-add-item-unselected
+		     :no-confirm
+  "Adds an item to the List widget as an unselected entry."
+  ((w widget) (item (or simple-string xmstring)) (pos fixnum)) ())
+
+(def-toolkit-request "XmListDeleteItem" list-delete-item :no-confirm
+  "Deletes an item from the given List widget."
+  ((w widget) (item (or simple-string xmstring))) ())
+
+(def-toolkit-request "XmListDeletePos" list-delete-pos :no-confirm
+  "Deletes and item from a List widget at the specified position."
+  ((w widget) (pos fixnum)) ())
+
+(def-toolkit-request "XmListDeselectAllItems" list-deselect-all-items
+		     :no-confirm
+  "Unhighlights and removes all items from the selected list."
+  ((w widget)) ())
+
+(def-toolkit-request "XmListDeselectItem" list-deselect-item :no-confirm
+  "Deselects the specified item from the selected list."
+  ((w widget) (item (or simple-string xmstring))) ())
+
+(def-toolkit-request "XmListDeselectPos" list-deselect-pos :no-confirm
+  "Deselects an item at a specified position in a List widget."
+  ((w widget) (pos fixnum)) ())
+
+(def-toolkit-request "XmListSelectItem" list-select-item :no-confirm
+  "Selects an item in the List widget."
+  ((w widget) (item (or simple-string xmstring)) (notify (member t nil))) ())
+
+(def-toolkit-request "XmListSelectPos" list-select-pos :no-confirm
+  "Selects an item at a specified position in the List widget."
+  ((w widget) (pos fixnum) (notify (member t nil))) ())
+
+(def-toolkit-request "XmListSetBottomItem" list-set-bottom-item :no-confirm
+  "Makes an existing item the last visible in the List widget."
+  ((w widget) (item (or simple-string xmstring))) ())
+
+(def-toolkit-request "XmListSetBottomPos" list-set-bottom-pos :no-confirm
+  "Makes the item at the specified position the last visible item in the
+   given List widget."
+  ((w widget) (pos fixnum)) ())
+
+(def-toolkit-request "XmListSetHorizPos" list-set-horiz-pos :no-confirm
+  "Scrolls to the specified position in the List widget."
+  ((w widget) (pos fixnum)) ())
+
+(def-toolkit-request "XmListSetItem" list-set-item :no-confirm
+  "Makes an existing item the first visible in the List widget."
+  ((w widget) (item (or simple-string xmstring))) ())
+
+(def-toolkit-request "XmListSetPos" list-set-pos :no-confirm
+  "Makes the item at the given position the first visible item in the List."
+  ((w widget) (pos fixnum)) ())
+
+(def-toolkit-request "XmListAddItems" list-add-items :no-confirm
+  "Adds items to the given List widget."
+  ((w widget) (items list :xm-string-table) (pos fixnum)) ())
+
+(def-toolkit-request "XmListDeleteAllItems" list-delete-all-items :no-confirm
+  "Deletes all items from the List widget."
+  ((w widget)) ())
+
+(def-toolkit-request "XmListDeleteItems" list-delete-items :no-confirm
+  "Deletes specified items from the List widget."
+  ((w widget) (items list :xm-string-table)) ())
+
+(def-toolkit-request "XmListDeleteItemsPos" list-delete-items-pos :no-confirm
+  "Deletes items from the list starting at the given position."
+  ((w widget) (item-count fixnum) (pos fixnum)) ())
+
+(def-toolkit-request "XmListItemExists" list-item-exists :confirm
+  "Checks if a specified item is in the List widget."
+  ((w widget) (item (or simple-string xmstring))) ((member t nil)))
+
+(def-toolkit-request "XmListItemPos" list-item-pos :confirm
+  "Returns the position of an item in the List widget."
+  ((w widget) (item (or simple-string xmstring))) (fixnum))
+
+(def-toolkit-request "XmListReplaceItems" list-replace-items :no-confirm
+  "Replaces the specified elements in the list."
+  ((w widget) (old list :xm-string-table) (new list :xm-string-table)) ())
+
+(def-toolkit-request "XmListReplaceItemsPos" list-replace-items-pos :no-confirm
+  "Replaces items in the list, starting at the given position."
+  ((w widget) (new-items list :xm-string-table) (pos fixnum)) ())
+
+(def-toolkit-request "XmListSetAddMode" list-set-add-mode :no-confirm
+  "Sets the state of Add Mode in the list."
+  ((w widget) (mode (member t nil))) ())
+
+(def-toolkit-request "XmListGetSelectedPos" list-get-selected-pos :confirm
+  "Returns the position of every selected item in the given List."
+  ((w widget))
+  (list (member t nil)))
+
+(def-toolkit-request "XmAddTabGroup" add-tab-group :no-confirm
+  "Adds a manager or a primitive widget to the list of tab groups."
+  ((w widget)) ())
+
+(def-toolkit-request "XmRemoveTabGroup" remove-tab-group :no-confirm
+  "Removes a manager or a primitive widget from the list of tab groups."
+  ((w widget)) ())
+
+(def-toolkit-request "XmProcessTraversal" process-traversal :confirm
+  "Determines which component of a widget hierarchy receives keyboard
+   events when a widget has the keyboard focus."
+  ((w widget) (direction keyword)) ((member t nil)))
+
+(def-toolkit-request "XmFontListAdd" font-list-add :confirm
+  "Adds a new font to a font-list and destroys the old list."
+  ((flist font-list) (font xlib:font) (charset simple-string))
+  (font-list))
+
+(def-toolkit-request "XmFontListCreate" font-list-create :confirm
+  "Creates a new font-list with the specified font."
+  ((font xlib:font) (charset simple-string))
+  (font-list))
+
+(def-toolkit-request "XmFontListFree" font-list-free :no-confirm
+  "Destroys the given font-list."
+  ((flist font-list)) ())
+
+(def-toolkit-request "XmStringBaseline" compound-string-basline :confirm
+  "Returns the number of pixels between the top of the character box and
+   the basline of the first line of text."
+  ((flist font-list) (string xmstring)) (fixnum))
+
+(def-toolkit-request "XmStringByteCompare" compound-string-byte-compare
+		     :confirm
+  "Indicates the result of a byte-by-byte comparison of two compound strings."
+  ((s1 xmstring) (s2 xmstring)) ((member t nil)))
+
+(def-toolkit-request "XmStringCompare" compound-string-compare :confirm
+  "Indicates whether two compound strings are semantically equivalent."
+  ((s1 xmstring) (s2 xmstring)) ((member t nil)))
+
+(def-toolkit-request "XmStringConcat" compound-string-concat :confirm
+  "Appends one compound string to another.  The original strings are preserved."
+  ((s1 xmstring) (s2 xmstring)) (xmstring))
+
+(def-toolkit-request "XmStringCopy" compound-string-copy :confirm
+  "Makes a copy of a compound string."
+  ((s xmstring)) (xmstring))
+
+(def-toolkit-request "XmStringCreate" compound-string-create :confirm
+  "Creates a new compound string."
+  ((s simple-string) (charset simple-string)) (xmstring))
+
+(def-toolkit-request "XmStringCreateLtoR" compound-string-create-ltor :confirm
+  "Creates a new compound string and translates newline characters into
+   line separators."
+  ((s simple-string) (charset simple-string)) (xmstring))
+
+(def-toolkit-request "XmStringGetLtoR" compound-string-get-ltor :confirm
+  "Returns True if a segment can be found in the input compound string that
+   matches the specified character set."
+  ((string xmstring) (charset simple-string))
+  (simple-string (member t nil)))
+
+(def-toolkit-request "XmStringCreateSimple" compound-string-create-simple
+		     :confirm
+  "Creates a compound string in the language environment of a widget."
+  ((s simple-string)) (xmstring))
+
+(def-toolkit-request "XmStringEmpty" compound-string-empty :confirm
+  "Provides information on the existence of non-zero length text components."
+  ((s xmstring)) ((member t nil)))
+
+(def-toolkit-request "XmStringExtent" compound-string-extent :confirm
+  "Determines the size of the smallest rectangle that will enclose the
+   given compound string."
+  ((flist font-list) (x xmstring)) (fixnum fixnum))
+
+(def-toolkit-request "XmStringFree" compound-string-free :no-confirm
+  "Recovers memory used by a compound string."
+  ((s xmstring)) ()
+  (remhash (xti::motif-object-id s)
+	   (xti::motif-connection-id-table *motif-connection*)))
+
+(def-toolkit-request "XmStringHasSubstring" compound-string-has-substring
+		     :confirm
+  "Indicates whether one compound string is contained within another."
+  ((string xmstring) (substring xmstring)) ((member t nil)))
+
+(def-toolkit-request "XmStringHeight" compound-string-height :confirm
+  "Returns the line height of the given compound string."
+  ((flist font-list) (string xmstring)) (fixnum))
+
+(def-toolkit-request "XmStringLength" compound-string-length :confirm
+  "Obtains the length of a compound string."
+  ((string xmstring)) (fixnum))
+
+(def-toolkit-request "XmStringLineCount" compound-string-line-count :confirm
+  "Returns the number of separators plus one in the provided compound string."
+  ((string xmstring)) (fixnum))
+
+(def-toolkit-request "XmStringNConcat" compound-string-nconcat :confirm
+  "Appends a specified number of bytes to a compound string."
+  ((s1 xmstring) (s2 xmstring) (num_bytes fixnum)) (xmstring))
+
+(def-toolkit-request "XmStringNCopy" compound-string-ncopy :confirm
+  "Copies a specified number of bytes into a new compound string."
+  ((s string) (num_bytes fixnum)) (xmstring))
+
+(def-toolkit-request "XmStringSeparatorCreate" compound-string-separator-create
+		     :confirm
+  "Creates a compound string with a single component, a separator."
+  () (xmstring))
+
+(def-toolkit-request "XmStringWidth" compound-string-width :confirm
+  "Returns the width of the longest sequence of text components in a
+   compound string."
+  ((flist font-list) (s xmstring)) (fixnum))
+
+(def-toolkit-request "XmTextClearSelection" text-clear-selection :no-confirm
+  "Clears the primary selection."
+  ((w widget)) ())
+
+(def-toolkit-request "XmTextCopy" text-copy :confirm
+  "Copies the primary selection to the clipboard."
+  ((w widget)) ((member t nil)))
+
+(def-toolkit-request "XmTextCut" text-cut :confirm
+  "Copies the primary selection to the clipboard and deletes the selected text."
+  ((w widget)) ((member t nil)))
+
+(def-toolkit-request "XmTextGetBaseline" text-get-basline :confirm
+  "Accesses the x position of the first baseline."
+  ((w widget)) (fixnum))
+
+(def-toolkit-request "XmTextGetEditable" text-get-editable :confirm
+  "Accesses the edit permission state of the Text widget."
+  ((w widget)) ((member t nil)))
+
+(def-toolkit-request "XmTextGetInsertionPosition" text-get-insertion-position 
+		     :confirm
+  "Accesses the positions of the insert cursor."
+  ((w widget)) (fixnum))
+
+(def-toolkit-request "XmTextGetLastPosition" text-get-last-position :confirm
+  "Accesses the positio of the last text character."
+  ((w widget)) (fixnum))
+
+(def-toolkit-request "XmTextGetMaxLength" text-get-max-length :confirm
+  "Accesses the value of the current maximum allowable length of a text
+   string entered from the keyboard."
+  ((w widget)) (fixnum))
+
+(def-toolkit-request "XmTextGetSelection" text-get-selection :confirm
+  "Retrieves the value of the primary selection."
+  ((w widget)) (simple-string))
+
+(def-toolkit-request "XmTextGetSelectionPosition" text-get-selection-position
+		     :confirm
+  "Accesses the position of the primary selection."
+  ((w widget))
+  ((member t nil) fixnum fixnum))
+
+(def-toolkit-request "XmTextGetString" text-get-stringtring :confirm
+  "Accesses the string value of a Text widget."
+  ((w widget)) (simple-string))
+
+(def-toolkit-request "XmTextGetTopCharacter" text-get-top-character :confirm
+  "Accesses the position of the first character displayed."
+  ((w widget)) (fixnum))
+
+(def-toolkit-request "XmTextInsert" text-insert :no-confirm
+  "Inserts a character string into a Text widget."
+  ((w widget) (pos fixnum) (value simple-string)) ())
+
+(def-toolkit-request "XmTextPaste" text-paste :confirm
+  "Inserts the clipboard selection."
+  ((w widget)) ((member t nil)))
+
+(def-toolkit-request "XmTextPosToXY" text-pos-to-xy :confirm
+  "Accesses the x and y position of a character position."
+  ((w widget) (pos fixnum))
+  ((member t nil) fixnum fixnum))
+
+(def-toolkit-request "XmTextRemove" text-remove :confirm
+  "Deletes the primary selection."
+  ((w widget)) ((member t nil)))
+
+(def-toolkit-request "XmTextReplace" text-replace :no-confirm
+  "Replaces part of the text of a Text widget."
+  ((w widget) (from-pos fixnum) (to-pos fixnum) (value simple-string)) ())
+
+(def-toolkit-request "XmTextScroll" text-scroll :no-confirm
+  "Scrolls the text of a Text widget."
+  ((w widget) (lines fixnum)) ())
+
+(def-toolkit-request "XmTextSetAddMode" text-set-add-mode :no-confirm
+  "Sets the state of Add Mode."
+  ((w widget) (state (member t nil))) ())
+
+(def-toolkit-request "XmTextSetEditable" text-set-editable :no-confirm
+  "Sets the edit permission on a Text widget."
+  ((w widget) (editable (member t nil))) ())
+
+(def-toolkit-request "XmTextSetHighlight" text-set-highlight :no-confirm
+  "Highlights text."
+  ((w widget) (left fixnum) (right fixnum) (mode keyword)) ())
+
+(def-toolkit-request "XmTextSetInsertionPosition" text-set-insertion-position
+		     :no-confirm
+  "Sets position of the insert cursor."
+  ((w widget) (pos fixnum)) ())
+
+(def-toolkit-request "XmTextSetMaxLength" text-set-max-length :no-confirm
+  "Sets the value of the current maximum allowable length of a text string
+   entered from the keyboard."
+  ((w widget) (max-length fixnum)) ())
+
+(def-toolkit-request "XmTextSetSelection" text-set-selection :no-confirm
+  "Sets the primary selection of the Text widget."
+  ((w widget) (first fixnum) (last fixnum)) ())
+
+(def-toolkit-request "XmTextSetString" text-set-string :no-confirm
+  "Sets the string value of a Text widget."
+  ((w widget) (value simple-string)) ())
+
+(def-toolkit-request "XmTextSetTopCharacter" text-set-top-character :no-confirm
+  "Sets the position of the first character displayed."
+  ((w widget) (top-char fixnum)) ())
+
+(def-toolkit-request "XmTextShowPosition" text-show-position :no-confirm
+  "Forces text at a given position to be displayed."
+  ((w widget) (pos fixnum)) ())
+
+(def-toolkit-request "XmTextXYToPos" text-xy-to-pos :confirm
+  "Accesses the character position nearest an x and y position."
+  ((w widget) (x fixnum) (y fixnum)) (fixnum))
+
+(def-toolkit-request "XmAddProtocolCallback" %add-protocol-callback
+		     :no-confirm
+  ""
+  ((w widget) (property keyword :atom) (protocol keyword :atom)) ())
+
+(def-toolkit-request "XmRemoveProtocolCallback" %remove-protocol-callback
+		     :no-confirm
+  ""
+  ((w widget) (property keyword :atom) (protocol keyword :atom)) ())
+
+(def-toolkit-request "XmSelectionBoxGetChild" selection-box-get-child :confirm
+  "Accesses a child component of a SelectionBox widget."
+  ((w widget) (child keyword)) (widget)
+  (widget-add-child w result)
+  (setf (widget-type result) :unknown))
+
+(def-toolkit-request "XmFileSelectionBoxGetChild" file-selection-box-get-child
+		     :confirm
+  "Accesses a child component of a FileSelectionBox widget."
+  ((w widget) (child keyword)) (widget)
+  (widget-add-child w result)
+  (setf (widget-type result) :unknown))
+
+(def-toolkit-request "XmMessageBoxGetChild" message-box-get-child :confirm
+  "Accesses a child component of a MessageBox widget."
+  ((w widget) (child keyword)) (widget)
+  (widget-add-child w result)
+  (setf (widget-type result) :unknown))
+
+(def-toolkit-request "XmCommandGetChild" command-get-child :confirm
+  "Accesses a child component of a Command widget."
+  ((w widget) (child keyword))
+  (widget)
+  (widget-add-child w result)
+  (setf (widget-type result) :unknown))
+
+(def-toolkit-request "XmScrolledWindowSetAreas" scrolled-window-set-areas
+		     :no-confirm
+  "Adds or changes a window work region and a horizontal or vertical
+   ScrollBar widget to the ScrolledWindow widget."
+  ((widget widget) (horiz-scroll (or null widget))
+   (vert-scroll (or null widget)) (work-region (or null widget)))
+  ())
+
+(def-toolkit-request "XmTrackingLocate" tracking-locate :confirm
+  "Provides a modal interface for the selection of a component."
+  ((w widget) (cursor xlib:cursor) (confine-to (member t nil)))
+  (widget))
+
+(def-toolkit-request "XmScrollBarGetValues" scroll-bar-get-values :confirm
+  "Returns the ScrollBar's increment values."
+  ((widget widget))
+  (fixnum fixnum fixnum fixnum))
+
+(def-toolkit-request "XmScrollBarSetValues" scroll-bar-set-values :no-confirm
+  "Changes the ScrollBar's increments values and the slider's size and
+   position."
+  ((widget widget) (value fixnum) (slider-size fixnum)
+   (increment fixnum) (page-increment fixnum) (notify (member t nil)))
+  ())
+
+(def-toolkit-request "SetItems" set-items :no-confirm
+  "Set the items of a List widget."
+  ((widget widget) (items list :xm-string-table)) ())
+
+(def-toolkit-request "GetItems" get-items :confirm
+  "Get the items of a List widget."
+  ((widget widget))
+  (list))
+
+(def-toolkit-request "ReturnTextCallbackDoit" return-text-callback-doit
+		     :no-confirm
+  "Return a boolean value determining whether the proposed text action will
+   actually be performed."
+  ((doit (member t nil)))
+  ())
diff --git a/motif/lisp/string-base.lisp b/motif/lisp/string-base.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..cd0dd18b971640f2fc09ae3077481a71e804533e
--- /dev/null
+++ b/motif/lisp/string-base.lisp
@@ -0,0 +1,336 @@
+;;;; -*- Mode: Lisp ; Package: Toolkit-Internals -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; This is the database of strings used for tokenizing communications
+;;; between Lisp and C.
+;;;
+
+(in-package "TOOLKIT-INTERNALS")
+
+;;; This table MUST be *SORTED*.
+(setf *toolkit-string-table*
+      (vector
+       "accelerator"
+       "acceleratorText"
+       "accelerators"
+       "activateCallback"
+       "adjustLast"
+       "adjustMargin"
+       "alignment"
+       "allowResize"
+       "allowShellResize"
+       "ancestorSensitive"
+       "applyCallback"
+       "applyLabelString"
+       "armCallback"
+       "armColor"
+       "armPixmap"
+       "autoShowCursorPosition"
+       "automaticSelection"
+       "background"
+       "backgroundPixmap"
+       "bitmap"
+       "blinkRate"
+       "borderColor"
+       "borderPixmap"
+       "borderWidth"
+       "bottomAttachment"
+       "bottomOffset"
+       "bottomPosition"
+       "bottomShadowColor"
+       "bottomShadowPixmap"
+       "bottomWidget"
+       "browseSelectionCallback"
+       "buttonAcceleratorText"
+       "buttonAccelerators"
+       "buttonCount"
+       "buttonMnemonicCharSets"
+       "buttonMnemonics"
+       "buttonSet"
+       "buttonType"
+       "buttons"
+       "cancelButton"
+       "cancelCallback"
+       "cancelLabelString"
+       "cascadePixmap"
+       "cascadingCallback"
+       "children"
+       "clipWindow"
+       "colormap"
+       "columns"
+       "commandChangedCallback"
+       "commandEnteredCallback"
+       "commandWindow"
+       "commandWindowLocation"
+       "createPopupChildProc"
+       "cursorPosition"
+       "cursorPositionVisible"
+       "decrementCallback"
+       "defaultActionCallback"
+       "defaultButton"
+       "defaultButtonShadowThickness"
+       "defaultFontList"
+       "depth"
+       "destroyCallback"
+       "dialogTitle"
+       "disarmCallback"
+       "doubleClickInterval"
+       "dragCallback"
+       "editMode"
+       "editType"
+       "editable"
+       "entryAlignment"
+       "entryBorder"
+       "entryCallback"
+       "entryClass"
+       "exposeCallback"
+       "extendedSelectionCallback"
+       "file"
+       "fillOnArm"
+       "fillOnSelect"
+       "filterLabelString"
+       "focusCallback"
+       "font"
+       "fontList"
+       "forceBars"
+       "foreground"
+       "function"
+       "gainPrimaryCallback"
+       "height"
+       "helpCallback"
+       "helpLabelString"
+       "highlight"
+       "highlightColor"
+       "highlightOnEnter"
+       "highlightPixmap"
+       "highlightThickness"
+       "horizontalScrollBar"
+       "iconMask"
+       "iconName"
+       "iconPixmap"
+       "iconWindow"
+       "increment"
+       "incrementCallback"
+       "index"
+       "indicatorOn"
+       "indicatorSize"
+       "indicatorType"
+       "initialDelay"
+       "initialResourcesPersistent"
+       "innerHeight"
+       "innerWidth"
+       "innerWindow"
+       "inputCallback"
+       "inputCreate"
+       "insertPosition"
+       "internalHeight"
+       "internalWidth"
+       "isAligned"
+       "isHomogeneous"
+       "itemCount"
+       "items"
+       "jumpProc"
+       "justify"
+       "labelInsensitivePixmap"
+       "labelPixmap"
+       "labelString"
+       "labelType"
+       "leftAttachment"
+       "leftOffset"
+       "leftPosition"
+       "leftWidget"
+       "length"
+       "listLabelString"
+       "listMarginHeight"
+       "listMarginWidth"
+       "listSizePolicy"
+       "listSpacing"
+       "listUpdated"
+       "losePrimaryCallback"
+       "losingFocusCallback"
+       "lowerRight"
+       "mainWindowMarginHeight"
+       "mainWindowMarginWidth"
+       "mapCallback"
+       "mappedWhenManaged"
+       "mappingDelay"
+       "marginBottom"
+       "marginHeight"
+       "marginLeft"
+       "marginRight"
+       "marginTop"
+       "marginWidth"
+       "maxLength"
+       "maximum"
+       "menuAccelerator"
+       "menuBar"
+       "menuCursor"
+       "menuEntry"
+       "menuHelpWidget"
+       "menuHistory"
+       "menuPost"
+       "messageString"
+       "messageWindow"
+       "minimum"
+       "mnemonic"
+       "mnemonicCharSet"
+       "modifyVerifyCallback"
+       "motionVerifyCallback"
+       "multiClick"
+       "multipleSelectionCallback"
+       "name"
+       "navigationType"
+       "noMatchCallback"
+       "notify"
+       "numChildren"
+       "numColumns"
+       "okCallback"
+       "okLabelString"
+       "optionLabel"
+       "optionMnemonic"
+       "orientation"
+       "outputCreate"
+       "overrideRedirect"
+       "packing"
+       "pageDecrementCallback"
+       "pageIncrement"
+       "pageIncrementCallback"
+       "paneMaximum"
+       "paneMinimum"
+       "parameter"
+       "pendingDelete"
+       "popdownCallback"
+       "popupCallback"
+       "popupEnabled"
+       "postFromButton"
+       "postFromCount"
+       "postFromList"
+       "processingDirection"
+       "promptString"
+       "radioAlwaysOne"
+       "radioBehavior"
+       "recomputeSize"
+       "refigureMode"
+       "repeatDelay"
+       "resizable"
+       "resize"
+       "resizeCallback"
+       "resizeHeight"
+       "resizeWidth"
+       "reverseVideo"
+       "rightAttachment"
+       "rightOffset"
+       "rightPosition"
+       "rightWidget"
+       "rowColumnType"
+       "rows"
+       "sashHeight"
+       "sashIndent"
+       "sashShadowThickness"
+       "sashWidth"
+       "saveUnder"
+       "scaleMultiple"
+       "screen"
+       "scrollBarDisplayPolicy"
+       "scrollBarPlacement"
+       "scrollDCursor"
+       "scrollHCursor"
+       "scrollHorizontal"
+       "scrollLCursor"
+       "scrollLeftSide"
+       "scrollProc"
+       "scrollRCursor"
+       "scrollTopSide"
+       "scrollUCursor"
+       "scrollVCursor"
+       "scrollVertical"
+       "scrolledWindowMarginHeight"
+       "scrolledWindowMarginWidth"
+       "scrollingPolicy"
+       "selectColor"
+       "selectInsensitivePixmap"
+       "selectPixmap"
+       "selectThreshold"
+       "selectedItemCount"
+       "selectedItems"
+       "selection"
+       "selectionArray"
+       "selectionArrayCount"
+       "selectionLabelString"
+       "selectionPolicy"
+       "sensitive"
+       "separatorOn"
+       "set"
+       "shadow"
+       "shadowThickness"
+       "showArrows"
+       "showAsDefault"
+       "showSeparator"
+       "shown"
+       "simpleCallback"
+       "singleSelectionCallback"
+       "sizePolicy"
+       "skipAdjust"
+       "sliderSize"
+       "source"
+       "space"
+       "spacing"
+       "string"
+       "stringDirection"
+       "subMenuId"
+       "symbolPixmap"
+       "textOptions"
+       "textSink"
+       "textSource"
+       "thickness"
+       "thumb"
+       "thumbProc"
+       "title"
+       "titleString"
+       "toBottomCallback"
+       "toPositionCallback"
+       "toTopCallback"
+       "top"
+       "topAttachment"
+       "topItemPosition"
+       "topOffset"
+       "topPosition"
+       "topShadowColor"
+       "topShadowPixmap"
+       "topWidget"
+       "transient"
+       "translations"
+       "traversalOn"
+       "traversalType"
+       "troughColor"
+       "unitType"
+       "unmapCallback"
+       "unselectPixmap"
+       "update"
+       "updateSliderSize"
+       "useBottom"
+       "useRight"
+       "userData"
+       "value"
+       "valueChangedCallback"
+       "verifyBell"
+       "verticalScrollBar"
+       "visibleItemCount"
+       "visibleWhenOff"
+       "visualPolicy"
+       "whichButton"
+       "width"
+       "window"
+       "windowGroup"
+       "wordWrap"
+       "workWindow"
+       "x"
+       "y"))
diff --git a/motif/lisp/transport.lisp b/motif/lisp/transport.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..01f708a7e0c6b2297ffde56a8a709594a22d17fd
--- /dev/null
+++ b/motif/lisp/transport.lisp
@@ -0,0 +1,308 @@
+;;;; -*- Mode: Lisp ; Package: Toolkit-Internals -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; Code for transporting packets and messages between the C toolkit server
+;;; and the Lisp client.
+;;;
+
+(in-package "TOOLKIT-INTERNALS")
+
+
+
+;;;; Data structures
+
+(defconstant *header-size* 12)
+
+(defstruct (packet
+	    (:print-function print-packet)
+	    (:constructor make-packet (head)))
+  (head nil :type system:system-area-pointer)
+  (fill *header-size* :type fixnum)
+  (next nil :type (or null packet)))
+
+(defstruct (message
+	    (:print-function print-message)
+	    (:constructor %make-message))
+  (packet-count 0 :type fixnum)
+  (serial (the fixnum 0) :type (unsigned-byte 32))
+  (fill-packet nil :type (or null packet))
+  ;;
+  ;; NOTE:  This list contains the constituent packets in REVERSE order
+  ;; while the message is being constructed.  When it is finished, the list
+  ;; is reversed.
+  (packet-list nil :type list))
+
+(defun print-packet (p stream d)
+  (declare (ignore p d))
+  (write-string "#<X Toolkit Packet>" stream))
+
+(defun print-message (r stream d)
+  (declare (ignore d)
+	   (stream stream))
+  (format stream "#<X Toolkit Message - serial ~d>"(message-serial r)))
+
+(defconstant *packet-size* 4096)
+
+(deftype packet-index () `(integer 0 ,*packet-size*))
+
+
+
+;;;; Memory management and packet accessors
+
+(defmacro packet-serial (packet)
+  `(the (signed-byte 29) (system:signed-sap-ref-32 (packet-head ,packet) 0)))
+
+(defmacro packet-sequence-number (packet)
+  `(system:signed-sap-ref-16 (packet-head ,packet) 4))
+
+(defmacro packet-sequence-length (packet)
+  `(system:signed-sap-ref-16 (packet-head ,packet) 6))
+
+(defmacro packet-length (packet)
+  `(the packet-index (system:signed-sap-ref-32 (packet-head ,packet) 8)))
+
+
+;;; Free-list for keeping empty packet husks around.
+(defvar *free-packets* nil)
+
+(defun create-packet ()
+  (if *free-packets*
+      (let ((packet *free-packets*))
+	(setf *free-packets* (packet-next packet))
+	(setf (packet-length packet) *header-size*)
+	(setf (packet-fill packet) *header-size*)
+	packet)
+      (let* ((buffer (system:allocate-system-memory *packet-size*))
+	     (packet (make-packet buffer)))
+	(setf (packet-length packet) *header-size*)
+	packet)))
+
+(defun destroy-packet (packet)
+  (setf (packet-next packet) *free-packets*)
+  (setf *free-packets* packet))
+
+(declaim (inline make-message))
+(defun make-message (serial)
+  (declare (type (unsigned-byte 29) serial))
+  (let ((message (%make-message)))
+    (setf (message-serial message) serial)
+    message))
+
+
+
+
+;;;; Functions to stuff things into packets
+
+(macrolet ((def-packet-writer (name size)
+	     (let ((sap-ref (ecase size
+			      (1 'system:sap-ref-8)
+			      (2 'system:sap-ref-16)
+			      (4 'system:sap-ref-32)))
+		   (bits (* size 8)))
+	       `(defun ,name (packet data)
+		  (declare (type (signed-byte ,bits) data))
+		  (let ((fill (system:sap+ (packet-head packet)
+					   (packet-fill packet))))
+		    (setf (,sap-ref fill 0) data)
+		    (incf (packet-fill packet) ,size)
+		    (incf (packet-length packet) ,size)))))
+	   (def-packet-reader (name size)
+	     (let ((sap-ref (ecase size
+			      (1 'system:sap-ref-8)
+			      (2 'system:sap-ref-16)
+			      (4 'system:sap-ref-32)))
+		   (bits (* size 8)))
+	       `(defun ,name (packet)
+		  (let* ((fill (system:sap+ (packet-head packet)
+					    (packet-fill packet)))
+			 (data (,sap-ref fill 0)))
+		    (declare (type (signed-byte ,bits) data))
+		    (incf (packet-fill packet) ,size)
+		    data)))))
+  (def-packet-writer packet-put-byte 1)
+  (def-packet-writer packet-put-word 2)
+  (def-packet-writer packet-put-dblword 4)
+
+  (def-packet-reader packet-get-byte 1)
+  (def-packet-reader packet-get-word 2)
+  (def-packet-reader packet-get-dblword 4))
+
+
+
+;;;; Message management and accessors
+
+(defun create-message (serial)
+  (let ((message (make-message serial)))
+    (message-add-packet message)
+    message))
+
+(defun destroy-message (message)
+  (dolist (packet (message-packet-list message))
+    (destroy-packet packet)))
+
+(defun message-add-packet (message)
+  (let ((packet (create-packet)))
+    (push packet (message-packet-list message))
+    (setf (message-fill-packet message) packet)
+    (incf (message-packet-count message))
+    (setf (packet-sequence-number packet) (message-packet-count message))
+    ;; PACKET-SEQUENCE-LENGTH will be set when the message is sent
+    (setf (packet-serial packet) (message-serial message))))
+
+
+(macrolet ((def-message-writer (name size)
+	     (let ((packet-ref (ecase size
+				 (1 'packet-put-byte)
+				 (2 'packet-put-word)
+				 (4 'packet-put-dblword)))
+		   (bits (* size 8)))
+	       `(defun ,name (message data)
+		  (declare (type (signed-byte ,bits) data))
+		  (when (> (packet-length (message-fill-packet message))
+			   (- *packet-size* ,size 1))
+		    (message-add-packet message))
+		  (,packet-ref (message-fill-packet message) data))))
+	   (def-message-reader (name size)
+	     (let ((packet-ref (ecase size
+				 (1 'packet-get-byte)
+				 (2 'packet-get-word)
+				 (4 'packet-get-dblword))))
+	       `(defun ,name (message)
+		  (unless (< (packet-fill (message-fill-packet message))
+			     (- *packet-size* ,size -1))
+		    ;;
+		    ;; This is REALLY gross
+		    (setf (message-fill-packet message)
+			  (cadr (member (message-fill-packet message)
+					(message-packet-list message)))))
+		  (,packet-ref (message-fill-packet message))))))
+
+  (def-message-writer message-put-byte 1)
+  (def-message-writer message-put-word 2)
+  (def-message-writer message-put-dblword 4)
+
+  ;; These accessors should only be used in deciphering complete messages.
+  ;; Hence, it is assumed that the message IS complete (ie. the packets are
+  ;; in normal order).
+  (def-message-reader message-get-byte 1)
+  (def-message-reader message-get-word 2)
+  (def-message-reader message-get-dblword 4))
+
+
+
+;;;; Transmission functions
+
+(defun read-some-bytes (socket packet count)
+  (declare (type packet-index count))
+  (loop
+    (when (zerop count) (return))
+    (multiple-value-bind
+	(bytes-read errnum)
+	(unix:unix-read socket (system:sap+ (packet-head packet)
+					    (packet-fill packet)) count)
+      (declare (type (or null fixnum) bytes-read))
+      (unless bytes-read
+	(toolkit-error "Encountered error reading packet: ~a"
+		       (unix:get-unix-error-msg errnum)))
+      (when (zerop bytes-read)
+	(error 'toolkit-eof-error :string "Hit EOF while reading packet"))
+      (decf count (the fixnum bytes-read))
+      (incf (packet-fill packet) (the fixnum bytes-read)))))
+
+(defun write-some-bytes (socket packet)
+  (let ((fill 0)
+	(count (packet-length packet)))
+    (declare (type packet-index fill count))
+    (loop
+      (when (zerop count) (return))
+      (multiple-value-bind
+	  (bytes-sent errnum)
+	  (unix:unix-write socket (system:sap+ (packet-head packet) fill)
+			   0 count)
+	(declare (type (or null fixnum) bytes-sent))
+	(unless bytes-sent
+	  (toolkit-error "Encountered error writing packet: ~a"
+			 (unix:get-unix-error-msg errnum)))
+	(when (zerop (the fixnum bytes-sent))
+	  (error 'toolkit-eof-error :string "Hit EOF while sending packet."))
+	(decf count (the fixnum bytes-sent))
+	(incf fill (the fixnum bytes-sent))))))
+
+(defun check-packet-sanity (packet)
+  (format t "Packet serial is ~a~%" (packet-serial packet))
+  (format t "Packet current is ~a~%" (packet-sequence-number packet))
+  (format t "Packet total is ~a~%" (packet-sequence-length packet))
+  (format t "Packet length is ~a~%" (packet-length packet)))
+
+(declaim (inline transmit-packet receive-packet))
+(defun transmit-packet (packet socket)
+  (write-some-bytes socket packet ))
+
+(defun receive-packet (socket)
+  (let ((packet (create-packet)))
+    (setf (packet-fill packet) 0)
+    (read-some-bytes socket packet *header-size*)
+    (read-some-bytes socket packet (- (packet-length packet) *header-size*))
+    (setf (packet-fill packet) *header-size*)
+    packet))
+
+(defun transmit-message (message socket)
+  ;; First, reverse the packet list so that the packets go out in the right
+  ;; order
+  (setf (message-packet-list message) (nreverse (message-packet-list message)))
+  (let ((packet-count (message-packet-count message)))
+    (dolist (packet (message-packet-list message))
+      (setf (packet-sequence-length packet) packet-count)
+      (transmit-packet packet socket))))
+
+;;; An a-list of (serial . incomplete message)
+(defvar *pending-msgs* nil)
+
+(defun kill-deferred-message (packet)
+  (declare (ignore packet))
+  (warn "Cannot yet handle killing deferred messages."))
+
+(defun defer-packet (packet)
+  (declare (ignore packet))
+  (warn "Cannot yet handle deferring packets."))
+
+(defun receive-message (socket)
+  (let* ((first (receive-packet socket))
+	 (count (packet-sequence-length first)))
+    (cond
+     ((zerop count) (kill-deferred-message first))
+     ((= count 1)
+      (let ((message (make-message (packet-serial first))))
+	(setf (message-packet-count message) 1)
+	(push first (message-packet-list message))
+	(setf (message-fill-packet message) first)
+	message))
+     (t
+      (defer-packet first)))))
+
+
+
+;;;; Functions for handling requests
+
+(defun create-next-message ()
+  (let ((message (create-message (motif-connection-serial
+				  *motif-connection*))))
+    (incf (motif-connection-serial *motif-connection*))
+    message))
+
+(defun prepare-request (request-op options arg-count)
+  (declare (type (unsigned-byte 16) request-op)
+	   (type (unsigned-byte 8) arg-count))
+  (let ((message (create-next-message)))
+    (message-put-word message request-op)
+    (message-put-byte message (if (eq options :confirm) 1 0))
+    (message-put-byte message arg-count)
+    message))
diff --git a/motif/lisp/widgets.lisp b/motif/lisp/widgets.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..d3131944eaa65317aa14c373590939ee7acf5145
--- /dev/null
+++ b/motif/lisp/widgets.lisp
@@ -0,0 +1,235 @@
+;;;; -*- Mode: Lisp ; Package: Toolkit -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; These functions provide a nice interface to the underlying primitives
+;;; for manipulating widgets.
+;;;
+
+(in-package "TOOLKIT")
+
+
+
+;;;; Functions for dealing with widget resources
+
+;;; The resource list arguments are of the form:
+;;;      ( ... :<resource-name> <resource-value> ...)
+;;; eg.  (:label-string "Hello world")
+
+;;; This function takes a resource list and converts the resource symbols
+;;; into their appropriate string names
+(defun convert-resource-list (resources)
+  (when (cdr resources)
+    (setf (car resources) (symbol-resource (car resources)))
+    (convert-resource-list (cddr resources))))
+
+(defun convert-resource-names (resources)
+  (when resources
+    (setf (car resources) (symbol-resource (car resources)))
+    (convert-resource-names (cdr resources))))
+
+(declaim (inline set-values get-values))
+(defun set-values (widget &rest resources)
+  "Set the resource values of the specified widget."
+  (declare (type widget widget))
+  (convert-resource-list resources)
+  (%set-values widget resources))
+
+(defun get-values (widget &rest names)
+  "Access the resource values of the specified widget."
+  (declare (type widget widget))
+  (convert-resource-names names)
+  (%get-values widget names))
+
+(defmacro with-resource-values ((widget names bindings) &body forms)
+  `(progn
+     (convert-resource-names ,names)
+     (multiple-value-bind ,bindings
+			  (values-list (%get-values ,widget ,names))
+       ,@forms)))
+
+
+
+;;;; Functions for creating/destroying widgets
+
+(declaim (inline create-managed-widget create-widget create-application-shell
+		 create-popup-shell destroy-widget))
+(defun create-managed-widget (name class parent &rest resources)
+  "Creates a new widget and automatically manages it."
+  (declare (simple-string name)
+	   (keyword class)
+	   (type widget parent))
+  (convert-resource-list resources)
+  (%create-managed-widget name class parent resources))
+
+(defun create-widget (name class parent &rest resources)
+  "Creates a new widget."
+  (declare (simple-string name)
+	   (keyword class)
+	   (type widget parent))
+  (convert-resource-list resources)
+  (%create-widget name class parent resources))
+
+(defun create-application-shell (&rest resources)
+  "Creates an application shell."
+  (convert-resource-list resources)
+  (%create-application-shell resources))
+
+(defun create-popup-shell (name class parent &rest resources)
+  "Creates a popup shell."
+  (declare (simple-string name)
+	   (keyword class)
+	   (type widget parent))
+  (convert-resource-list resources)
+  (%create-popup-shell name class parent resources))
+
+(defun internal-destroy-widget (widget)
+  (declare (type widget widget))
+  (let ((id (widget-id widget)))
+    ;; Destroy all storage for widget's children
+    (dolist (child (widget-children widget))
+      (internal-destroy-widget child))
+    ;; Remove widget's entry in the widget table
+    (remhash id (motif-connection-widget-table *motif-connection*))
+    ;; Destroy all callback information
+    (dolist (cback-name (widget-callbacks widget))
+      (remhash (cons id (symbol-resource cback-name))
+	       (motif-connection-callback-table *motif-connection*)))
+    ;; Destroy all protocol callback information
+    (dolist (entry (widget-protocols widget))
+      (let ((prop (car entry))
+	    (proto (cdr entry)))
+	(remhash (list (widget-id widget) prop proto)
+		 (motif-connection-protocol-table *motif-connection*))))
+    ;; Destroy all event handler information
+    (dolist (event-class (widget-events widget))
+      (remhash (cons (widget-id widget) event-class)
+	       (motif-connection-event-table *motif-connection*)))))
+
+(defun destroy-widget (widget)
+  "Destroys the specified widget and all its descendents."
+  (declare (type widget widget))
+  (let ((parent (widget-parent widget)))
+    (setf (widget-children parent)
+	  (delete widget (widget-children parent))))
+  (internal-destroy-widget widget)
+  (%destroy-widget widget))
+
+(declaim (inline manage-children unmanage-children))
+(defun manage-children (&rest widgets)
+  "Manage multiple children of the same parent."
+  (%manage-children widgets))
+
+(defun unmanage-children (&rest widgets)
+  "Unmanage multiple children of the same parent."
+  (%unmanage-children widgets))
+
+
+
+;;;; Motif widget creation convenience functions
+
+(defvar *convenience-auto-manage* nil
+  "Controls whether widget convenience functions will automatically manage the
+   widgets which they create.")
+
+(eval-when (compile eval)
+  (defmacro def-widget-maker (class)
+    (let ((fn-name (read-from-string (format nil "CREATE-~a" class))))
+      `(progn
+	 (declaim (inline ,fn-name))
+	 (defun ,fn-name (parent name &rest resources)
+	   ,(format nil "Creates a new ~a widget." class)
+	   (declare (type widget parent)
+		    (simple-string name))
+	   (convert-resource-list resources)
+	   (if *convenience-auto-manage*
+	       (%create-managed-widget name ,class parent resources)
+	       (%create-widget name ,class parent resources))))))
+  
+  (defmacro def-creation-wrapper (class)
+    (let ((fn-name (read-from-string (format nil "CREATE-~a" class)))
+	  (other (read-from-string (format nil "%CREATE-~a" class))))
+      `(progn
+	 (declaim (inline ,fn-name))
+	 (defun ,fn-name (parent name &rest resources)
+	   ,(format nil "Creates a new ~a widget." class)
+	   (declare (type widget parent)
+		    (simple-string name))
+	   (convert-resource-list resources)
+	   (,other parent name resources)))))
+  ) ;; EVAL-WHEN
+
+
+(def-widget-maker :arrow-button)
+(def-widget-maker :arrow-button-gadget)
+(def-widget-maker :bulletin-board)
+(def-widget-maker :cascade-button)
+(def-widget-maker :cascade-button-gadget)
+(def-widget-maker :command)
+(def-widget-maker :dialog-shell)
+(def-widget-maker :drawing-area)
+(def-widget-maker :drawn-button)
+(def-widget-maker :file-selection-box)
+(def-widget-maker :form)
+(def-widget-maker :frame)
+(def-widget-maker :label)
+(def-widget-maker :label-gadget)
+(def-widget-maker :list)
+(def-widget-maker :main-window)
+(def-widget-maker :menu-shell)
+(def-widget-maker :message-box)
+(def-widget-maker :paned-window)
+(def-widget-maker :push-button)
+(def-widget-maker :push-button-gadget)
+(def-widget-maker :row-column)
+(def-widget-maker :scale)
+(def-widget-maker :scroll-bar)
+(def-widget-maker :scrolled-window)
+(def-widget-maker :selection-box)
+(def-widget-maker :separator)
+(def-widget-maker :separator-gadget)
+(def-widget-maker :text)
+(def-widget-maker :toggle-button)
+(def-widget-maker :toggle-button-gadget)
+
+
+(def-creation-wrapper :menu-bar)
+(def-creation-wrapper :option-menu)
+(def-creation-wrapper :radio-box)
+(def-creation-wrapper :warning-dialog)
+(def-creation-wrapper :bulletin-board-dialog)
+(def-creation-wrapper :error-dialog)
+(def-creation-wrapper :file-selection-dialog)
+(def-creation-wrapper :form-dialog)
+(def-creation-wrapper :information-dialog)
+(def-creation-wrapper :message-dialog)
+(def-creation-wrapper :popup-menu)
+(def-creation-wrapper :prompt-dialog)
+(def-creation-wrapper :pulldown-menu)
+(def-creation-wrapper :question-dialog)
+(def-creation-wrapper :scrolled-list)
+(def-creation-wrapper :scrolled-text)
+(def-creation-wrapper :selection-dialog)
+(def-creation-wrapper :working-dialog)
+
+
+
+;;;; Misc. widget management functions
+
+(declaim (inline menu-position))
+(defun menu-position (widget event)
+  "Positions a popup menu according to the position in the given XEvent."
+  (declare (type widget widget)
+	   (type (or (unsigned-byte 32) toolkit-event) event))
+
+  (%menu-position widget
+		    (if (typep event 'toolkit-event)
+			(xti:event-handle event)
+			event)))
diff --git a/motif/lisp/xt-types.lisp b/motif/lisp/xt-types.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..a16e8bee9c74e4acb296473ff2e2731c5a6044db
--- /dev/null
+++ b/motif/lisp/xt-types.lisp
@@ -0,0 +1,278 @@
+;;;; -*- Mode: Lisp, Fill ; Package: Toolkit -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+;;; **********************************************************************
+;;;
+;;; Written by Michael Garland
+;;;
+;;; This file defines the data types allowed in communication between the
+;;; Lisp client and the C server.
+;;;
+
+(in-package "TOOLKIT")
+
+(declaim (vector *class-table*))
+(declaim (simple-vector *type-table*))
+
+(setf (fill-pointer *class-table*) 0)
+(setf next-type-tag 0)
+
+
+
+;;;; Functions for defining data types
+
+;;; enumeration values will have a :enum-value on the symbol plist
+(defun def-toolkit-enum (type values)
+  ;; Values begin at zero by default and increase by one each time
+  (let ((current 0)
+	(values-alist)
+	(main-value))
+    (declare (fixnum current))
+    (dolist (value values)
+      (setf main-value value)
+      (when (listp value)
+	(when (numberp (car value))
+	  (setf current (car value))
+	  (setf value (cdr value)))
+	(setf main-value (car value))
+	(dolist (synonym (cdr value))
+	  (setf (get synonym :enum-value) current)))
+      (setf (get main-value :enum-value) current)
+      (push (cons current main-value) values-alist)
+      (incf current))
+    (setf (gethash type *enum-table*) values-alist)))
+    
+(defun def-toolkit-types (types)
+  (dolist (type types)
+    (let ((name (first type))
+	  (kind (second type)))
+      (setf (get name :xtk-type-tag) next-type-tag)
+      (when (eq kind :enum) (setf kind name))
+      (setf (svref *type-table* next-type-tag) (cons name kind))
+      (incf next-type-tag))))
+
+
+
+;;;; Defining of widget classes
+
+(defun def-motif-classes (shells motif-shells classes)
+  (flet ((register-shell (name format-arg)
+	   (setf (get name :widget-class) (fill-pointer *class-table*))
+	   (vector-push-extend
+	    (cons name (format nil format-arg (symbol-resource name)))
+	    *class-table*))
+	 (register-class (name format-arg)
+	   (setf (get name :widget-class) (fill-pointer *class-table*))
+	   (vector-push-extend
+	    (cons name (format nil format-arg (symbol-class name)))
+	    *class-table*)))
+    (dolist (shell shells)
+      (register-shell shell "~aWidgetClass"))
+    (dolist (motif-shell motif-shells)
+      (register-class motif-shell "xm~aWidgetClass"))
+    (dolist (thing classes)
+      (let ((widget (first thing))
+	    (gadget (second thing)))
+	(register-class widget "xm~aWidgetClass")
+	(when gadget
+	  (register-class gadget "xm~aClass"))))))
+
+
+
+;;;; Widget classes
+
+(def-motif-classes
+  ;; These are the generic Xt shell widget classes
+  '(:override-shell :transient-shell :top-level-shell :application-shell)
+  ;;
+  ;; These are specific Motif shell widget classes
+  '(:dialog-shell :menu-shell)
+  ;;
+  ;; These are the various other widget classes (all Motif)
+  '((:label :label-gadget)
+    (:arrow-button :arrow-button-gadget)
+    (:push-button :push-button-gadget)
+    (:toggle-button :toggle-button-gadget)
+    (:cascade-button :cascade-button-gadget)
+    (:separator :separator-gadget)
+    (:drawn-button)
+    (:menu-shell)
+    (:drawing-area)
+    (:dialog-shell)
+    (:bulletin-board)
+    (:command)
+    (:file-selection-box)
+    (:form)
+    (:message-box)
+    (:selection-box)
+    (:scroll-bar)
+    (:text)
+    (:text-field)
+    (:row-column)
+    (:scale)
+    (:frame)
+    (:list)
+    (:main-window)
+    (:scrolled-window)
+    (:paned-window)))
+
+
+
+;;;; Motif data types
+;;;
+;;; The types MUST be listed in alphabetical order
+;;;
+
+(def-toolkit-types
+  '((:accelerator-table :accelerator-table) (:alignment :enum)
+    (:arrow-direction :enum) (:atom :atom) (:attachment :enum)
+    (:bitmap :xid) (:bool :boolean) (:boolean :boolean) (:callback-reason :enum)
+    (:cardinal :int) (:char :short) (:color :color) (:colormap :xid)
+    (:command-window-location :enum) (:cursor :xid) (:default-button-type :enum)
+    (:dialog-style :enum) (:dialog-type :enum) (:dimension :short)
+    (:edit-mode :enum) (:enum :enum) (:event :event) (:file-type-mask :enum)
+    (:float :float) (:font :xid) (:font-list :font-list)
+    (:function :function) (:grab-kind :enum) (:highlight-mode :enum)
+    (:indicator-type :enum) (:initial-state :int) (:int :int)
+    (:int-list :int-list) (:keyboard-focus-policy :enum) (:label-type :enum)
+    (:list-size-policy :enum) (:multi-click :enum) (:navigation-type :enum)
+    (:packing :enum) (:pixel :int) (:pixmap :xid) (:pointer :int)
+    (:position :short) (:processing-direction :enum) (:resize-policy :enum)
+    (:resource-list :resource-list) (:resource-names :resource-names)
+    (:row-column-type :enum) (:scroll-bar-display-policy :enum)
+    (:scroll-bar-placement :enum) (:scrolling-policy :enum)
+    (:selection-policy :enum) (:separator-type :enum) (:shadow-type :enum)
+    (:short :short) (:string :string) (:string-direction :enum)
+    (:string-table :string-table) (:string-token :string-token)
+    (:translation-table :translation-table) (:traversal-direction :enum)
+    (:unit-type :enum) (:unsigned-char :short) (:visual-policy :enum)
+    (:widget :widget) (:widget-class :widget-class)
+    (:widget-list :widget-list) (:window :xid) (:xm-string :xm-string)
+    (:xm-string-table :xm-string-table)))
+
+(def-toolkit-enum :arrow-direction
+  '(:arrow-up :arrow-down :arrow-left :arrow-right))
+
+(def-toolkit-enum :shadow-type
+  '((5 :shadow-etched-in :etched-in) (:shadow-etched-out :etched-out)
+    (:shadow-in :in) (:shadow-out :out)))
+
+(def-toolkit-enum :alignment
+  '((:alignment-beginning :beginning) (:alignment-center :center)
+    (:alignment-end :end)))
+
+(def-toolkit-enum :attachment
+  '((:attach-none :none) :attach-form
+    (:attach-opposite-form :opposite-form) (:attach-widget :widget)
+    (:attach-opposite-widget :opposite-widget) (:attach-position :position)
+    (:attach-self :self)))
+
+(def-toolkit-enum :resize-policy
+  '((:resize-none :none) (:resize-grow :grow) (:resize-any :any)))
+
+(def-toolkit-enum :separator-type
+  '(:no-line :single-line :double-line :single-dashed-line
+   :double-dashed-line :shadow-etched-in :shadow-etched-out))
+
+(def-toolkit-enum :keyboard-focus-policy
+  '(:explicit :pointer))
+
+(def-toolkit-enum :row-column-type
+  '(:work-area :menu-bar :menu-pulldown :menu-popup :menu-option))
+
+(def-toolkit-enum :orientation
+  '(:no-orientation :vertical :horizontal))
+
+(def-toolkit-enum :grab-kind
+  '(:grab-none :grab-nonexclusive :grab-exclusive))
+
+(def-toolkit-enum :edit-mode
+  '(:multi-line-edit :single-line-edit))
+
+(def-toolkit-enum :callback-reason
+  '(:cr-none :cr-help :cr-value-changed :cr-increment :cr-decrement
+    :cr-page-increment :cr-page-decrement :cr-to-top :cr-to-bottom :cr-drag
+    :cr-activate :cr-arm :cr-disarm (16 :cr-map) :cr-unmap :cr-focus
+    :cr-losing-focus :cr-modifying-text-value :cr-moving-insert-cursor
+    :cr-execute :cr-single-select :cr-multiple-select :cr-extended-select
+    :cr-browse-select :cr-default-action :cr-clipboard-data-request
+    :cr-clipboard-data-delete :cr-cascading :cr-ok :cr-cancel (34 :cr-apply)
+    :cr-no-match :cr-command-entered :cr-command-changed :cr-expose
+    :cr-resize :cr-input :cr-gain-primary :cr-lose-primary :cr-create
+    (6666 :cr-protocols)))
+
+(def-toolkit-enum :default-button-type
+  '(:dialog-none :dialog-apply-button :dialog-cancel-button
+    :dialog-default-button :dialog-ok-button :dialog-filter-label
+    :dialog-filter-text :dialog-help-button
+    (:dialog-list :dialog-history-list :dialog-file-list)
+    (:dialog-list-label :dialog-file-list-label) :dialog-message-label
+    (:dialog-selection-label :dialog-prompt-label) :dialog-symbol-label
+    (:dialog-text :dialog-value-text :dialog-command-text)
+    :dialog-separator :dialog-dir-list :dialog-dir-list-label))
+
+(def-toolkit-enum :dialog-style
+  '((:dialog-modeless :dialog-work-area)
+    (:dialog-primary-application-modal :dialog-application-modal)
+    (:dialog-full-application-modal) (:dialog-system-modal)))
+
+(def-toolkit-enum :dialog-type
+  '(:dialog-work-area
+    (:dialog-error       :dialog-prompt)
+    (:dialog-information :dialog-selection)
+    (:dialog-message     :dialog-command)
+    (:dialog-question    :dialog-file-selection)
+    :dialog-warning :dialog-working))
+
+(def-toolkit-enum :file-type-mask
+  '((1 :file-directory) :file-regular :file-any-type))
+
+(def-toolkit-enum :command-window-location
+  '(:command-above-workspace :command-below-workspace))
+
+(def-toolkit-enum :multi-click '(:multiclick-discard :multiclick-keep))
+
+(def-toolkit-enum :navigation-type
+  '(:none :tab-group :sticky-tab-group :exclusive-tab-group))
+
+(def-toolkit-enum :processing-direction
+  '(:max-on-top :max-on-bottom :max-on-left :max-on-right))
+
+(def-toolkit-enum :list-size-policy '(:variable :constant :resize-if-possible))
+
+(def-toolkit-enum :unit-type
+  '(:pixels :100th-millimeters :1000th-inches :100th-points :100th-font-units))
+
+(def-toolkit-enum :indicator-type '((1 :n-of-many) :one-of-many))
+
+(def-toolkit-enum :selection-policy
+  '(:single-select :multiple-select :extended-select :browse-select))
+
+(def-toolkit-enum :string-direction
+  '(:string-direction-l-to-r :string-direction-r-to-l))
+
+(def-toolkit-enum :scroll-bar-display-policy '(:static :as-needed))
+
+(def-toolkit-enum :scroll-bar-placement
+  '(:bottom-right :top-right :bottom-left :top-left))
+
+(def-toolkit-enum :scrolling-policy '(:automatic :application-defined))
+
+(def-toolkit-enum :visual-policy '(:variable :constant))
+
+(def-toolkit-enum :label-type '((1 :pixmap) :string))
+
+(def-toolkit-enum :packing
+  '(:no-packing :pack-tight :pack-column :pack-none))
+
+(def-toolkit-enum :traversal-direction
+  '(:traverse-current :traverse-next :traverse-next :traverse-prev
+    :traverse-home :traverse-next-tab-group :traverse-prev-tab-group
+    :traverse-up :traverse-down :traverse-left :traverse-right))
+
+(def-toolkit-enum :highlight-mode
+  '(:highlight-normal :highlight-selected :highlight-secondary-selected))