diff --git a/code/serve-event.lisp b/code/serve-event.lisp
index aa26296ec2a1226eb6206f6fc3d80516c94636ad..918ec4a73a8b609435c92a8631818ce09ae6ff02 100644
--- a/code/serve-event.lisp
+++ b/code/serve-event.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.14 1992/02/14 23:45:32 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.15 1992/03/26 03:17:26 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -20,7 +20,9 @@
 (in-package "SYSTEM")
 
 (export '(with-fd-handler add-fd-handler remove-fd-handler invalidate-descriptor
-	  serve-event serve-all-events wait-until-fd-usable))
+	  serve-event serve-all-events wait-until-fd-usable
+	  make-object-set object-set-operation *xwindow-table*
+	  map-xwindow add-xwindow-object remove-xwindow-object))
 
 (in-package "EXTENSIONS")
 
@@ -30,11 +32,116 @@
 
 
 
-;;;; MACH Message receiving noise.
+;;;; Object set stuff.
 
-(defvar *in-server* NIL
-  "*In-server* is set to T when the SIGMSG interrupt has been enabled
-  in Server.")
+;;;
+;;;    Hashtable from ports to objects.  Each entry is a cons (object . set).
+;;;
+;(defvar *port-table* (make-hash-table :test #'eql))
+
+;;; Hashtable from windows to objects.  Each entry is a cons (object . set).
+;;;
+(defvar *xwindow-table* (make-hash-table :test #'eql))
+
+
+(defstruct (object-set
+	    (:constructor make-object-set
+			  (name &optional
+				(default-handler #'default-default-handler)))
+	    (:print-function
+	     (lambda (s stream d)
+	       (declare (ignore d))
+	       (format stream "#<Object Set ~S>" (object-set-name s)))))
+  name					; Name, for descriptive purposes.
+  (table (make-hash-table :test #'eq))  ; Message-ID or xevent-type --> handler fun.
+  default-handler)
+
+(setf (documentation 'make-object-set 'function)
+      "Make an object set for use by a RPC/xevent server.  Name is for
+      descriptive purposes only.")
+
+;;; Default-Default-Handler  --  Internal
+;;;
+;;;    If no such operation defined, signal an error.
+;;;
+(defun default-default-handler (object)
+  (error "You lose, object: ~S" object))
+
+
+;;; MAP-XWINDOW and MAP-PORT return as multiple values the object and
+;;; object set mapped to by a xwindow or port in *xwindow-table* or
+;;; *port-table*.
+;;; 
+(macrolet ((defmapper (name table)
+	      `(defun ,(intern (concatenate 'simple-string
+					    "MAP-" (symbol-name name)))
+		      (,name)
+		 ,(format nil "Return as multiple values the object and ~
+		               object-set mapped to by ~A."
+			  (string-downcase (symbol-name name)))
+		 (let ((temp (gethash ,name ,table)))
+		   (if temp
+		       (values (car temp) (cdr temp))
+		       (values nil nil))))))
+  ;(defmapper port *port-table*)
+  (defmapper xwindow *xwindow-table*))
+
+
+;;; ADD-PORT-OBJECT and ADD-XWINDOW-OBJECT store an object/object-set pair
+;;; mapped to by a port or xwindow in either *port-table* or *xwindow-table*.
+;;; 
+(macrolet ((def-add-object (name table)
+	      `(defun ,(intern (concatenate 'simple-string
+					    "ADD-" (symbol-name name)
+					    "-OBJECT"))
+		      (,name object object-set)
+		 ,(format nil "Add a new ~A/object/object-set association."
+			  (string-downcase (symbol-name name)))
+		 (check-type object-set object-set)
+		 (setf (gethash ,name ,table) (cons object object-set))
+		 object)))
+  ;(def-add-object port *port-table*)
+  (def-add-object xwindow *xwindow-table*))
+
+
+;;; REMOVE-PORT-OBJECT and REMOVE-XWINDOW-OBJECT remove a port or xwindow and
+;;; its associated object/object-set pair from *port-table* or *xwindow-table*.
+;;; 
+(macrolet ((def-remove-object (name table)
+	      `(defun ,(intern (concatenate 'simple-string
+					    "REMOVE-" (symbol-name name)
+					    "-OBJECT"))
+		      (,name)
+		 ,(format nil
+			  "Remove ~A and its associated object/object-set pair."
+			  (string-downcase (symbol-name name)))
+		 (remhash ,name ,table))))
+  ;(def-remove-object port *port-table*)
+  (def-remove-object xwindow *xwindow-table*))
+
+
+;;; Object-Set-Operation  --  Public
+;;;
+;;;    Look up the handler function for a given message ID.
+;;;
+(defun object-set-operation (object-set message-id)
+  "Return the handler function in Object-Set for the operation specified by
+   Message-ID, if none, NIL is returned."
+  (check-type object-set object-set)
+  (check-type message-id fixnum)
+  (values (gethash message-id (object-set-table object-set))))
+
+;;; %Set-Object-Set-Operation  --  Internal
+;;;
+;;;    The setf inverse for Object-Set-Operation.
+;;;
+(defun %set-object-set-operation (object-set message-id new-value)
+  (check-type object-set object-set)
+  (check-type message-id fixnum)
+  (setf (gethash message-id (object-set-table object-set)) new-value))
+;;;
+(defsetf object-set-operation %set-object-set-operation
+  "Sets the handler function for an object set operation.")