X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=classes.lisp;h=40db29a86dd1b45a66721fbfebeb856263d341bd;hb=f1ceffd73c7e181db3b2a739b7dbc64243cfca2d;hp=40490432de8de695fcc80f4f7fc4fd5e47b72e84;hpb=521486393a9ab3b83cee25cd7a4377000914b68c;p=umlisp.git diff --git a/classes.lisp b/classes.lisp index 4049043..40db29a 100644 --- a/classes.lisp +++ b/classes.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: classes.lisp,v 1.12 2002/11/12 17:25:43 kevin Exp $ +;;;; $Id: classes.lisp,v 1.26 2002/12/14 02:35:28 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -22,473 +22,443 @@ (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) - ((sab :type string :initarg :sab :reader sab) - (srl :type integer :initarg :srl :reader srl)) + ((sab :value-type string :initarg :sab :reader sab) + (srl :value-type fixnum :initarg :srl :reader srl)) (:metaclass hyperobject-class) (:default-initargs :sab nil :srl nil) - (:title "Source Restriction Level") - (:fields (sab :string) (srl :fixnum)) - (:documentation "Custom Table: Source Restriction Level")) + (:user-name "Source Restriction Level") + (:default-print-slots sab srl) + (:description "Custom Table: Source Restriction Level")) (defclass urank (umlsclass) - ((rank :type fixnum :initarg :rank :reader rank) - (sab :type string :initarg :sab :reader sab) - (tty :type string :initarg :tty :reader tty) - (supres :type string :initarg :supres :reader supres)) + ((rank :value-type fixnum :initarg :rank :reader rank) + (sab :value-type string :initarg :sab :reader sab) + (tty :value-type string :initarg :tty :reader tty) + (supres :value-type string :initarg :supres :reader supres)) (:metaclass hyperobject-class) (:default-initargs :rank nil :sab nil :tty nil :supres nil) - (:title "Rank") - (:fields (rank :fixnum) (sab :string) (tty :string) (supres :string))) + (:user-name "Rank") + (:default-print-slots rank sab tty supres)) (defclass udef (umlsclass) - ((def :type string :initarg :def :reader def) - (sab :type string :initarg :sab :reader sab)) + ((def :value-type cdata :initarg :def :reader def) + (sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab)) (:metaclass hyperobject-class) (:default-initargs :def nil :sab nil) - (:title "Definition") - (:ref-fields (sab find-usab-rsab)) - (:fields (sab :string) (def :cdata))) + (:user-name "Definition") + (:default-print-slots sab def)) (defclass usat (umlsclass) - ((sab :type string :initarg :sab :reader sab) - (code :type string :initarg :code :reader code) - (atn :type string :initarg :atn :reader atn) - (atv :type string :initarg :atv :reader atv)) + ((sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) + (code :value-type string :initarg :code :reader code) + (atn :value-type string :initarg :atn :reader atn) + (atv :value-type cdata :initarg :atv :reader atv)) (:metaclass hyperobject-class) (:default-initargs :sab nil :code nil :atn nil :atv nil) - (:title "Simple Attribute") - (:ref-fields (sab find-usab-rsab)) - (:fields (sab :string) (code :string) (atn :string) (atv :cdata))) + (:user-name "Simple Attribute") + (:default-print-slots sab code atn atv)) (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)) + ((vcui :value-type fixnum :initarg :vcui :reader vcui :print-formatter fmt-cui) + (rcui :value-type fixnum :initarg :rcui :reader rcui :print-formatter fmt-cui) + (vsab :value-type string :initarg :vsab :reader vsab) + (rsab :value-type string :initarg :rsab :reader rsab :hyperlink find-ucan-sab) + (son :value-type string :initarg :son :reader son) + (sf :value-type string :initarg :sf :reader sf) + (sver :value-type string :initarg :sver :reader sver) + (mstart :value-type string :initarg :mstart :reader mstart) + (mend :value-type string :initarg :mend :reader mend) + (imeta :value-type string :initarg :imeta :reader imeta) + (rmeta :value-type string :initarg :rmeta :reader rmeta) + (slc :value-type cdata :initarg :slc :reader slc) + (scc :value-type cdata :initarg :scc :reader scc) + (srl :value-type fixnum :initarg :srl :reader srl) + (tfr :value-type fixnum :initarg :tfr :reader tfr :print-formatter fmt-comma-integer) + (cfr :value-type fixnum :initarg :cfr :reader cfr :print-formatter fmt-comma-integer) + (cxty :value-type string :initarg :cxty :reader cxty) + (ttyl :value-type string :initarg :ttyl :reader ttyl) + (atnl :value-type string :initarg :atnl :reader atnl) + (lat :value-type string :initarg :lat :reader lat) + (cenc :value-type string :initarg :cenc :reader cenc) + (curver :value-type string :initarg :curver :reader curver) + (sabin :value-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))) + (:user-name "Source Abbreviation") + (:default-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) - (code :type string :initarg :code :reader code) - (tty :type string :initarg :tty :reader tty) - (srl :type fixnum :initarg :srl :reader srl)) + ((sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) + (code :value-type string :initarg :code :reader code) + (tty :value-type string :initarg :tty :reader tty :hyperlink find-btty-tty) + (srl :value-type fixnum :initarg :srl :reader srl)) (:metaclass hyperobject-class) (:default-initargs :sab nil :code nil :tty nil :srl nil) - (:title "Source") - (:ref-fields (sab find-usab-rsab) (tty find-btty-tty)) - (:fields (sab :string) (code :string) (tty :string) (srl :fixnum))) + (:user-name "Source") + (:default-print-slots sab code tty srl)) (defclass ucxt (umlsclass) - ((sab :type string :initarg :sab :reader sab) - (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 string :initarg :cxs :reader cxs) - (cui2 :type fixnum :initarg :cui2 :reader cui2) - (hcd :type string :initarg :hcd :reader hcd) - (rela :type string :initarg :rela :reader rela) - (xc :type string :initarg :xc :reader xc)) + ((sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) + (code :value-type string :initarg :code :reader code) + (rnk :value-type fixnum :initarg :rnk :reader rnk) + (cxn :value-type fixnum :initarg :cxn :reader cxn) + (cxl :value-type string :initarg :cxl :reader cxl) + (cxs :value-type cdata :initarg :cxs :reader cxs) + (cui2 :value-type fixnum :initarg :cui2 :reader cui2 :hyperlink find-ucon-cui + :print-formatter fmt-cui) + (hcd :value-type string :initarg :hcd :reader hcd) + (rela :value-type string :initarg :rela :reader rela) + (xc :value-type string :initarg :xc :reader xc)) (: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") - (:ref-fields (sab find-usab-rsab) (cui2 find-ucon-cui)) - (:fields - (sab :string) (code :string) (rnk :fixnum) (cxn :fixnum) (cxl :string) - (hcd :string) (rela :string) (xc :string) (cui2 :string fmt-cui) - (cxs :cdata))) + (:user-name "Context") + (:default-print-slots sab code rnk cxn cxl hcd rela xc cui2 cxs)) (defclass ustr (umlsclass) - ((sui :type fixnum :initarg :sui :reader sui) - (cui :type fixnum :initarg :cui :reader cui) - (lui :type fixnum :initarg :lui :reader lui) - (cuisui :type integer :initarg :cuisui :reader cuisui ) - (str :type string :initarg :str :reader str) - (lrl :type fixnum :initarg :lrl :reader lrl) - (stt :type string :initarg :stt :reader stt) - (s#sat :reader s#sat) - (s#so :reader s#so) - (s#cxt :reader s#cxt)) + ((sui :value-type fixnum :initarg :sui :reader sui :print-formatter fmt-sui + :hyperlink find-ustr-sui) + (cui :value-type fixnum :initarg :cui :reader cui :print-formatter fmt-cui + :hyperlink find-ucon-cui) + (lui :value-type fixnum :initarg :lui :reader lui :print-formatter fmt-lui + :hyperlink find-uterm-lui) + (cuisui :value-type integer :initarg :cuisui :reader cuisui ) + (str :value-type cdata :initarg :str :reader str) + (lrl :value-type fixnum :initarg :lrl :reader lrl) + (stt :value-type string :initarg :stt :reader stt) + (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") - (:subobjects-lists (s#sat usat) (s#so uso) (s#cxt ucxt)) - (:fields (sui :string fmt-sui) (stt :string) (lrl :fixnum) (str :cdata)) - (:ref-fields (sui find-ustr-sui))) + (:user-name "String") + (:default-print-slots sui stt lrl str)) (defclass ulo (umlsclass) - ((isn :type string :initarg :isn :reader isn) - (fr :type fixnum :initarg :fr :reader fr) - (un :type string :initarg :un :reader un) - (sui :type fixnum :initarg :sui :reader sui) - (sna :type string :initarg :sna :reader sna) - (soui :type string :initarg :soui :reader soui)) + ((isn :value-type string :initarg :isn :reader isn) + (fr :value-type fixnum :initarg :fr :reader fr) + (un :value-type string :initarg :un :reader un) + (sui :value-type fixnum :initarg :sui :reader sui :print-formatter fmt-sui) + (sna :value-type string :initarg :sna :reader sna) + (soui :value-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") - (:fields (isn :string) (fr :fixnum) (un :string) (sna :string) - (soui :string) (sui :string fmt-sui) (suistr :string))) + (:user-name "Locator") + (:default-print-slots isn fr un sna soui sui)) (defclass uterm (umlsclass) - ((lui :type fixnum :initarg :lui :reader lui) - (cui :type fixnum :initarg :cui :reader 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) - (s#sat :reader s#sat)) + ((lui :value-type fixnum :initarg :lui :reader lui :print-formatter fmt-lui + :hyperlink find-uterm-lui) + (cui :value-type fixnum :initarg :cui :reader cui :print-formatter fmt-cui + :hyperlink find-ucon-cui) + (lat :value-type string :initarg :lat :reader lat) + (ts :value-type string :initarg :ts :reader ts) + (lrl :value-type fixnum :initarg :lrl :reader lrl) + (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") - (:subobjects-lists (s#sat usat) (s#str ustr)) - (:fields (lui :string fmt-lui) (lat :string) (ts :string) (lrl :fixnum)) - (:ref-fields (lui find-uterm-lui))) + (:user-name "Term") + (:default-print-slots lui lat ts lrl)) (defclass usty (umlsclass) - ((tui :type fixnum :initarg :tui :reader tui) - (sty :type string :initarg :sty :reader sty)) + ((tui :value-type fixnum :initarg :tui :reader tui :print-formatter fmt-tui + :hyperlink (find-ucon-tui ("subobjects" "no"))) + (sty :value-type string :initarg :sty :reader sty)) (:metaclass hyperobject-class) (:default-initargs :tui nil :sty nil) - (:title "Semantic Type") - (:ref-fields (tui find-ucon-tui (("subobjects" "no")))) - (:fields (tui :string fmt-tui) (sty :string))) + (:user-name "Semantic Type") + (:default-print-slots tui sty)) (defclass urel (umlsclass) - ((rel :type string :initarg :rel :reader rel) - (cui1 :type fixnum :initarg :cui1 :reader cui1) - (cui2 :type fixnum :initarg :cui2 :reader cui2) - (pfstr2 :type string :initarg :pfstr2 :reader pfstr2) - (rela :type string :initarg :rela :reader rela) - (sab :type string :initarg :sab :reader sab) - (sl :type string :initarg :sl :reader sl) - (mg :type string :initarg :mg :reader mg)) + ((rel :value-type string :initarg :rel :reader rel :hyperlink find-brel-rel) + (cui1 :value-type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui) + (cui2 :value-type fixnum :initarg :cui2 :reader cui2 :hyperlink find-ucon-sui + :print-formatter fmt-cui) + (pfstr2 :value-type cdata :initarg :pfstr2 :reader pfstr2) + (rela :value-type string :initarg :rela :reader rela) + (sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) + (sl :value-type string :initarg :sl :reader sl) + (mg :value-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") - (:ref-fields (rel find-brel-rel) (sab find-usab-rsab) (cui2 find-ucon-cui)) - (:fields (rel :string) (rela :string) (sab :string) (sl :string) - (mg :string) (cui2 :string fmt-cui) (pfstr2 :cdata))) + (:user-name "Relationship") + (:default-print-slots rel rela sab sl mg cui2 pfstr2)) (defclass ucoc (umlsclass) - ((cui1 :type fixnum :initarg :cui1 :reader cui1) - (cui2 :type fixnum :initarg :cui2 :reader cui2) - (pfstr2 :type string :initarg :pfstr2 :reader pfstr2) - (soc :type string :initarg :soc :reader soc) - (cot :type string :initarg :cot :reader cot) - (cof :type fixnum :initarg :cof :reader cof) - (coa :type string :initarg :coa :reader coa)) + ((cui1 :value-type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui) + (cui2 :value-type fixnum :initarg :cui2 :reader cui2 :print-formatter fmt-cui + :hyperlink find-ucon-cui) + (pfstr2 :value-type cdata :initarg :pfstr2 :reader pfstr2) + (soc :value-type string :initarg :soc :reader soc) + (cot :value-type string :initarg :cot :reader cot) + (cof :value-type fixnum :initarg :cof :reader cof) + (coa :value-type cdata :initarg :coa :reader coa)) (:metaclass hyperobject-class) (:default-initargs :cui1 nil :cui2 nil :pfstr2 nil :soc nil :cot nil :cof nil :coa nil) - (:title "Co-occuring Concept") - (:ref-fields (cui2 find-ucon-cui)) - (:fields (soc :string) (cot :string) (cof :fixnum) (coa :cdata) - (cui2 :string fmt-cui) (pfstr2 :cdata))) + (:user-name "Co-occuring Concept") + (:default-print-slots soc cot cof coa cui2 pfstr2)) (defclass uatx (umlsclass) - ((sab :type string :initarg :sab :reader sab) - (rel :type string :initarg :rel :reader rel) - (atx :type string :initarg :atx :reader atx)) + ((sab :value-type string :initarg :sab :reader sab) + (rel :value-type string :initarg :rel :reader rel) + (atx :value-type cdata :initarg :atx :reader atx)) (:metaclass hyperobject-class) (:default-initargs :sab nil :rel nil :atx nil) - (:title "Associated Expression") - (:fields (sab :string) (rel :string) (atx :cdata))) + (:user-name "Associated Expression") + (:default-print-slots sab rel atx)) (defclass ucon (umlsclass) - ((cui :type fixnum :initarg :cui :reader cui ) - (pfstr :initarg :pfstr :reader pfstr) - (lrl :initarg :lrl :reader lrl) - (s#term :reader s#term) - (s#def :reader s#def) - (s#lo :reader s#lo) - (s#rel :reader s#rel) - (s#coc :reader s#coc) - (s#sat :reader s#sat) - (s#atx :reader s#atx) - (s#sty :reader s#sty)) - (:metaclass hyperobject-class) - (:default-initargs :cui nil :pfstr nil :lrl nil) - (:title "Concept") - (:subobjects-lists - (s#def udef) (s#sty usty) (s#lo ulo) (s#atx uatx) (s#sat usat) (s#rel urel) - (s#coc ucoc) (s#term uterm)) - (:fields (cui :string fmt-cui) (lrl :fixum) (pfstr :cdata)) - (:ref-fields (cui find-ucon-cui))) + ((cui :value-type fixnum :initarg :cui :reader cui :print-formatter fmt-cui + :hyperlink find-ucon-cui) + (lrl :value-type fixnum :initarg :lrl :reader lrl) + (pfstr :value-type cdata :initarg :pfstr :reader pfstr) + (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 :lrl nil :pfstr nil) + (:user-name "Concept") + (:default-print-slots cui lrl pfstr)) (defclass uxw (umlsclass) - ((wd :type string :initarg :wd :reader wd) - (cui :type fixnum :initform nil :initarg :cui :reader cui) - (lui :type fixnum :initform nil :initarg :lui :reader lui) - (sui :type fixnum :initform nil :initarg :sui :reader sui)) + ((wd :value-type string :initarg :wd :reader wd) + (cui :value-type fixnum :initform nil :initarg :cui :reader cui :print-formatter fmt-cui) + (lui :value-type fixnum :initform nil :initarg :lui :reader lui :print-formatter fmt-lui) + (sui :value-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") - (:fields (wd :string) (cui :string fmt-cui) (lui :string fmt-lui) - (sui :string fmt-sui))) + (:user-name "XW Index") + (:default-print-slots wd cui lui sui)) (defclass uxnw (umlsclass) - ((lat :type string :initarg :lat :reader lat) - (nwd :type string :initarg :nwd :reader nwd) - (cuilist :type list :initarg :cuilist :reader uxnw-cuilist)) + ((lat :value-type string :initarg :lat :reader lat) + (nwd :value-type string :initarg :nwd :reader nwd) + (cuilist :value-type list :initarg :cuilist :reader uxnw-cuilist)) (:metaclass hyperobject-class) (:default-initargs :lat nil :nwd nil :cuilist nil) - (:title "XNW Index") - (:fields (lat :string) (nwd :string) (cuilist :string))) + (:user-name "XNW Index") + (:default-print-slots lat nwd cuilist)) (defclass uxns (umlsclass) - ((lat :type string :initarg :lat :reader lat) - (nstr :type string :initarg :nstr :reader nstr) - (cuilist :type list :initarg :cuilist :reader cuilist)) + ((lat :value-type string :initarg :lat :reader lat) + (nstr :value-type string :initarg :nstr :reader nstr) + (cuilist :value-type list :initarg :cuilist :reader cuilist)) (:metaclass hyperobject-class) (:default-initargs :lat nil :nstr nil :cuilist nil) - (:title "XNS Index") - (:fields (lat :string) (nstr :string) (cuilist :string))) + (:user-name "XNS Index") + (:default-print-slots lat nstr cuilist)) ;;; LEX objects (defclass lexterm (umlsclass) - ((eui :type fixnum :initarg :eui :reader eui) - (wrd :type string :initarg :wrd :reader wrd) - (s#abr :reader s#abr) - (s#agr :reader s#agr) - (s#cmp :reader s#cmp) - (s#mod :reader s#mod) - (s#nom :reader s#nom) - (s#prn :reader s#prn) - (s#prp :reader s#prp) - (s#spl :reader s#spl) - (s#trm :reader s#trm) - (s#typ :reader s#typ)) + ((eui :value-type fixnum :initarg :eui :reader eui :print-formatter fmt-eui + :hyperlink find-lexterm-eui) + (wrd :value-type string :initarg :wrd :reader wrd) + (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") - (:subobjects-lists - (s#abr labr) (s#agr lagr) (s#cmp lcmp) (s#mod lmod) (s#nom unom) - (s#prn lprn) (s#prp lprp) (s#spl lspl) (s#trm ltrm) (s#typ ltyp)) - (:fields (eui :string fmt-eui) (wrd :string)) - (:ref-fields (eui find-lexterm-eui))) + (:user-name "Lexical Term") + (:default-print-slots eui wrd)) (defclass labr (umlsclass) - ((eui :type integer :initarg :eui :reader eui) - (bas :type string :initarg :bas :reader bas) - (abr :type string :initarg :abr :reader abr) - (eui2 :type integer :initarg :eui2 :reader eui2) - (bas2 :type string :initarg :bas2 :reader bas2)) + ((eui :value-type integer :initarg :eui :reader eui :print-formatter fmt-eui) + (bas :value-type string :initarg :bas :reader bas) + (abr :value-type string :initarg :abr :reader abr) + (eui2 :value-type integer :initarg :eui2 :reader eui2 :print-formatter fmt-eui) + (bas2 :value-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") - (:fields (eui :string fmt-eui) (bas :string) (abr :string) - (eui2 :string fmt-eui) (bas2 :string ))) + (:user-name "Abbreviations and Acronyms") + (:default-print-slots eui bas abr eui2 bas2)) (defclass lagr (umlsclass) - ((eui :type integer :initarg :eui :reader eui) - (str :type string :initarg :str :reader str) - (sca :type string :initarg :sca :reader sca) - (agr :type string :initarg :agr :reader agr) - (cit :type string :initarg :cit :reader cit) - (bas :type string :initarg :bas :reader bas)) + ((eui :value-type integer :initarg :eui :reader eui :print-formatter fmt-eui) + (str :value-type string :initarg :str :reader str) + (sca :value-type string :initarg :sca :reader sca) + (agr :value-type string :initarg :agr :reader agr) + (cit :value-type string :initarg :cit :reader cit) + (bas :value-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") - (:fields (eui :string fmt-eui) (str :string) (sca :string) (agr :string) - (cit :string) (bas :string))) + (:user-name "Agreement and Inflection") + (:default-print-slots eui str sca agr cit bas)) (defclass lcmp (umlsclass) - ((eui :type integer :initarg :eui :reader eui) - (bas :type string :initarg :bas :reader bas) - (sca :type string :initarg :sca :reader sca) - (com :type string :initarg :com :reader com)) + ((eui :value-type integer :initarg :eui :reader eui :print-formatter fmt-eui) + (bas :value-type string :initarg :bas :reader bas) + (sca :value-type string :initarg :sca :reader sca) + (com :value-type string :initarg :com :reader com)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :sca nil :com nil) - (:title "Complementation") - (:fields (eui :string fmt-eui) (bas :string) (sca :string) (com :string))) + (:user-name "Complementation") + (:default-print-slots eui bas sca com)) (defclass lmod (umlsclass) - ((eui :type integer :initarg :eui :reader eui) - (bas :type string :initarg :bas :reader bas) - (sca :type string :initarg :sca :reader sca) - (psnmod :type string :initarg :psnmod :reader psnmod) - (fea :type string :initarg :fea :reader fea)) + ((eui :value-type integer :initarg :eui :reader eui :print-formatter fmt-eui) + (bas :value-type string :initarg :bas :reader bas) + (sca :value-type string :initarg :sca :reader sca) + (psnmod :value-type string :initarg :psnmod :reader psnmod) + (fea :value-type string :initarg :fea :reader fea)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :sca nil :psnmod nil :fea nil) - (:title "Modifiers") - (:fields (eui :string fmt-eui) (bas :string) (sca :string) (psnmod :string) - (fea :string))) + (:user-name "Modifiers") + (:default-print-slots eui bas sca psnmod fea)) (defclass lnom (umlsclass) - ((eui :type integer :initarg :eui :reader eui) - (bas :type string :initarg :bas :reader bas) - (sca :type string :initarg :sca :reader sca) - (eui2 :type integer :initarg :eui2 :reader eui2) - (bas2 :type string :initarg :bas2 :reader bas2) - (sca2 :type string :initarg :sca2 :reader sca2)) + ((eui :value-type integer :initarg :eui :reader eui :print-formatter fmt-eui) + (bas :value-type string :initarg :bas :reader bas) + (sca :value-type string :initarg :sca :reader sca) + (eui2 :value-type integer :initarg :eui2 :reader eui2 :print-formatter fmt-eui) + (bas2 :value-type string :initarg :bas2 :reader bas2) + (sca2 :value-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") - (:fields (eui :string fmt-eui) (bas :string) (sca :string) - (eui2 :string fmt-eui) (bas2 :string) (sca2 :string))) + (:user-name "Nominalizations") + (:default-print-slots eui bas sca eui2 bas2 sca2)) (defclass lprn (umlsclass) - ((eui :type integer :initarg :eui :reader eui) - (bas :type string :initarg :bas :reader bas) - (num :type string :initarg :num :reader num) - (gnd :type string :initarg :gnd :reader gnd) - (cas :type string :initarg :cas :reader cas) - (pos :type string :initarg :pos :reader pos) - (qnt :type string :initarg :qnt :reader qnt) - (fea :type string :initarg :fea :reader fea)) + ((eui :value-type integer :initarg :eui :reader eui :print-formatter fmt-eui) + (bas :value-type string :initarg :bas :reader bas) + (num :value-type string :initarg :num :reader num) + (gnd :value-type string :initarg :gnd :reader gnd) + (cas :value-type string :initarg :cas :reader cas) + (pos :value-type string :initarg :pos :reader pos) + (qnt :value-type string :initarg :qnt :reader qnt) + (fea :value-type string :initarg :fea :reader fea)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :num nil :gnd nil :cas nil :pos nil :qnt nil :fea nil) - (:title "Pronouns") - (:fields (eui :string fmt-eui) (bas :string) (num :string) (gnd :string) - (cas :string) (pos :string) (qnt :string) (fea :string))) + (:user-name "Pronouns") + (:default-print-slots eui bas num gnd cas pos qnt fea)) (defclass lprp (umlsclass) - ((eui :type integer :initarg :eui :reader eui) - (bas :type string :initarg :bas :reader bas) - (str :type string :initarg :str :reader str) - (sca :type string :initarg :sca :reader sca) - (fea :type string :initarg :fea :reader fea)) + ((eui :value-type integer :initarg :eui :reader eui :print-formatter fmt-eui) + (bas :value-type string :initarg :bas :reader bas) + (str :value-type string :initarg :str :reader str) + (sca :value-type string :initarg :sca :reader sca) + (fea :value-type string :initarg :fea :reader fea)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :str nil :sca nil :fea nil) - (:title "Properties") - (:fields (eui :string fmt-eui) (bas :string) (str :string) (sca :string) - (fea :string))) + (:user-name "Properties") + (:default-print-slots eui bas str sca fea)) (defclass lspl (umlsclass) - ((eui :type integer :initarg :eui :reader eui) - (spv :type string :initarg :spv :reader spv) - (bas :type string :initarg :bas :reader bas)) + ((eui :value-type integer :initarg :eui :reader eui :print-formatter fmt-eui) + (spv :value-type string :initarg :spv :reader spv) + (bas :value-type string :initarg :bas :reader bas)) (:metaclass hyperobject-class) (:default-initargs :eui nil :spv nil :bas nil) - (:title "Spelling Variants") - (:fields (eui :string fmt-eui) (spv :string) (bas :string))) - + (:user-name "Spelling Variants") + (:default-print-slots eui spv bas)) (defclass ltrm (umlsclass) - ((eui :type integer :initarg :eui :reader eui) - (bas :type string :initarg :bas :reader bas) - (gen :type string :initarg :gen :reader gen)) + ((eui :value-type integer :initarg :eui :reader eui :print-formatter fmt-eui) + (bas :value-type string :initarg :bas :reader bas) + (gen :value-type string :initarg :gen :reader gen)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :gen nil) - (:title "Trade Marks") - (:fields (eui :string fmt-eui) (bas :string) (gen :string))) + (:user-name "Trade Marks") + (:default-print-slots eui bas gen)) (defclass ltyp (umlsclass) - ((eui :type integer :initarg :eui :reader eui) - (bas :type string :initarg :bas :reader bas) - (sca :type string :initarg :sca :reader sca) - (typ :type string :initarg :typ :reader typ)) + ((eui :value-type integer :initarg :eui :reader eui :print-formatter fmt-eui) + (bas :value-type string :initarg :bas :reader bas) + (sca :value-type string :initarg :sca :reader sca) + (typ :value-type string :initarg :typ :reader typ)) (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :sca nil :typ nil) - (:title "Inflection Type") - (:fields (eui :string fmt-eui) (bas :string) (sca :string) (typ :string))) + (:user-name "Inflection Type") + (:default-print-slots eui bas sca typ)) (defclass lwd (umlsclass) - ((wrd :type string :initarg :wrd :reader wrd) - (euilist :type list :initarg :euilist :reader euilist)) + ((wrd :value-type string :initarg :wrd :reader wrd) + (euilist :value-type list :initarg :euilist :reader euilist)) (:metaclass hyperobject-class) (:default-initargs :wrd nil :euilist nil) - (:title "Lexical Word Index") - (:fields (wrd :string) (euilist :string))) + (:user-name "Lexical Word Index") + (:default-print-slots wrd euilist)) ;;; Semantic NET objects (defclass sdef (umlsclass) - ((rt :type string :initarg :rt :reader rt) - (ui :type integer :initarg :ui :reader ui) - (styrl :type string :initarg :styrl :reader styrl) - (stnrtn :type string :initarg :stnrtn :reader stnrtn) - (def :type string :initarg :def :reader def) - (ex :type string :initarg :ex :reader ex) - (un :type string :initarg :un :reader un) - (rh :type string :initarg :rh :reader rh) - (abr :type string :initarg :abr :reader abr) - (rin :type string :initarg :rin :reader rin)) + ((rt :value-type string :initarg :rt :reader rt) + (ui :value-type integer :initarg :ui :reader ui :print-formatter fmt-tui) + (styrl :value-type string :initarg :styrl :reader styrl) + (stnrtn :value-type string :initarg :stnrtn :reader stnrtn) + (def :value-type string :initarg :def :reader def) + (ex :value-type string :initarg :ex :reader ex) + (un :value-type string :initarg :un :reader un) + (rh :value-type string :initarg :rh :reader rh) + (abr :value-type string :initarg :abr :reader abr) + (rin :value-type string :initarg :rin :reader rin)) (:metaclass hyperobject-class) (: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") - (:fields - (rt :string) (ui :string fmt-tui) (styrl :string) (stnrtn :string-tui) - (def :string) (ex :string) (un :string) (rh :string) (abr :string) - (rin :string))) + (:user-name "Basic information about Semantic Types and Relations") + (:default-print-slots rt ui styrl stnrtn def ex un rh abr rin)) (defclass sstr (umlsclass) - ((styrl :type string :initarg :styrl :reader styrl) - (rl :type string :initarg :rl :reader rl) - (styrl2 :type string :initarg :styrl2 :reader styrl2) - (ls :type string :initarg :ls :reader ls)) + ((styrl :value-type string :initarg :styrl :reader styrl) + (rl :value-type string :initarg :rl :reader rl) + (styrl2 :value-type string :initarg :styrl2 :reader styrl2) + (ls :value-type string :initarg :ls :reader ls)) (:metaclass hyperobject-class) (:default-initargs :styrl nil :rl nil :styrl2 nil :ls nil) - (:title "Structure of the Network") - (:fields (styrl :string) (rl :string) (styrl2 :string) (ls :string))) + (:user-name "Structure of the Network") + (:default-print-slots styrl rl styrl2 ls)) (defclass sstre1 (umlsclass) - ((ui :type integer :initarg :ui :reader ui) - (ui2 :type integer :initarg :ui2 :reader ui2) - (ui3 :type integer :initarg :ui3 :reader ui3)) + ((ui :value-type integer :initarg :ui :reader ui :print-formatter fmt-tui) + (ui2 :value-type integer :initarg :ui2 :reader ui2 :print-formatter fmt-tui) + (ui3 :value-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)") - (:fields (ui :string fmt-tui) (ui2 :string fmt-tui) (ui3 :string fmt-tui))) + (:user-name "Fully Inherited Set of Releatons (TUI's)") + (:default-print-slots ui ui2 ui3)) (defclass sstre2 (umlsclass) - ((sty :type string :initarg :ui :reader sty) - (rl :type string :initarg :ui2 :reader rl) - (sty2 :type string :initarg :ui3 :reader sty2)) + ((sty :value-type string :initarg :ui :reader sty) + (rl :value-type string :initarg :ui2 :reader rl) + (sty2 :value-type string :initarg :ui3 :reader sty2)) (:metaclass hyperobject-class) (:default-initargs :sty nil :rl nil :sty2 nil) - (:title "Fully Inherited Set of Releatons (strings)") - (:fields (sty :string) (rl :string) (sty2 :string))) + (:user-name "Fully Inherited Set of Releatons (strings)") + (:default-print-slots sty rl sty2)) ;;; Formatting routines @@ -557,29 +527,29 @@ (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)))) +(defun english-term-filter (obj) + "Retrns NIL if object is a term and not english" + (multiple-value-bind (is-english is-term) (english-term-p obj) + (or (not is-term) is-english))) -(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) - (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)) - +(defun print-umlsclass (obj &key (stream *standard-output*) (category :compact-text) + (file-wrapper t) (english-only nil) (subobjects nil) + (refvars nil)) + (view obj :stream stream :category category :subobjects subobjects + :file-wrapper file-wrapper + :filter (if english-only nil #'english-term-filter) + :refvars refvars)) (defmacro define-lookup-display (newfuncname lookup-func) "Defines functions for looking up and displaying objects" - `(defun ,newfuncname (keyval &key (os *standard-output*) (format :text) (label nil) - (file-wrapper t) (english-only nil) (subobjects nil)) + `(defun ,newfuncname (keyval &key (stream *standard-output*) (category :compact-text) + (file-wrapper t) (english-only nil) (subobjects nil)) (let ((obj (funcall ,lookup-func keyval))) - (print-umlsclass obj :os os :format format :label label + (print-umlsclass obj :stream stream :category category :file-wrapper file-wrapper :english-only english-only :subobjects subobjects) obj)))