r3564: *** empty log message ***
[umlisp.git] / classes.lisp
index dbb4bc1b8c91e7edc7131bff5b8f13560b99f7c4..7f88827e22e2f2d999ded65423eb53efa07c3bc1 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: classes.lisp,v 1.14 2002/11/23 22:15:13 kevin Exp $
+;;;; $Id: classes.lisp,v 1.21 2002/12/05 19:12:05 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -22,7 +22,7 @@
 (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."))
+  (:description "Parent class of all UMLS objects. It is based on the HYPEROBJECT-CLASS metaclass that provides object printing functions."))
 
 
 (defclass usrl (umlsclass)
@@ -32,7 +32,7 @@
   (:default-initargs :sab nil :srl nil)
   (:title "Source Restriction Level")
   (:print-slots sab srl)
-  (:documentation "Custom Table: Source Restriction Level"))
+  (:description "Custom Table: Source Restriction Level"))
 
   
 (defclass urank (umlsclass)
 
 (defclass udef (umlsclass)
   ((def :type cdata :initarg :def :reader def)
-   (sab :type string :initarg :sab :reader sab :reference find-usab-rsab))
+   (sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab))
   (:metaclass hyperobject-class)
   (:default-initargs :def nil :sab nil)
   (:title "Definition")
   (:print-slots sab def))
 
 (defclass usat (umlsclass)
-  ((sab :type string :initarg :sab :reader sab :reference find-usab-rsab)
+  ((sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)
    (code :type string :initarg :code :reader code)
    (atn :type string :initarg :atn :reader atn)
    (atv :type cdata :initarg :atv :reader atv))
@@ -67,7 +67,7 @@
   ((vcui :type fixnum :initarg :vcui :reader vcui :print-formatter fmt-cui)
    (rcui :type fixnum :initarg :rcui :reader rcui :print-formatter fmt-cui)
    (vsab :type string :initarg :vsab :reader vsab)
-   (rsab :type string :initarg :rsab :reader rsab :reference find-ucan-sab)
+   (rsab :type string :initarg :rsab :reader rsab :hyperlink find-ucan-sab)
    (son :type string :initarg :son :reader son)
    (sf :type string :initarg :sf :reader sf)
    (sver :type string :initarg :sver :reader sver)
@@ -78,8 +78,8 @@
    (slc :type cdata :initarg :slc :reader slc)
    (scc :type cdata :initarg :scc :reader scc)
    (srl :type fixnum :initarg :srl :reader srl)
-   (tfr :type fixnum :initarg :tfr :reader tfr :print-formatter ho:comma-integer)
-   (cfr :type fixnum :initarg :cfr :reader cfr :print-formatter ho:comma-integer)
+   (tfr :type fixnum :initarg :tfr :reader tfr :print-formatter fmt-comma-integer)
+   (cfr :type fixnum :initarg :cfr :reader cfr :print-formatter fmt-comma-integer)
    (cxty :type string :initarg :cxty :reader cxty)
    (ttyl :type string :initarg :ttyl :reader ttyl)
    (atnl :type string :initarg :atnl :reader atnl)
                     :ttyl nil :atnl nil :lat nil :cenc nil :curver nil
                     :sabin nil)
   (:title "Source Abbreviation")
-  (:print-slots vcui rcui vsab rsab san sf sver mstart mend imeta
-               rmeta slc scc srl tfr csr cxty ttyl atnl lat cenc
+  (:print-slots vcui rcui vsab rsab son sf sver mstart mend imeta
+               rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc
                curver sabin))
 
 (defclass uso (umlsclass)
-  ((sab :type string :initarg :sab :reader sab :reference find-usab-rsab)
+  ((sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)
    (code :type string :initarg :code :reader code)
-   (tty :type string :initarg :tty :reader tty :reference find-btty-tty)
+   (tty :type string :initarg :tty :reader tty :hyperlink find-btty-tty)
    (srl :type fixnum :initarg :srl :reader srl))
   (:metaclass hyperobject-class)
   (:default-initargs :sab nil :code nil :tty nil :srl nil)
   (:print-slots sab code tty srl))
 
 (defclass ucxt (umlsclass)
-  ((sab :type string :initarg :sab :reader sab :reference find-usab-rsab)
+  ((sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)
    (code :type string :initarg :code :reader code)
    (rnk :type fixnum :initarg :rnk :reader rnk)
    (cxn :type fixnum :initarg :cxn :reader cxn)
    (cxl :type string :initarg :cxl :reader cxl)
    (cxs :type cdata :initarg :cxs :reader cxs)
-   (cui2 :type fixnum :initarg :cui2 :reader cui2 :reference find-ucon-cui
+   (cui2 :type fixnum :initarg :cui2 :reader cui2 :hyperlink find-ucon-cui
         :print-formatter fmt-cui)
    (hcd :type string :initarg :hcd :reader hcd)
    (rela :type string :initarg :rela :reader rela)
   (:default-initargs :sab nil :code nil :rnk nil :cxn nil :cxl nil :cxs nil
                     :cui2 nil :hcd nil :rela nil :xc nil)
   (:title "Context")
-  (:print-slots sab code rnk cnx cxl hcd rela xc cui2 cxs))
+  (:print-slots sab code rnk cxn cxl hcd rela xc cui2 cxs))
 
 (defclass ustr (umlsclass)
   ((sui :type fixnum :initarg :sui :reader sui :print-formatter fmt-sui
-       :reference find-ustr-sui)
-   (cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui)
+       :hyperlink find-ustr-sui)
+   (cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui
+       :hyperlink find-ucon-cui)
    (lui :type fixnum :initarg :lui :reader lui :print-formatter fmt-lui
-       :reference find-uterm-lui)
+       :hyperlink find-uterm-lui)
    (cuisui :type integer :initarg :cuisui :reader cuisui )
    (str :type cdata :initarg :str :reader str)
    (lrl :type fixnum :initarg :lrl :reader lrl)
   (:metaclass hyperobject-class)
   (:default-initargs :isn nil :fr nil :un nil :sui nil :sna nil :soui nil)
   (:title "Locator")
-  (:print-slots isn fr un sna soui sui suistr))
+  (:print-slots isn fr un sna soui sui))
 
 (defclass uterm (umlsclass)
-  ((lui :type fixnum :initarg :lui :reader lui :reference find-uterm-lui)
-   (cui :type fixnum :initarg :cui :reader cui)
+  ((lui :type fixnum :initarg :lui :reader lui :print-formatter fmt-lui
+       :hyperlink find-uterm-lui)
+   (cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui
+       :hyperlink find-ucon-cui)
    (lat :type string :initarg :lat :reader lat)
    (ts :type string  :initarg :ts :reader ts)
    (lrl :type fixnum :initarg :lrl :reader lrl)
 
 (defclass usty (umlsclass)
   ((tui :type fixnum :initarg :tui :reader tui :print-formatter fmt-tui
-       :reference (find-ucon-tui ("subobjects" "no")))
+       :hyperlink (find-ucon-tui ("subobjects" "no")))
    (sty :type string :initarg :sty :reader sty))
   (:metaclass hyperobject-class)
   (:default-initargs :tui nil :sty nil)
   (:print-slots tui sty))
 
 (defclass urel (umlsclass)
-  ((rel :type string :initarg :rel :reader rel :reference find-brel-rel)
+  ((rel :type string :initarg :rel :reader rel :hyperlink find-brel-rel)
    (cui1 :type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui)
-   (cui2 :type fixnum :initarg :cui2 :reader cui2 :reference find-ucon-sui
+   (cui2 :type fixnum :initarg :cui2 :reader cui2 :hyperlink find-ucon-sui
         :print-formatter fmt-cui)
    (pfstr2 :type cdata :initarg :pfstr2 :reader pfstr2)
    (rela :type string :initarg :rela :reader rela)
-   (sab :type string :initarg :sab :reader sab :reference find-usab-rsab)
+   (sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)
    (sl :type string  :initarg :sl :reader sl)
    (mg :type string  :initarg :mg :reader mg))
   (:metaclass hyperobject-class)
 (defclass ucoc (umlsclass)
   ((cui1 :type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui)
    (cui2 :type fixnum :initarg :cui2 :reader cui2 :print-formatter fmt-cui
-        :reference find-ucon-cui)
+        :hyperlink find-ucon-cui)
    (pfstr2 :type cdata :initarg :pfstr2 :reader pfstr2)
    (soc :type string :initarg :soc :reader soc)
    (cot :type string :initarg :cot :reader cot)
 
 (defclass ucon (umlsclass)
   ((cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui
-       :reference find-ucon-cui)
+       :hyperlink find-ucon-cui)
    (pfstr :type cdata :initarg :pfstr :reader pfstr)
    (lrl :type fixnum :initarg :lrl :reader lrl)
    (s#term :reader s#term :subobject t)
 
 (defclass lexterm (umlsclass)
   ((eui :type fixnum :initarg :eui :reader eui :print-formatter fmt-eui
-       :reference find-lexterm-eui)
+       :hyperlink find-lexterm-eui)
    (wrd :type string :initarg :wrd :reader wrd)
    (s#abr :reader s#abr :subobject t)
    (s#agr :reader s#agr :subobject t)
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :abr nil :eui2 nil :bas2 nil)
   (:title "Abbreviations and Acronyms")
-  (:print-slots eui bas absr eui2 bas3))
+  (:print-slots eui bas abr eui2 bas2))
 
 (defclass lagr  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :sca nil :com nil)
   (:title "Complementation")
-  (:print-slots eui bas sca cam))
+  (:print-slots eui bas sca com))
 
 (defclass lmod  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :sca nil :psnmod nil :fea nil)
   (:title "Modifiers")
-  (:print-slots eui bas scan psnmod fea))
+  (:print-slots eui bas sca psnmod fea))
 
 (defclass lnom  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :sca nil :eui2 nil :bas2 nil :sca2 nil)
   (:title "Nominalizations")
-  (:print-slots eui bas eui2 bas2 sca2))
+  (:print-slots eui bas sca eui2 bas2 sca2))
 
 (defclass lprn  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
   (:metaclass hyperobject-class)
   (:default-initargs :styrl nil :rl nil :styrl2 nil :ls nil)
   (:title "Structure of the Network")
-  (:print-slots styrl rl styl2 ls))
+  (:print-slots styrl rl styrl2 ls))
 
 (defclass sstre1 (umlsclass)
   ((ui :type integer :initarg :ui :reader ui :print-formatter fmt-tui)
 (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 (hyperobject::portable-class-name (hyperobject::portable-class-of obj)) 'uterm)
+  (if (eq (hyperobject::class-name (hyperobject::class-of obj)) 'uterm)
       (values (string-equal (lat obj) "ENG") t)
     (values nil nil))))
 
 
-(defgeneric print-umlsclass (obj &key os format label file-wrapper english-only subobjects refvars)
-  )
-
-(defmethod print-umlsclass ((obj umlsclass) &key (os *standard-output*) (format :text)
+(defun print-umlsclass (obj &key (os *standard-output*) (format :text)
                              (label nil) (file-wrapper t) (english-only nil) (subobjects nil)
                              (refvars nil))
-  (print-hyperobject obj :os os :format format :label label :subobjects subobjects
-                    :file-wrapper file-wrapper
-                    :english-only-function (if english-only #'english-term-p nil)
-                    :refvars refvars))
+  (view obj :os os :format format :label label :subobjects subobjects
+       :file-wrapper file-wrapper
+       :english-only-function (if english-only #'english-term-p nil)
+       :refvars refvars))
 
 
 (defmacro define-lookup-display (newfuncname lookup-func)