X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=mop.lisp;h=43a2f82708b67bfb6f3fed53826d1566c9c051cd;hb=refs%2Fheads%2Fmaster;hp=b37a59c21300673022024970184867678f1e6db1;hpb=7488e60672318e28e08f87c64fe3868690dbfd7b;p=hyperobject.git diff --git a/mop.lisp b/mop.lisp index b37a59c..43a2f82 100644 --- a/mop.lisp +++ b/mop.lisp @@ -11,8 +11,6 @@ ;;;; in Text, HTML, and XML formats. This includes hyperlinking ;;;; capability and sub-objects. ;;;; -;;;; $Id$ -;;;; ;;;; This file is Copyright (c) 2000-2006 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -22,10 +20,10 @@ (defclass hyperobject-class (standard-class) ( ;; slots initialized in defclass - (user-name :initarg :user-name :type string :initform nil + (user-name :initarg :user-name :initform nil :accessor user-name :documentation "User name for class") - (user-name-plural :initarg :user-name-plural :type string :initform nil + (user-name-plural :initarg :user-name-plural :initform nil :accessor user-name-plural :documentation "Plural user name for class") (default-print-slots :initarg :default-print-slots :type list :initform nil @@ -218,7 +216,8 @@ (defmethod finalize-inheritance :after ((cl hyperobject-class)) "Initialize a hyperobject class. Calculates all class slots" (finalize-subobjects cl) - (finalize-compute-cached cl)) + (finalize-compute-cached cl) + (init-hyperobject-class cl)) (eval-when (:compile-toplevel :load-toplevel :execute) (when (>= (length (generic-function-lambda-list @@ -401,6 +400,13 @@ SQL name" (or (eq type 'string) (and (listp type) (some #'(lambda (x) (eq x 'string)) type)))) +(defun value-type-is-a-string (type) + (or (eq type 'string) + (eq type 'cdata) + (and (listp type) (some #'(lambda (x) (or (eq x 'string) + (eq x 'cdata))) + type)))) + (defun base-value-type (value-type) (if (atom value-type) value-type @@ -533,7 +539,7 @@ SQL name" (setf (documentation cl 'type) (format nil "Hyperobject~A~A~A~A" (aif (user-name cl) - (format nil ": ~A" it "")) + (format nil ": ~A" it) "") (aif (description cl) (format nil "~%Class description: ~A" it) "") (aif (subobjects cl)