X-Git-Url: http://git.kpe.io/?p=hyperobject.git;a=blobdiff_plain;f=mop.lisp;h=43a2f82708b67bfb6f3fed53826d1566c9c051cd;hp=47a2aaeb3d37a2da6b0a5983383a66bd6cdbfe36;hb=HEAD;hpb=68758a88e44b4bacb0f8cce68166ff0f8d5b3100 diff --git a/mop.lisp b/mop.lisp index 47a2aae..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 @@ -402,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 @@ -534,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)