X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/6e92afa75860a55640efa6f3ba39f9624b41e8a8..944bf9362ff51217b1617f85126d26e821b8aa91:/src/class-make-proto.lisp

diff --git a/src/class-make-proto.lisp b/src/class-make-proto.lisp
index 0e3c5d7..09b9f98 100644
--- a/src/class-make-proto.lisp
+++ b/src/class-make-proto.lisp
@@ -28,8 +28,16 @@
 ;;;--------------------------------------------------------------------------
 ;;; Classes.
 
+(export 'guess-metaclass)
+(defgeneric guess-metaclass (class)
+  (:documentation
+   "Determine a suitable metaclass for the CLASS.
+
+   The default behaviour is to choose the most specific metaclass of any of
+   the direct superclasses of CLASS, or to signal an error if that failed."))
+
 (export 'make-sod-class)
-(defun make-sod-class (name superclasses pset &optional location)
+(defun make-sod-class (name superclasses pset &key location)
   "Construct and return a new SOD class with the given NAME and SUPERCLASSES.
 
    This is the main constructor function for classes.  The protocol works as
@@ -64,7 +72,7 @@
 ;;; Slots and slot initializers.
 
 (export 'make-sod-slot)
-(defgeneric make-sod-slot (class name type pset &optional location)
+(defgeneric make-sod-slot (class name type pset &key location)
   (:documentation
    "Construct, add, and attach a new slot with given NAME and TYPE, to CLASS.
 
@@ -78,7 +86,7 @@
 
 (export 'make-sod-instance-initializer)
 (defgeneric make-sod-instance-initializer
-    (class nick name value pset &optional location)
+    (class nick name value pset &key location inhibit-initargs add-to-class)
   (:documentation
    "Construct and attach an instance slot initializer, to CLASS.
 
@@ -87,11 +95,17 @@
    construction process.  The default method looks up the slot using
    `find-instance-slot-by-name', calls `make-sod-initializer-using-slot' to
    actually make the initializer object, and adds it to the appropriate list
-   in CLASS."))
+   in CLASS unless ADD-TO-CLASS is nil.
+
+   Usually, if an `initarg' property is set on PSET, then a slot initarg is
+   created and attached to the slot; this can be prevented by setting
+   INHIBIT-INITARGS non-nil.  This is needed when creating a slot and
+   initializer from the same property set, in order to prevent creation of a
+   duplicate initarg."))
 
 (export 'make-sod-class-initializer)
 (defgeneric make-sod-class-initializer
-    (class nick name value pset &optional location)
+    (class nick name value pset &key location add-to-class)
   (:documentation
    "Construct and attach a class slot initializer, to CLASS.
 
@@ -100,7 +114,7 @@
    construction process.  The default method looks up the slot using
    `find-class-slot-by-name', calls `make-sod-initializer-using-slot' to
    actually make the initializer object, and adds it to the appropriate list
-   in CLASS."))
+   in CLASS unless ADD-TO-CLASS is nil."))
 
 (export 'make-sod-initializer-using-slot)
 (defgeneric make-sod-initializer-using-slot
@@ -127,7 +141,7 @@
 
 (export 'make-sod-user-initarg)
 (defgeneric make-sod-user-initarg
-    (class name type pset &optional default location)
+    (class name type pset &key default location)
   (:documentation
    "Attach a user-defined initialization keyword argument to the CLASS.
 
@@ -137,7 +151,7 @@
 
 (export 'make-sod-slot-initarg)
 (defgeneric make-sod-slot-initarg
-    (class name nick slot-name pset &optional location)
+    (class name nick slot-name pset &key location)
   (:documentation
    "Attach an initialization keyword argument to a slot by name.
 
@@ -146,7 +160,7 @@
 
 (export 'make-sod-slot-initarg-using-slot)
 (defgeneric make-sod-slot-initarg-using-slot
-    (class name slot pset &optional location)
+    (class name slot pset &key location)
   (:documentation
    "Attach an initialization keyword argument to a SLOT.
 
@@ -161,7 +175,7 @@
   (:documentation "Returns an `argument' object for the initarg."))
 
 (export 'make-sod-class-initfrag)
-(defgeneric make-sod-class-initfrag (class frag pset &optional location)
+(defgeneric make-sod-class-initfrag (class frag pset &key location)
   (:documentation
    "Attach an initialization fragment FRAG to the CLASS.
 
@@ -169,7 +183,7 @@
    list."))
 
 (export 'make-sod-class-tearfrag)
-(defgeneric make-sod-class-tearfrag (class frag pset &optional location)
+(defgeneric make-sod-class-tearfrag (class frag pset &key location)
   (:documentation
    "Attach a teardown fragment FRAG to the CLASS.
 
@@ -180,7 +194,7 @@
 ;;; Messages and methods.
 
 (export 'make-sod-message)
-(defgeneric make-sod-message (class name type pset &optional location)
+(defgeneric make-sod-message (class name type pset &key location)
   (:documentation
    "Construct and attach a new message with given NAME and TYPE, to CLASS.
 
@@ -196,7 +210,7 @@
 
 (export 'make-sod-method)
 (defgeneric make-sod-method
-    (class nick name type body pset &optional location)
+    (class nick name type body pset &key location)
   (:documentation
    "Construct and attach a new method to CLASS.