X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=classes.lisp;h=0ae8ad0d2a42a6770154c266d6f8eb2b747c2439;hb=baef3e3eba503d04fe6d19ac3087bf9d3dbc37b9;hp=dbb4bc1b8c91e7edc7131bff5b8f13560b99f7c4;hpb=d17db83f9f6dc74ea41cc960770dcbfafa3fef30;p=umlisp.git diff --git a/classes.lisp b/classes.lisp index dbb4bc1..0ae8ad0 100644 --- a/classes.lisp +++ b/classes.lisp @@ -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.22 2002/12/09 14:11:09 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) @@ -30,9 +30,9 @@ (srl :type fixnum :initarg :srl :reader srl)) (:metaclass hyperobject-class) (:default-initargs :sab nil :srl nil) - (:title "Source Restriction Level") + (:user-name "Source Restriction Level") (:print-slots sab srl) - (:documentation "Custom Table: Source Restriction Level")) + (:description "Custom Table: Source Restriction Level")) (defclass urank (umlsclass) @@ -42,32 +42,32 @@ (supres :type string :initarg :supres :reader supres)) (:metaclass hyperobject-class) (:default-initargs :rank nil :sab nil :tty nil :supres nil) - (:title "Rank") + (:user-name "Rank") (:print-slots rank sab tty supres)) (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") + (:user-name "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)) (:metaclass hyperobject-class) (:default-initargs :sab nil :code nil :atn nil :atv nil) - (:title "Simple Attribute") + (:user-name "Simple Attribute") (:print-slots sab code atn atv)) (defclass usab (umlsclass) ((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) @@ -93,29 +93,29 @@ :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") - (:print-slots vcui rcui vsab rsab san sf sver mstart mend imeta - rmeta slc scc srl tfr csr cxty ttyl atnl lat cenc + (:user-name "Source Abbreviation") + (: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) - (:title "Source") + (:user-name "Source") (: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) @@ -123,26 +123,27 @@ (:metaclass hyperobject-class) (: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)) + (:user-name "Context") + (: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) (stt :type string :initarg :stt :reader stt) - (s#sat :reader s#sat :subobject t) - (s#so :reader s#so :subobject t) - (s#cxt :reader s#cxt :subobject t)) + (s#sat :reader s#sat :subobject (find-usat-ui cui lui sui)) + (s#so :reader s#so :subobject (find-uso-cuisui cui sui)) + (s#cxt :reader s#cxt :subobject (find-ucxt-cuisui cui sui))) (:metaclass hyperobject-class) (:default-initargs :sui nil :cui nil :lui nil :cuisui nil :str nil :lrl nil :stt nil) - (:title "String") + (:user-name "String") (:print-slots sui stt lrl str)) (defclass ulo (umlsclass) @@ -154,51 +155,53 @@ (soui :type string :initarg :soui :reader soui)) (: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)) + (:user-name "Locator") + (: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) - (s#str :reader s#str :subobject t) - (s#sat :reader s#sat :subobject t)) + (s#str :reader s#str :subobject (find-ustr-cuilui cui lui)) + (s#sat :reader s#sat :subobject (find-usat-ui cui lui))) (:metaclass hyperobject-class) (:default-initargs :lui nil :cui nil :lat nil :ts nil :lrl nil) - (:title "Term") + (:user-name "Term") (:print-slots lui lat ts 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) - (:title "Semantic Type") + (:user-name "Semantic Type") (: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) (:default-initargs :rel nil :cui1 nil :cui2 nil :pfstr2 nil :rela nil :sab nil :sl nil :mg nil) - (:title "Relationship") + (:user-name "Relationship") (:print-slots rel rela sab sl mg cui2 pfstr2)) (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) @@ -207,7 +210,7 @@ (:metaclass hyperobject-class) (:default-initargs :cui1 nil :cui2 nil :pfstr2 nil :soc nil :cot nil :cof nil :coa nil) - (:title "Co-occuring Concept") + (:user-name "Co-occuring Concept") (:print-slots soc cot cof coa cui2 pfstr2)) @@ -217,25 +220,25 @@ (atx :type cdata :initarg :atx :reader atx)) (:metaclass hyperobject-class) (:default-initargs :sab nil :rel nil :atx nil) - (:title "Associated Expression") + (:user-name "Associated Expression") (:print-slots sab rel atx)) (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) - (s#def :reader s#def :subobject t) - (s#lo :reader s#lo :subobject t) - (s#rel :reader s#rel :subobject t) - (s#coc :reader s#coc :subobject t) - (s#sat :reader s#sat :subobject t) - (s#atx :reader s#atx :subobject t) - (s#sty :reader s#sty :subobject t)) + (s#term :reader s#term :subobject (find-uterm-cui cui)) + (s#def :reader s#def :subobject (find-udef-cui cui)) + (s#lo :reader s#lo :subobject (find-ulo-cui cui)) + (s#rel :reader s#rel :subobject (find-urel-cui cui)) + (s#coc :reader s#coc :subobject (find-ucoc-cui cui)) + (s#sat :reader s#sat :subobject (find-usat-ui cui)) + (s#atx :reader s#atx :subobject (find-uatx-cui cui)) + (s#sty :reader s#sty :subobject (find-usty-cui cui))) (:metaclass hyperobject-class) (:default-initargs :cui nil :pfstr nil :lrl nil) - (:title "Concept") + (:user-name "Concept") (:print-slots cui lrl pfstr)) (defclass uxw (umlsclass) @@ -245,7 +248,7 @@ (sui :type fixnum :initform nil :initarg :sui :reader sui :print-formatter fmt-sui)) (:metaclass hyperobject-class) (:default-initargs :wd nil :cui nil :lui nil :sui nil) - (:title "XW Index") + (:user-name "XW Index") (:print-slots wd cui lui sui)) (defclass uxnw (umlsclass) @@ -254,7 +257,7 @@ (cuilist :type list :initarg :cuilist :reader uxnw-cuilist)) (:metaclass hyperobject-class) (:default-initargs :lat nil :nwd nil :cuilist nil) - (:title "XNW Index") + (:user-name "XNW Index") (:print-slots lat nwd cuilist)) (defclass uxns (umlsclass) @@ -263,7 +266,7 @@ (cuilist :type list :initarg :cuilist :reader cuilist)) (:metaclass hyperobject-class) (:default-initargs :lat nil :nstr nil :cuilist nil) - (:title "XNS Index") + (:user-name "XNS Index") (:print-slots lat nstr cuilist)) @@ -271,21 +274,21 @@ (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) - (s#cmp :reader s#cmp :subobject t) - (s#mod :reader s#mod :subobject t) - (s#nom :reader s#nom :subobject t) - (s#prn :reader s#prn :subobject t) - (s#prp :reader s#prp :subobject t) - (s#spl :reader s#spl :subobject t) - (s#trm :reader s#trm :subobject t) - (s#typ :reader s#typ :subobject t)) + (s#abr :reader s#abr :subobject (find-labr-eui eui)) + (s#agr :reader s#agr :subobject (find-lagr-eui eui)) + (s#cmp :reader s#cmp :subobject (find-lcmp-eui eui)) + (s#mod :reader s#mod :subobject (find-lmod-eui eui)) + (s#nom :reader s#nom :subobject (find-lnom-eui eui)) + (s#prn :reader s#prn :subobject (find-lprn-eui eui)) + (s#prp :reader s#prp :subobject (find-lprp-eui eui)) + (s#spl :reader s#spl :subobject (find-lspl-eui eui)) + (s#trm :reader s#trm :subobject (find-ltrm-eui eui)) + (s#typ :reader s#typ :subobject (find-ltyp-eui eui))) (:metaclass hyperobject-class) (:default-initargs :eui nil :wrd nil) - (:title "Lexical Term") + (:user-name "Lexical Term") (:print-slots eui wrd)) @@ -297,8 +300,8 @@ (bas2 :type string :initarg :bas2 :reader bas2)) (: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)) + (:user-name "Abbreviations and Acronyms") + (:print-slots eui bas abr eui2 bas2)) (defclass lagr (umlsclass) ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui) @@ -309,7 +312,7 @@ (bas :type string :initarg :bas :reader bas)) (:metaclass hyperobject-class) (:default-initargs :eui nil :str nil :sca nil :agr nil :cit nil :bas nil) - (:title "Agreement and Inflection") + (:user-name "Agreement and Inflection") (:print-slots eui str sca agr cit bas)) (defclass lcmp (umlsclass) @@ -319,8 +322,8 @@ (com :type string :initarg :com :reader com)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :sca nil :com nil) - (:title "Complementation") - (:print-slots eui bas sca cam)) + (:user-name "Complementation") + (:print-slots eui bas sca com)) (defclass lmod (umlsclass) ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui) @@ -330,8 +333,8 @@ (fea :type string :initarg :fea :reader fea)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :sca nil :psnmod nil :fea nil) - (:title "Modifiers") - (:print-slots eui bas scan psnmod fea)) + (:user-name "Modifiers") + (:print-slots eui bas sca psnmod fea)) (defclass lnom (umlsclass) ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui) @@ -342,8 +345,8 @@ (sca2 :type string :initarg :sca2 :reader sca2)) (: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)) + (:user-name "Nominalizations") + (:print-slots eui bas sca eui2 bas2 sca2)) (defclass lprn (umlsclass) ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui) @@ -357,7 +360,7 @@ (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :num nil :gnd nil :cas nil :pos nil :qnt nil :fea nil) - (:title "Pronouns") + (:user-name "Pronouns") (:print-slots eui bas num gnd cas pos qnt fea)) (defclass lprp (umlsclass) @@ -368,7 +371,7 @@ (fea :type string :initarg :fea :reader fea)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :str nil :sca nil :fea nil) - (:title "Properties") + (:user-name "Properties") (:print-slots eui bas str sca fea)) @@ -378,7 +381,7 @@ (bas :type string :initarg :bas :reader bas)) (:metaclass hyperobject-class) (:default-initargs :eui nil :spv nil :bas nil) - (:title "Spelling Variants") + (:user-name "Spelling Variants") (:print-slots eui spv bas)) @@ -388,7 +391,7 @@ (gen :type string :initarg :gen :reader gen)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :gen nil) - (:title "Trade Marks") + (:user-name "Trade Marks") (:print-slots eui bas gen)) (defclass ltyp (umlsclass) @@ -398,7 +401,7 @@ (typ :type string :initarg :typ :reader typ)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :sca nil :typ nil) - (:title "Inflection Type") + (:user-name "Inflection Type") (:print-slots eui bas sca typ)) (defclass lwd (umlsclass) @@ -406,7 +409,7 @@ (euilist :type list :initarg :euilist :reader euilist)) (:metaclass hyperobject-class) (:default-initargs :wrd nil :euilist nil) - (:title "Lexical Word Index") + (:user-name "Lexical Word Index") (:print-slots wrd euilist)) ;;; Semantic NET objects @@ -426,7 +429,7 @@ (:default-initargs :rt nil :ui nil :styrl nil :stnrtn nil :def nil :ex nil :un nil :rh nil :abr nil :rin nil) - (:title "Basic information about Semantic Types and Relations") + (:user-name "Basic information about Semantic Types and Relations") (:print-slots rt ui styrl stnrtn def ex un rh abr rin)) (defclass sstr (umlsclass) @@ -436,8 +439,8 @@ (ls :type string :initarg :ls :reader ls)) (:metaclass hyperobject-class) (:default-initargs :styrl nil :rl nil :styrl2 nil :ls nil) - (:title "Structure of the Network") - (:print-slots styrl rl styl2 ls)) + (:user-name "Structure of the Network") + (:print-slots styrl rl styrl2 ls)) (defclass sstre1 (umlsclass) ((ui :type integer :initarg :ui :reader ui :print-formatter fmt-tui) @@ -445,7 +448,7 @@ (ui3 :type integer :initarg :ui3 :reader ui3 :print-formatter fmt-tui)) (:metaclass hyperobject-class) (:default-initargs :ui nil :ui2 nil :ui3 nil) - (:title "Fully Inherited Set of Releatons (TUI's)") + (:user-name "Fully Inherited Set of Releatons (TUI's)") (:print-slots ui ui2 ui3)) (defclass sstre2 (umlsclass) @@ -454,7 +457,7 @@ (sty2 :type string :initarg :ui3 :reader sty2)) (:metaclass hyperobject-class) (:default-initargs :sty nil :rl nil :sty2 nil) - (:title "Fully Inherited Set of Releatons (strings)") + (:user-name "Fully Inherited Set of Releatons (strings)") (:print-slots sty rl sty2)) ;;; Formatting routines @@ -524,21 +527,18 @@ (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)