X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/52a79ab8b310a785f2c2f1a11069f3a5ad53810c..6ac5b807942124461e19a7964165d7237c61fbb7:/src/class-make-proto.lisp diff --git a/src/class-make-proto.lisp b/src/class-make-proto.lisp index 01e18eb..8b024bd 100644 --- a/src/class-make-proto.lisp +++ b/src/class-make-proto.lisp @@ -45,8 +45,14 @@ (with-default-error-location (location) (let* ((pset (property-set pset)) - (class (make-instance (get-property pset :lisp-metaclass :symbol - 'sod-class) + (best-class (or (get-property pset :lisp-metaclass :symbol nil) + (if superclasses + (maximum (mapcar #'class-of superclasses) + #'subtypep + (format nil "Lisp metaclass for ~A" + name)) + 'sod-class))) + (class (make-instance best-class :name name :superclasses superclasses :location (file-location location) @@ -136,12 +142,13 @@ This is the main constructor function for messages. This is a generic function primarily so that the CLASS can intervene in the construction - process. The default method uses the `:message-class' property - (defaulting to `sod-message') to choose a (CLOS) class to instantiate. - The message is then constructed by `make-instance' passing the arguments - as initargs; further behaviour is left to the standard CLOS instance - construction protocol; for example, `sod-message' defines an - `:after'-method on `shared-initialize'.")) + process. The default method uses the `:message-class' property to choose + a (CLOS) class to instantiate; if no such property is provided but a + `combination' property is present, then `aggregating-message' is chosen; + otherwise `standard-message' is used. The message is then constructed by + `make-instance' passing the arguments as initargs; further behaviour is + left to the standard CLOS instance construction protocol; for example, + `sod-message' defines an `:after'-method on `shared-initialize'.")) (export 'make-sod-method) (defgeneric make-sod-method