r3019: *** empty log message ***

diff --git a/debian/changelog b/debian/changelog
index 5703dd9b99099bb9c6afbd5a5a4aca31e7e304ec..3f9903a3634e6b3f64e30191d5790dda16a12785 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-kmrcl (1.8-1) unstable; urgency=low
+
+  * ml-class.lisp: Add defgeneric for generic functions
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon, 14 Oct 2002 09:11:08 -0600
+
 cl-kmrcl (1.7-1) unstable; urgency=low
 
   * Push :kmrcl onto features

diff --git a/ml-class.lisp b/ml-class.lisp
index f32a974a29f067aa25bafe7744bd8978b159bef1..bab9ca619497c66de58c58edadb52e9aec4cbfeb 100644 (file)
--- a/ml-class.lisp
+++ b/ml-class.lisp
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: ml-class.lisp,v 1.9 2002/10/14 15:01:17 kevin Exp $
+;;;; $Id: ml-class.lisp,v 1.10 2002/10/14 15:25:11 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -227,9 +227,14 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
            (setq xmlvalue-func (append xmlvalue-func plain-value-func)))
          ))
 
-      (setq value-func `(lambda () (values ,@value-func)))
+      (if value-func
+         (setq value-func `(lambda (x) (values ,@value-func)))
+       (setq value-func `(lambda () (values))))
       (setq value-func (compile nil (eval value-func)))
-      (setq xmlvalue-func `(lambda () (values ,@xmlvalue-func)))
+      
+      (if xmlvalue-func
+         (setq xmlvalue-func `(lambda (x) (values ,@xmlvalue-func)))
+       (setq xmlvalue-func `(lambda () (values))))
       (setq xmlvalue-func (compile nil (eval xmlvalue-func)))
 
       (setf (slot-value cl 'fmtstr-text) fmtstr-text)
@@ -301,6 +306,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 ;;; Class name functions
 
+(defgeneric ml-class-stdname (x))
 (defmethod ml-class-stdname ((name string))
   (string-downcase (subseq name 1)))
   
@@ -479,18 +485,21 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 ;;; File Start and Ends
 
+(defgeneric fmt-file-start (fmt s))
 (defmethod fmt-file-start ((fmt dataformat) (s stream)))
 
 (defmethod fmt-file-start ((fmt textformat) (s stream))
   (aif (file-start-str fmt)
       (format s it)))
 
+(defgeneric fmt-file-end (fmt s))
 (defmethod fmt-file-end ((fmt textformat) (s stream))
   (aif (file-end-str fmt)
          (format s it)))
 
 ;;; List Start and Ends
 
+(defgeneric fmt-list-start (obj fmt s &optional indent num-items))
 (defmethod fmt-list-start (x (fmt textformat) (s stream) &optional (indent 0) (num-items 1))
   (if (list-start-indent fmt)
       (indent-spaces indent s))
@@ -499,6 +508,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
                 (multiple-value-list
                  (funcall (list-start-value-func fmt) x num-items)))))
 
+(defgeneric fmt-list-end (obj fmt s &optional indent num-items))
 (defmethod fmt-list-end (x (fmt textformat) (s stream) &optional (indent 0) (num-items 1))
   (declare (ignore num-items))
   (if (list-end-indent fmt)
@@ -510,6 +520,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 ;;; Object Start and Ends
 
+(defgeneric fmt-obj-start (obj fmt s &optional indent))
 (defmethod fmt-obj-start (x (fmt textformat) (s stream) &optional (indent 0))
   (if (obj-start-indent fmt)
       (indent-spaces indent s))
@@ -518,6 +529,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
                 (multiple-value-list
                  (funcall (obj-start-value-func fmt) x)))))
 
+(defgeneric fmt-obj-end (obj fmt s &optional indent))
 (defmethod fmt-obj-end (x (fmt textformat) (s stream) &optional (indent 0))
   (if (obj-end-indent fmt)
       (indent-spaces indent s))
@@ -528,6 +540,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
   
 ;;; Object Data 
 
+(defgeneric make-link-start (obj ref fieldname fieldfunc fieldvalue refvars))
 (defmethod make-link-start (obj (ref link-ref) fieldname fieldfunc fieldvalue refvars)
   (declare (ignore obj fieldname))
   (format nil "~a\"~a?func=~a~akey=~a~a\"" 
@@ -541,11 +554,13 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
                varstr)
            "")))
 
+(defgeneric make-link-end (obj ref fieldname)) 
 (defmethod make-link-end (obj (ref link-ref) fieldname)
   (declare (ignore obj fieldname))
   (format nil "~a" (href-end ref))
   )
 
+(defgeneric fmt-obj-data (obj fmt s &optional indent label refvars))
 (defmethod fmt-obj-data (x (fmt textformat) s
                         &optional (indent 0) (label nil) (refvars nil))
   (if (obj-data-indent fmt)
@@ -556,6 +571,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
   (aif (obj-data-end-fmtstr fmt)
        (format s it)))
 
+(defgeneric fmt-obj-data-plain (obj fmt s label))
 (defmethod fmt-obj-data-plain (x (fmt textformat) s label)
   (if label
       (apply #'format s
@@ -566,6 +582,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
           (multiple-value-list
            (funcall (funcall (obj-data-value-func fmt) x) x)))))
 
+(defgeneric fmt-obj-data-with-ref (obj fmt s label refvars))
 (defmethod fmt-obj-data-with-ref (x (fmt textformat) s label refvars)
   (let ((refstr (make-ref-data-str x fmt label))
        (refvalues nil)
@@ -585,7 +602,8 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     (setq refvalues (nreverse refvalues))
     
     (apply #'format s refstr refvalues)))
-  
+
+(defgeneric obj-data (obj))
 (defmethod obj-data (x)
   "Returns the objects data as a string. Used by common-graphics outline function"
   (let ((fmt (make-format-instance :text)))
@@ -593,6 +611,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
           (multiple-value-list 
            (funcall (funcall (obj-data-value-func fmt) x) x)))))
 
+(defgeneric make-ref-data-str (obj fmt &optional label))
 (defmethod make-ref-data-str (x (fmt textformat) &optional (label nil))
   "Return fmt string for that contains ~a slots for reference link start and end"
   (unless (link-ref fmt)
@@ -609,6 +628,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 ;;; Display method for objects
 
 
+(defgeneric load-all-subobjects (objs))
 (defmethod load-all-subobjects (objs)
   "Load all subobjects if they have not already been loaded."
   (when objs
@@ -620,6 +640,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
               (load-all-subobjects it))))))
     objs))
 
+(defgeneric output-ml-class (objs fmt strm &optional label english-only-function indent subobjects refvars))
 (defmethod output-ml-class (objs (fmt dataformat) (strm stream) 
                            &optional (label nil) (english-only-function nil)
                                      (indent 0) (subobjects nil) (refvars nil))