classes.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          classes.lisp
   6 ;;;; Purpose:       Class defintions for UMLisp
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2000
   9 ;;;;
  10 ;;;; $Id: classes.lisp,v 1.24 2002/12/13 07:34:20 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of UMLisp, is
  13 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
  14 ;;;;
  15 ;;;; UMLisp users are granted the rights to distribute and use this software
  16 ;;;; as governed by the terms of the GNU General Public License.
  17 ;;;; *************************************************************************
  18
  19 (in-package :umlisp)
  20 (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
  21
  22 (defclass umlsclass (hyperobject)
  23   ()
  24   (:metaclass hyperobject-class)
  25   (:description "Parent class of all UMLS objects. It is based on the HYPEROBJECT-CLASS metaclass that provides object printing functions."))
  26
  27
  28 (defclass usrl (umlsclass)
  29   ((sab :type string :initarg :sab :reader sab)
  30    (srl :type fixnum :initarg :srl :reader srl))
  31   (:metaclass hyperobject-class)
  32   (:default-initargs :sab nil :srl nil)
  33   (:user-name "Source Restriction Level")
  34   (:default-print-slots sab srl)
  35   (:description "Custom Table: Source Restriction Level"))
  36
  37
  38 (defclass urank (umlsclass)
  39   ((rank :type fixnum :initarg :rank :reader rank)
  40    (sab :type string :initarg :sab :reader sab)
  41    (tty :type string :initarg :tty :reader tty)
  42    (supres :type string :initarg :supres :reader supres))
  43   (:metaclass hyperobject-class)
  44   (:default-initargs :rank nil :sab nil :tty nil :supres nil)
  45   (:user-name "Rank")
  46   (:default-print-slots rank sab tty supres))
  47
  48 (defclass udef (umlsclass)
  49   ((def :type cdata :initarg :def :reader def)
  50    (sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab))
  51   (:metaclass hyperobject-class)
  52   (:default-initargs :def nil :sab nil)
  53   (:user-name "Definition")
  54   (:default-print-slots sab def))
  55
  56 (defclass usat (umlsclass)
  57   ((sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)
  58    (code :type string :initarg :code :reader code)
  59    (atn :type string :initarg :atn :reader atn)
  60    (atv :type cdata :initarg :atv :reader atv))
  61   (:metaclass hyperobject-class)
  62   (:default-initargs :sab nil :code nil :atn nil :atv nil)
  63   (:user-name "Simple Attribute")
  64   (:default-print-slots sab code atn atv))
  65
  66 (defclass usab (umlsclass)
  67   ((vcui :type fixnum :initarg :vcui :reader vcui :print-formatter fmt-cui)
  68    (rcui :type fixnum :initarg :rcui :reader rcui :print-formatter fmt-cui)
  69    (vsab :type string :initarg :vsab :reader vsab)
  70    (rsab :type string :initarg :rsab :reader rsab :hyperlink find-ucan-sab)
  71    (son :type string :initarg :son :reader son)
  72    (sf :type string :initarg :sf :reader sf)
  73    (sver :type string :initarg :sver :reader sver)
  74    (mstart :type string :initarg :mstart :reader mstart)
  75    (mend :type string :initarg :mend :reader mend)
  76    (imeta :type string :initarg :imeta :reader imeta)
  77    (rmeta :type string :initarg :rmeta :reader rmeta)
  78    (slc :type cdata :initarg :slc :reader slc)
  79    (scc :type cdata :initarg :scc :reader scc)
  80    (srl :type fixnum :initarg :srl :reader srl)
  81    (tfr :type fixnum :initarg :tfr :reader tfr :print-formatter fmt-comma-integer)
  82    (cfr :type fixnum :initarg :cfr :reader cfr :print-formatter fmt-comma-integer)
  83    (cxty :type string :initarg :cxty :reader cxty)
  84    (ttyl :type string :initarg :ttyl :reader ttyl)
  85    (atnl :type string :initarg :atnl :reader atnl)
  86    (lat :type string :initarg :lat :reader lat)
  87    (cenc :type string :initarg :cenc :reader cenc)
  88    (curver :type string :initarg :curver :reader curver)
  89    (sabin :type string :initarg :sabin :reader sabin))
  90   (:metaclass hyperobject-class)
  91   (:default-initargs :vcui nil :rcui nil :vsab nil :rsab nil :son nil :sf nil
  92                      :sver nil :mstart nil :mend nil :imeta nil :rmeta nil
  93                      :slc nil :scc nil :srl nil :tfr nil :cfr nil :cxty nil
  94                      :ttyl nil :atnl nil :lat nil :cenc nil :curver nil
  95                      :sabin nil)
  96   (:user-name "Source Abbreviation")
  97   (:default-print-slots vcui rcui vsab rsab son sf sver mstart mend imeta
  98                 rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc
  99                 curver sabin))
 100
 101 (defclass uso (umlsclass)
 102   ((sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)
 103    (code :type string :initarg :code :reader code)
 104    (tty :type string :initarg :tty :reader tty :hyperlink find-btty-tty)
 105    (srl :type fixnum :initarg :srl :reader srl))
 106   (:metaclass hyperobject-class)
 107   (:default-initargs :sab nil :code nil :tty nil :srl nil)
 108   (:user-name "Source")
 109   (:default-print-slots sab code tty srl))
 110
 111 (defclass ucxt (umlsclass)
 112   ((sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)
 113    (code :type string :initarg :code :reader code)
 114    (rnk :type fixnum :initarg :rnk :reader rnk)
 115    (cxn :type fixnum :initarg :cxn :reader cxn)
 116    (cxl :type string :initarg :cxl :reader cxl)
 117    (cxs :type cdata :initarg :cxs :reader cxs)
 118    (cui2 :type fixnum :initarg :cui2 :reader cui2 :hyperlink find-ucon-cui
 119          :print-formatter fmt-cui)
 120    (hcd :type string :initarg :hcd :reader hcd)
 121    (rela :type string :initarg :rela :reader rela)
 122    (xc :type string  :initarg :xc :reader xc))
 123   (:metaclass hyperobject-class)
 124   (:default-initargs :sab nil :code nil :rnk nil :cxn nil :cxl nil :cxs nil
 125                      :cui2 nil :hcd nil :rela nil :xc nil)
 126   (:user-name "Context")
 127   (:default-print-slots sab code rnk cxn cxl hcd rela xc cui2 cxs))
 128
 129 (defclass ustr (umlsclass)
 130   ((sui :type fixnum :initarg :sui :reader sui :print-formatter fmt-sui
 131         :hyperlink find-ustr-sui)
 132    (cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui
 133         :hyperlink find-ucon-cui)
 134    (lui :type fixnum :initarg :lui :reader lui :print-formatter fmt-lui
 135         :hyperlink find-uterm-lui)
 136    (cuisui :type integer :initarg :cuisui :reader cuisui )
 137    (str :type cdata :initarg :str :reader str)
 138    (lrl :type fixnum :initarg :lrl :reader lrl)
 139    (stt :type string :initarg :stt :reader stt)
 140    (s#sat :reader s#sat :subobject (find-usat-ui cui lui sui))
 141    (s#so :reader s#so :subobject (find-uso-cuisui cui sui))
 142    (s#cxt :reader s#cxt :subobject (find-ucxt-cuisui cui sui)))
 143   (:metaclass hyperobject-class)
 144   (:default-initargs
 145    :sui nil :cui nil :lui nil :cuisui nil :str nil :lrl nil :stt nil)
 146   (:user-name "String")
 147   (:default-print-slots sui stt lrl str))
 148
 149 (defclass ulo (umlsclass)
 150   ((isn :type string :initarg :isn :reader isn)
 151    (fr :type fixnum :initarg :fr :reader fr)
 152    (un :type string :initarg :un :reader un)
 153    (sui :type fixnum :initarg :sui :reader sui :print-formatter fmt-sui)
 154    (sna :type string :initarg :sna :reader sna)
 155    (soui :type string :initarg :soui :reader soui))
 156   (:metaclass hyperobject-class)
 157   (:default-initargs :isn nil :fr nil :un nil :sui nil :sna nil :soui nil)
 158   (:user-name "Locator")
 159   (:default-print-slots isn fr un sna soui sui))
 160
 161 (defclass uterm (umlsclass)
 162   ((lui :type fixnum :initarg :lui :reader lui :print-formatter fmt-lui
 163         :hyperlink find-uterm-lui)
 164    (cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui
 165         :hyperlink find-ucon-cui)
 166    (lat :type string :initarg :lat :reader lat)
 167    (ts :type string  :initarg :ts :reader ts)
 168    (lrl :type fixnum :initarg :lrl :reader lrl)
 169    (s#str :reader s#str :subobject (find-ustr-cuilui cui lui))
 170    (s#sat :reader s#sat :subobject (find-usat-ui cui lui)))
 171   (:metaclass hyperobject-class)
 172   (:default-initargs :lui nil :cui nil :lat nil :ts nil :lrl nil)
 173   (:user-name "Term")
 174   (:default-print-slots lui lat ts lrl))
 175
 176 (defclass usty (umlsclass)
 177   ((tui :type fixnum :initarg :tui :reader tui :print-formatter fmt-tui
 178         :hyperlink (find-ucon-tui ("subobjects" "no")))
 179    (sty :type string :initarg :sty :reader sty))
 180   (:metaclass hyperobject-class)
 181   (:default-initargs :tui nil :sty nil)
 182   (:user-name "Semantic Type")
 183   (:default-print-slots tui sty))
 184
 185 (defclass urel (umlsclass)
 186   ((rel :type string :initarg :rel :reader rel :hyperlink find-brel-rel)
 187    (cui1 :type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui)
 188    (cui2 :type fixnum :initarg :cui2 :reader cui2 :hyperlink find-ucon-sui
 189          :print-formatter fmt-cui)
 190    (pfstr2 :type cdata :initarg :pfstr2 :reader pfstr2)
 191    (rela :type string :initarg :rela :reader rela)
 192    (sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)
 193    (sl :type string  :initarg :sl :reader sl)
 194    (mg :type string  :initarg :mg :reader mg))
 195   (:metaclass hyperobject-class)
 196   (:default-initargs
 197    :rel nil :cui1 nil :cui2 nil :pfstr2 nil :rela nil :sab nil :sl nil :mg nil)
 198   (:user-name "Relationship")
 199   (:default-print-slots rel rela sab sl mg cui2 pfstr2))
 200
 201 (defclass ucoc (umlsclass)
 202   ((cui1 :type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui)
 203    (cui2 :type fixnum :initarg :cui2 :reader cui2 :print-formatter fmt-cui
 204          :hyperlink find-ucon-cui)
 205    (pfstr2 :type cdata :initarg :pfstr2 :reader pfstr2)
 206    (soc :type string :initarg :soc :reader soc)
 207    (cot :type string :initarg :cot :reader cot)
 208    (cof :type fixnum :initarg :cof :reader cof)
 209    (coa :type cdata :initarg :coa :reader coa))
 210   (:metaclass hyperobject-class)
 211   (:default-initargs
 212    :cui1 nil :cui2 nil :pfstr2 nil :soc nil :cot nil :cof nil :coa nil)
 213   (:user-name "Co-occuring Concept")
 214   (:default-print-slots soc cot cof coa cui2 pfstr2))
 215
 216
 217 (defclass uatx (umlsclass)
 218   ((sab :type string :initarg :sab :reader sab)
 219    (rel :type string :initarg :rel :reader rel)
 220    (atx :type cdata :initarg :atx :reader atx))
 221   (:metaclass hyperobject-class)
 222   (:default-initargs :sab nil :rel nil :atx nil)
 223   (:user-name "Associated Expression")
 224   (:default-print-slots sab rel atx))
 225
 226 (defclass ucon (umlsclass)
 227   ((cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui
 228         :hyperlink find-ucon-cui)
 229    (lrl :type fixnum :initarg :lrl :reader lrl)
 230    (pfstr :type cdata :initarg :pfstr :reader pfstr)
 231    (s#term :reader s#term :subobject (find-uterm-cui cui))
 232    (s#def :reader s#def :subobject (find-udef-cui cui))
 233    (s#lo :reader s#lo :subobject (find-ulo-cui cui))
 234    (s#rel :reader s#rel :subobject (find-urel-cui cui))
 235    (s#coc :reader s#coc :subobject (find-ucoc-cui cui))
 236    (s#sat :reader s#sat :subobject (find-usat-ui cui))
 237    (s#atx :reader s#atx :subobject (find-uatx-cui cui))
 238    (s#sty :reader s#sty :subobject (find-usty-cui cui)))
 239   (:metaclass hyperobject-class)
 240   (:default-initargs :cui nil :lrl nil :pfstr nil)
 241   (:user-name "Concept")
 242   (:default-print-slots cui lrl pfstr))
 243
 244 (defclass uxw (umlsclass)
 245   ((wd :type string :initarg :wd :reader wd)
 246    (cui :type fixnum :initform nil :initarg :cui :reader cui :print-formatter fmt-cui)
 247    (lui :type fixnum :initform nil :initarg :lui :reader lui :print-formatter fmt-lui)
 248    (sui :type fixnum :initform nil :initarg :sui :reader sui :print-formatter fmt-sui))
 249   (:metaclass hyperobject-class)
 250   (:default-initargs :wd nil :cui nil :lui nil :sui nil)
 251   (:user-name "XW Index")
 252   (:default-print-slots wd cui lui sui))
 253
 254 (defclass uxnw (umlsclass)
 255   ((lat :type string :initarg :lat :reader lat)
 256    (nwd :type string :initarg :nwd :reader nwd)
 257    (cuilist :type list :initarg :cuilist :reader uxnw-cuilist))
 258   (:metaclass hyperobject-class)
 259   (:default-initargs :lat nil :nwd nil :cuilist nil)
 260   (:user-name "XNW Index")
 261   (:default-print-slots lat nwd cuilist))
 262
 263 (defclass uxns (umlsclass)
 264   ((lat :type string :initarg :lat :reader lat)
 265    (nstr :type string :initarg :nstr :reader nstr)
 266    (cuilist :type list :initarg :cuilist :reader cuilist))
 267   (:metaclass hyperobject-class)
 268   (:default-initargs :lat nil :nstr nil :cuilist nil)
 269   (:user-name "XNS Index")
 270   (:default-print-slots lat nstr cuilist))
 271
 272
 273 ;;; LEX objects
 274
 275 (defclass lexterm (umlsclass)
 276   ((eui :type fixnum :initarg :eui :reader eui :print-formatter fmt-eui
 277         :hyperlink find-lexterm-eui)
 278    (wrd :type string :initarg :wrd :reader wrd)
 279    (s#abr :reader s#abr :subobject (find-labr-eui eui))
 280    (s#agr :reader s#agr :subobject (find-lagr-eui eui))
 281    (s#cmp :reader s#cmp :subobject (find-lcmp-eui eui))
 282    (s#mod :reader s#mod :subobject (find-lmod-eui eui))
 283    (s#nom :reader s#nom :subobject (find-lnom-eui eui))
 284    (s#prn :reader s#prn :subobject (find-lprn-eui eui))
 285    (s#prp :reader s#prp :subobject (find-lprp-eui eui))
 286    (s#spl :reader s#spl :subobject (find-lspl-eui eui))
 287    (s#trm :reader s#trm :subobject (find-ltrm-eui eui))
 288    (s#typ :reader s#typ :subobject (find-ltyp-eui eui)))
 289   (:metaclass hyperobject-class)
 290   (:default-initargs :eui nil :wrd nil)
 291   (:user-name "Lexical Term")
 292   (:default-print-slots eui wrd))
 293
 294
 295 (defclass labr  (umlsclass)
 296   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
 297    (bas :type string :initarg :bas :reader bas)
 298    (abr :type string :initarg :abr :reader abr)
 299    (eui2 :type integer :initarg :eui2 :reader eui2 :print-formatter fmt-eui)
 300    (bas2 :type string :initarg :bas2 :reader bas2))
 301   (:metaclass hyperobject-class)
 302   (:default-initargs :eui nil :bas nil :abr nil :eui2 nil :bas2 nil)
 303   (:user-name "Abbreviations and Acronyms")
 304   (:default-print-slots eui bas abr eui2 bas2))
 305
 306 (defclass lagr  (umlsclass)
 307   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
 308    (str :type string :initarg :str :reader str)
 309    (sca :type string :initarg :sca :reader sca)
 310    (agr :type string :initarg :agr :reader agr)
 311    (cit :type string :initarg :cit :reader cit)
 312    (bas :type string :initarg :bas :reader bas))
 313   (:metaclass hyperobject-class)
 314   (:default-initargs :eui nil :str nil :sca nil :agr nil :cit nil :bas nil)
 315   (:user-name "Agreement and Inflection")
 316   (:default-print-slots eui str sca agr cit bas))
 317
 318 (defclass lcmp  (umlsclass)
 319   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
 320    (bas :type string :initarg :bas :reader bas)
 321    (sca :type string :initarg :sca :reader sca)
 322    (com :type string :initarg :com :reader com))
 323   (:metaclass hyperobject-class)
 324   (:default-initargs :eui nil :bas nil :sca nil :com nil)
 325   (:user-name "Complementation")
 326   (:default-print-slots eui bas sca com))
 327
 328 (defclass lmod  (umlsclass)
 329   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
 330    (bas :type string :initarg :bas :reader bas)
 331    (sca :type string :initarg :sca :reader sca)
 332    (psnmod :type string :initarg :psnmod :reader psnmod)
 333    (fea :type string :initarg :fea :reader fea))
 334   (:metaclass hyperobject-class)
 335   (:default-initargs :eui nil :bas nil :sca nil :psnmod nil :fea nil)
 336   (:user-name "Modifiers")
 337   (:default-print-slots eui bas sca psnmod fea))
 338
 339 (defclass lnom  (umlsclass)
 340   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
 341    (bas :type string :initarg :bas :reader bas)
 342    (sca :type string :initarg :sca :reader sca)
 343    (eui2 :type integer :initarg :eui2 :reader eui2 :print-formatter fmt-eui)
 344    (bas2 :type string :initarg :bas2 :reader bas2)
 345    (sca2 :type string :initarg :sca2 :reader sca2))
 346   (:metaclass hyperobject-class)
 347   (:default-initargs :eui nil :bas nil :sca nil :eui2 nil :bas2 nil :sca2 nil)
 348   (:user-name "Nominalizations")
 349   (:default-print-slots eui bas sca eui2 bas2 sca2))
 350
 351 (defclass lprn  (umlsclass)
 352   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
 353    (bas :type string :initarg :bas :reader bas)
 354    (num :type string :initarg :num :reader num)
 355    (gnd :type string :initarg :gnd :reader gnd)
 356    (cas :type string :initarg :cas :reader cas)
 357    (pos :type string :initarg :pos :reader pos)
 358    (qnt :type string :initarg :qnt :reader qnt)
 359    (fea :type string :initarg :fea :reader fea))
 360   (:metaclass hyperobject-class)
 361   (:default-initargs :eui nil :bas nil :num nil :gnd nil :cas nil
 362                      :pos nil :qnt nil :fea nil)
 363   (:user-name "Pronouns")
 364   (:default-print-slots eui bas num gnd cas pos qnt fea))
 365
 366 (defclass lprp  (umlsclass)
 367   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
 368    (bas :type string :initarg :bas :reader bas)
 369    (str :type string :initarg :str :reader str)
 370    (sca :type string :initarg :sca :reader sca)
 371    (fea :type string :initarg :fea :reader fea))
 372   (:metaclass hyperobject-class)
 373   (:default-initargs :eui nil :bas nil :str nil :sca nil :fea nil)
 374   (:user-name "Properties")
 375   (:default-print-slots eui bas str sca fea))
 376
 377
 378 (defclass lspl  (umlsclass)
 379   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
 380    (spv :type string :initarg :spv :reader spv)
 381    (bas :type string :initarg :bas :reader bas))
 382   (:metaclass hyperobject-class)
 383   (:default-initargs :eui nil :spv nil :bas nil)
 384   (:user-name "Spelling Variants")
 385   (:default-print-slots eui spv bas))
 386
 387
 388 (defclass ltrm  (umlsclass)
 389   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
 390    (bas :type string :initarg :bas :reader bas)
 391    (gen :type string :initarg :gen :reader gen))
 392   (:metaclass hyperobject-class)
 393   (:default-initargs :eui nil :bas nil :gen nil)
 394   (:user-name "Trade Marks")
 395   (:default-print-slots eui bas gen))
 396
 397 (defclass ltyp  (umlsclass)
 398   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
 399    (bas :type string :initarg :bas :reader bas)
 400    (sca :type string :initarg :sca :reader sca)
 401    (typ :type string :initarg :typ :reader typ))
 402   (:metaclass hyperobject-class)
 403   (:default-initargs :eui nil :bas nil :sca nil :typ nil)
 404   (:user-name "Inflection Type")
 405   (:default-print-slots eui bas sca typ))
 406
 407 (defclass lwd (umlsclass)
 408   ((wrd :type string :initarg :wrd :reader wrd)
 409    (euilist :type list :initarg :euilist :reader euilist))
 410   (:metaclass hyperobject-class)
 411   (:default-initargs :wrd nil :euilist nil)
 412   (:user-name "Lexical Word Index")
 413   (:default-print-slots wrd euilist))
 414
 415 ;;; Semantic NET objects
 416
 417 (defclass sdef (umlsclass)
 418   ((rt :type string :initarg :rt :reader rt)
 419    (ui :type integer :initarg :ui :reader ui :print-formatter fmt-tui)
 420    (styrl :type string :initarg :styrl :reader styrl)
 421    (stnrtn :type string :initarg :stnrtn :reader stnrtn)
 422    (def :type string :initarg :def :reader def)
 423    (ex :type string :initarg :ex :reader ex)
 424    (un :type string :initarg :un :reader un)
 425    (rh :type string :initarg :rh :reader rh)
 426    (abr :type string :initarg :abr :reader abr)
 427    (rin :type string :initarg :rin :reader rin))
 428   (:metaclass hyperobject-class)
 429   (:default-initargs
 430    :rt nil :ui nil :styrl nil :stnrtn nil :def nil :ex nil :un nil :rh nil
 431    :abr nil :rin nil)
 432   (:user-name "Basic information about Semantic Types and Relations")
 433   (:default-print-slots rt ui styrl stnrtn def ex un rh abr rin))
 434
 435 (defclass sstr (umlsclass)
 436   ((styrl :type string :initarg :styrl :reader styrl)
 437    (rl :type string :initarg :rl :reader rl)
 438    (styrl2 :type string :initarg :styrl2 :reader styrl2)
 439    (ls :type string :initarg :ls :reader ls))
 440   (:metaclass hyperobject-class)
 441   (:default-initargs :styrl nil :rl nil :styrl2 nil :ls nil)
 442   (:user-name "Structure of the Network")
 443   (:default-print-slots styrl rl styrl2 ls))
 444
 445 (defclass sstre1 (umlsclass)
 446   ((ui :type integer :initarg :ui :reader ui :print-formatter fmt-tui)
 447    (ui2 :type integer :initarg :ui2 :reader ui2 :print-formatter fmt-tui)
 448    (ui3 :type integer :initarg :ui3 :reader ui3 :print-formatter fmt-tui))
 449   (:metaclass hyperobject-class)
 450   (:default-initargs :ui nil :ui2 nil :ui3 nil)
 451   (:user-name "Fully Inherited Set of Releatons (TUI's)")
 452   (:default-print-slots ui ui2 ui3))
 453
 454 (defclass sstre2 (umlsclass)
 455   ((sty :type string :initarg :ui :reader sty)
 456    (rl :type string :initarg :ui2 :reader rl)
 457    (sty2 :type string :initarg :ui3 :reader sty2))
 458   (:metaclass hyperobject-class)
 459   (:default-initargs :sty nil :rl nil :sty2 nil)
 460   (:user-name "Fully Inherited Set of Releatons (strings)")
 461   (:default-print-slots sty rl sty2))
 462
 463 ;;; Formatting routines
 464
 465 (defgeneric fmt-cui (c))
 466 (defmethod fmt-cui ((c ucon))
 467   (format nil "C~7,'0d" (cui c)))
 468
 469 (defmethod fmt-cui ((c fixnum))
 470   (format nil "C~7,'0d" c))
 471
 472 (defmethod fmt-cui ((c string))
 473   (if (eql (aref c 0) #\C)
 474       c
 475     (format nil "C~7,'0d" (parse-integer c))))
 476
 477 (defmethod fmt-cui ((c null))
 478   (format nil "nil"))
 479
 480 (defgeneric fmt-lui (c))
 481 (defmethod fmt-lui ((l uterm))
 482   (format nil "L~7,'0d" (lui l)))
 483
 484 (defmethod fmt-lui ((l fixnum))
 485   (format nil "L~7,'0d" l))
 486
 487 (defmethod fmt-lui ((l string))
 488   (if (eql (aref l 0) #\L)
 489       l
 490   (format nil "L~7,'0d" (parse-integer l))))
 491
 492 (defgeneric fmt-sui (s))
 493 (defmethod fmt-sui ((s ustr))
 494   (format nil "S~7,'0d" (sui s)))
 495
 496 (defmethod fmt-sui ((s fixnum))
 497   (format nil "S~7,'0d" s))
 498
 499 (defmethod fmt-sui ((s string))
 500   (if (eql (aref s 0) #\S)
 501       s
 502   (format nil "S~7,'0d" (parse-integer s))))
 503
 504 (defgeneric fmt-tui (t))
 505 (defmethod fmt-tui ((s fixnum))
 506   (format nil "T~3,'0d" s))
 507
 508 (defmethod fmt-tui ((s string))
 509   (if (eql (aref s 0) #\T)
 510       s
 511   (format nil "T~3,'0d" (parse-integer s))))
 512
 513 (defgeneric fmt-eui (e))
 514 (defmethod fmt-eui ((e fixnum))
 515   (format nil "E~7,'0d" e))
 516
 517 (defmethod fmt-eui ((e string))
 518   (if (eql (aref e 0) #\E)
 519       e
 520     (format nil "E~7,'0d" (parse-integer e))))
 521
 522 (defmethod fmt-eui ((e null))
 523   (format nil "nil"))
 524
 525 ;;; Generic display functions
 526
 527 (eval-when (:compile-toplevel :load-toplevel :execute)
 528 (defun english-term-p (obj)
 529   "Returns two values: T/NIL if term is english and T/NIL if obj is a TERM"
 530   (if (eq (hyperobject::class-name (hyperobject::class-of obj)) 'uterm)
 531       (values (string-equal (lat obj) "ENG") t)
 532     (values nil nil))))
 533
 534 (defun english-term-filter (obj)
 535   "Retrns NIL if object is a term and not english"
 536   (multiple-value-bind (is-english is-term) (english-term-p obj)
 537       (or (not is-term) is-english)))
 538
 539 (defun print-umlsclass (obj &key (os *standard-output*) (category :compact-text)
 540                         (file-wrapper t) (english-only nil) (subobjects nil)
 541                         (refvars nil))
 542   (view obj :stream os :category category :subobjects subobjects
 543         :file-wrapper file-wrapper
 544         :filter (if english-only nil #'english-term-filter)
 545         :refvars refvars))
 546
 547 (defmacro define-lookup-display (newfuncname lookup-func)
 548   "Defines functions for looking up and displaying objects"
 549   `(defun ,newfuncname  (keyval &key (stream *standard-output*) (category :compact-text)
 550                          (file-wrapper t) (english-only nil) (subobjects nil))
 551      (let ((obj (funcall ,lookup-func keyval)))
 552        (print-umlsclass obj :stream stream :category category
 553                         :file-wrapper file-wrapper :english-only english-only
 554                         :subobjects subobjects)
 555        obj)))
 556
 557 (define-lookup-display display-con #'find-ucon-cui)
 558 (define-lookup-display display-term #'find-uterm-lui)
 559 (define-lookup-display display-str #'find-ustr-sui)
 560
 561 #+(or scl cmu)
 562 (dolist (c '(urank udef usat uso ucxt ustr ulo uterm usty urel ucoc uatx ucon uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl))
 563     #+cmu
 564     (let ((cl (pcl:find-class c)))
 565       (pcl:finalize-inheritance cl))
 566     #+scl
 567     (let ((cl (find-class c)))
 568       (clos:finalize-inheritance cl)))