r3368: *** empty log message ***

[umlisp.git] / classes.lisp

diff --git a/classes.lisp b/classes.lisp
index b82410b78fef2f7365285651d6cf4bdb79bbdb06..aaa932ab7535589673fb99b12fa66c1edece8841 100644 (file)
--- a/classes.lisp
+++ b/classes.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: classes.lisp,v 1.9 2002/11/04 18:02:13 kevin Exp $
+;;;; $Id: classes.lisp,v 1.11 2002/11/10 22:39:15 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -19,21 +19,12 @@
 (in-package :umlisp)
 (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
 
-(defclass umlsclass ()
+(defclass umlsclass (hyperobject)
   ()
   (:metaclass hyperobject-class)
   (:documentation "Parent class of all UMLS objects. It is based on the HYPEROBJECT-CLASS metaclass that provides object printing functions."))
 
 
-(defmethod print-object ((obj umlsclass) (s stream))
-  (print-unreadable-object (obj s :type t :identity t)
-    (let ((fmt (make-instance 'kmrcl::textformat)))
-      (apply #'format 
-            s (funcall (kmrcl::obj-data-fmtstr fmt) obj)
-            (multiple-value-list 
-             (funcall (funcall (kmrcl::obj-data-value-func fmt) obj) obj))))))
-
-
 (defclass usrl (umlsclass)
   ((sab :type string :initarg :sab :reader sab)
    (srl :type integer :initarg :srl :reader srl))
@@ -74,6 +65,46 @@
   (:ref-fields (sab find-bsab-sab))
   (:fields (sab :string) (code :string) (atn :string) (atv :cdata)))
 
+(defclass usab (umlsclass)
+  ((vcui :type fixnum :initarg :vcui :reader vcui)
+   (rcui :type fixnum :initarg :rcui :reader rcui)
+   (vsab :type string :initarg :vsab :reader vsab)
+   (rsab :type string :initarg :rsab :reader rsab)
+   (son :type string :initarg :son :reader son)
+   (sf :type string :initarg :sf :reader sf)
+   (sver :type string :initarg :sver :reader sver)
+   (mstart :type string :initarg :mstart :reader mstart)
+   (mend :type string :initarg :mend :reader mend)
+   (imeta :type string :initarg :imeta :reader imeta)
+   (rmeta :type string :initarg :rmeta :reader rmeta)
+   (slc :type string :initarg :slc :reader slc)
+   (scc :type string :initarg :scc :reader scc)
+   (srl :type fixnum :initarg :srl :reader srl)
+   (tfr :type fixnum :initarg :tfr :reader tfr)
+   (cfr :type fixnum :initarg :cfr :reader cfr)
+   (cxty :type string :initarg :cxty :reader cxty)
+   (ttyl :type string :initarg :ttyl :reader ttyl)
+   (atnl :type string :initarg :atnl :reader atnl)
+   (lat :type string :initarg :lat :reader lat)
+   (cenc :type string :initarg :cenc :reader cenc)
+   (curver :type string :initarg :curver :reader curver)
+   (sabin :type string :initarg :sabin :reader sabin))
+  (:metaclass hyperobject-class)
+  (:default-initargs :vcui nil :rcui nil :vsab nil :rsab nil :son nil :sf nil
+                    :sver nil :mstart nil :mend nil :imeta nil :rmeta nil
+                    :slc nil :scc nil :srl nil :tfr nil :cfr nil :cxty nil
+                    :ttyl nil :atnl nil :lat nil :cenc nil :curver nil
+                    :sabin nil)
+  (:title "Source Abbreviation")
+  (:ref-fields (rsab find-ucon-sab))
+  (:fields (vcui :string fmt-cui) (rcui :string fmt-cui)
+          (vsab :string) (rsab :string) (son :cdata) (sf :string)
+          (sver :string) (mstart :string) (mend :string) (imeta :string)
+          (rmeta :string) (slc :cdata) (scc :cdata) (srl :fixnum)
+          (tfr :commainteger) (cfr :commainteger) (cxty :string)
+          (ttyl :string) (atnl :string) (lat :string) (cenc :string)
+          (curver :string) (sabin :string)))
+
 (defclass uso (umlsclass)
   ((sab :type string :initarg :sab :reader sab)
    (code :type string :initarg :code :reader code)
@@ -526,7 +557,7 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defun english-term-p (obj)
   "Returns two values: T/NIL if term is english and T/NIL if obj is a TERM"
-  (if (eq (kmrcl::hyperobject-class-name (kmrcl::hyperobject-class-of obj)) 'uterm)
+  (if (eq (hyperobject::portable-class-name (hyperobject::portable-class-of obj)) 'uterm)
       (values (string-equal (lat obj) "ENG") t)
     (values nil nil))))