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