;;;----- Licensing notice ---------------------------------------------------
;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;;--------------------------------------------------------------------------
;;; Classes.
-(defun maximum (items order what)
- "Return a maximum item according to the non-strict partial ORDER."
- (reduce (lambda (best this)
- (cond ((funcall order best this) best)
- ((funcall order this best) this)
- (t (error "Unable to choose best ~A." what))))
- items))
-
-(defmethod guess-metaclass ((class sod-class))
- "Default metaclass-guessing function for classes.
-
- Return the most specific metaclass of any of the CLASS's direct
- superclasses."
- (maximum (mapcar #'sod-class-metaclass
- (sod-class-direct-superclasses class))
- #'sod-subclass-p
- (format nil "metaclass for `~A'" class)))
-
(defmethod shared-initialize :after ((class sod-class) slot-names &key pset)
"Specific behaviour for SOD class initialization.
(pset :nick :id)
(string-downcase (slot-value class 'name)))
- ;; If no metaclass, guess one in a (Lisp) class-specific way.
+ ;; Set the metaclass if the appropriate property has been provided;
+ ;; otherwise leave it unbound for now, and we'll sort out the mess during
+ ;; finalization.
(default-slot-from-property (class 'metaclass slot-names)
- (pset :metaclass :id meta (find-sod-class meta))
- (and (sod-class-direct-superclasses class)
- (guess-metaclass class)))
+ (pset :metaclass :id meta (find-sod-class meta)))
;; If no chain-link, then start a new chain here.
(default-slot-from-property (class 'chain-link slot-names)