;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: classes.lisp,v 1.22 2002/12/09 14:11:09 kevin Exp $
+;;;; $Id: classes.lisp,v 1.23 2002/12/13 05:43:38 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
(:metaclass hyperobject-class)
(:default-initargs :sab nil :srl nil)
(:user-name "Source Restriction Level")
- (:print-slots sab srl)
+ (:default-print-slots sab srl)
(:description "Custom Table: Source Restriction Level"))
(:metaclass hyperobject-class)
(:default-initargs :rank nil :sab nil :tty nil :supres nil)
(:user-name "Rank")
- (:print-slots rank sab tty supres))
+ (:default-print-slots rank sab tty supres))
(defclass udef (umlsclass)
((def :type cdata :initarg :def :reader def)
(:metaclass hyperobject-class)
(:default-initargs :def nil :sab nil)
(:user-name "Definition")
- (:print-slots sab def))
+ (:default-print-slots sab def))
(defclass usat (umlsclass)
((sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)
(:metaclass hyperobject-class)
(:default-initargs :sab nil :code nil :atn nil :atv nil)
(:user-name "Simple Attribute")
- (:print-slots sab code atn atv))
+ (:default-print-slots sab code atn atv))
(defclass usab (umlsclass)
((vcui :type fixnum :initarg :vcui :reader vcui :print-formatter fmt-cui)
:ttyl nil :atnl nil :lat nil :cenc nil :curver nil
:sabin nil)
(:user-name "Source Abbreviation")
- (:print-slots vcui rcui vsab rsab son sf sver mstart mend imeta
+ (: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))
(:metaclass hyperobject-class)
(:default-initargs :sab nil :code nil :tty nil :srl nil)
(:user-name "Source")
- (:print-slots sab code tty srl))
+ (:default-print-slots sab code tty srl))
(defclass ucxt (umlsclass)
((sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)
(:default-initargs :sab nil :code nil :rnk nil :cxn nil :cxl nil :cxs nil
:cui2 nil :hcd nil :rela nil :xc nil)
(:user-name "Context")
- (:print-slots sab code rnk cxn cxl hcd rela xc cui2 cxs))
+ (:default-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
(:default-initargs
:sui nil :cui nil :lui nil :cuisui nil :str nil :lrl nil :stt nil)
(:user-name "String")
- (:print-slots sui stt lrl str))
+ (:default-print-slots sui stt lrl str))
(defclass ulo (umlsclass)
((isn :type string :initarg :isn :reader isn)
(:metaclass hyperobject-class)
(:default-initargs :isn nil :fr nil :un nil :sui nil :sna nil :soui nil)
(:user-name "Locator")
- (:print-slots isn fr un sna soui sui))
+ (:default-print-slots isn fr un sna soui sui))
(defclass uterm (umlsclass)
((lui :type fixnum :initarg :lui :reader lui :print-formatter fmt-lui
(:metaclass hyperobject-class)
(:default-initargs :lui nil :cui nil :lat nil :ts nil :lrl nil)
(:user-name "Term")
- (:print-slots lui lat ts lrl))
+ (:default-print-slots lui lat ts lrl))
(defclass usty (umlsclass)
((tui :type fixnum :initarg :tui :reader tui :print-formatter fmt-tui
(:metaclass hyperobject-class)
(:default-initargs :tui nil :sty nil)
(:user-name "Semantic Type")
- (:print-slots tui sty))
+ (:default-print-slots tui sty))
(defclass urel (umlsclass)
((rel :type string :initarg :rel :reader rel :hyperlink find-brel-rel)
(:default-initargs
:rel nil :cui1 nil :cui2 nil :pfstr2 nil :rela nil :sab nil :sl nil :mg nil)
(:user-name "Relationship")
- (:print-slots rel rela sab sl mg cui2 pfstr2))
+ (:default-print-slots rel rela sab sl mg cui2 pfstr2))
(defclass ucoc (umlsclass)
((cui1 :type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui)
(:default-initargs
:cui1 nil :cui2 nil :pfstr2 nil :soc nil :cot nil :cof nil :coa nil)
(:user-name "Co-occuring Concept")
- (:print-slots soc cot cof coa cui2 pfstr2))
+ (:default-print-slots soc cot cof coa cui2 pfstr2))
(defclass uatx (umlsclass)
(:metaclass hyperobject-class)
(:default-initargs :sab nil :rel nil :atx nil)
(:user-name "Associated Expression")
- (:print-slots sab rel atx))
+ (:default-print-slots sab rel atx))
(defclass ucon (umlsclass)
((cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui
(:metaclass hyperobject-class)
(:default-initargs :cui nil :pfstr nil :lrl nil)
(:user-name "Concept")
- (:print-slots cui lrl pfstr))
+ (:default-print-slots cui lrl pfstr))
(defclass uxw (umlsclass)
((wd :type string :initarg :wd :reader wd)
(:metaclass hyperobject-class)
(:default-initargs :wd nil :cui nil :lui nil :sui nil)
(:user-name "XW Index")
- (:print-slots wd cui lui sui))
+ (:default-print-slots wd cui lui sui))
(defclass uxnw (umlsclass)
((lat :type string :initarg :lat :reader lat)
(:metaclass hyperobject-class)
(:default-initargs :lat nil :nwd nil :cuilist nil)
(:user-name "XNW Index")
- (:print-slots lat nwd cuilist))
+ (:default-print-slots lat nwd cuilist))
(defclass uxns (umlsclass)
((lat :type string :initarg :lat :reader lat)
(:metaclass hyperobject-class)
(:default-initargs :lat nil :nstr nil :cuilist nil)
(:user-name "XNS Index")
- (:print-slots lat nstr cuilist))
+ (:default-print-slots lat nstr cuilist))
;;; LEX objects
(:metaclass hyperobject-class)
(:default-initargs :eui nil :wrd nil)
(:user-name "Lexical Term")
- (:print-slots eui wrd))
+ (:default-print-slots eui wrd))
(defclass labr (umlsclass)
(:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :abr nil :eui2 nil :bas2 nil)
(:user-name "Abbreviations and Acronyms")
- (:print-slots eui bas abr eui2 bas2))
+ (:default-print-slots eui bas abr eui2 bas2))
(defclass lagr (umlsclass)
((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(:metaclass hyperobject-class)
(:default-initargs :eui nil :str nil :sca nil :agr nil :cit nil :bas nil)
(:user-name "Agreement and Inflection")
- (:print-slots eui str sca agr cit bas))
+ (:default-print-slots eui str sca agr cit bas))
(defclass lcmp (umlsclass)
((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :sca nil :com nil)
(:user-name "Complementation")
- (:print-slots eui bas sca com))
+ (:default-print-slots eui bas sca com))
(defclass lmod (umlsclass)
((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :sca nil :psnmod nil :fea nil)
(:user-name "Modifiers")
- (:print-slots eui bas sca psnmod fea))
+ (:default-print-slots eui bas sca psnmod fea))
(defclass lnom (umlsclass)
((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :sca nil :eui2 nil :bas2 nil :sca2 nil)
(:user-name "Nominalizations")
- (:print-slots eui bas sca eui2 bas2 sca2))
+ (:default-print-slots eui bas sca eui2 bas2 sca2))
(defclass lprn (umlsclass)
((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(:default-initargs :eui nil :bas nil :num nil :gnd nil :cas nil
:pos nil :qnt nil :fea nil)
(:user-name "Pronouns")
- (:print-slots eui bas num gnd cas pos qnt fea))
+ (:default-print-slots eui bas num gnd cas pos qnt fea))
(defclass lprp (umlsclass)
((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :str nil :sca nil :fea nil)
(:user-name "Properties")
- (:print-slots eui bas str sca fea))
+ (:default-print-slots eui bas str sca fea))
(defclass lspl (umlsclass)
(:metaclass hyperobject-class)
(:default-initargs :eui nil :spv nil :bas nil)
(:user-name "Spelling Variants")
- (:print-slots eui spv bas))
+ (:default-print-slots eui spv bas))
(defclass ltrm (umlsclass)
(:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :gen nil)
(:user-name "Trade Marks")
- (:print-slots eui bas gen))
+ (:default-print-slots eui bas gen))
(defclass ltyp (umlsclass)
((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :sca nil :typ nil)
(:user-name "Inflection Type")
- (:print-slots eui bas sca typ))
+ (:default-print-slots eui bas sca typ))
(defclass lwd (umlsclass)
((wrd :type string :initarg :wrd :reader wrd)
(:metaclass hyperobject-class)
(:default-initargs :wrd nil :euilist nil)
(:user-name "Lexical Word Index")
- (:print-slots wrd euilist))
+ (:default-print-slots wrd euilist))
;;; Semantic NET objects
:rt nil :ui nil :styrl nil :stnrtn nil :def nil :ex nil :un nil :rh nil
:abr nil :rin nil)
(:user-name "Basic information about Semantic Types and Relations")
- (:print-slots rt ui styrl stnrtn def ex un rh abr rin))
+ (:default-print-slots rt ui styrl stnrtn def ex un rh abr rin))
(defclass sstr (umlsclass)
((styrl :type string :initarg :styrl :reader styrl)
(:metaclass hyperobject-class)
(:default-initargs :styrl nil :rl nil :styrl2 nil :ls nil)
(:user-name "Structure of the Network")
- (:print-slots styrl rl styrl2 ls))
+ (:default-print-slots styrl rl styrl2 ls))
(defclass sstre1 (umlsclass)
((ui :type integer :initarg :ui :reader ui :print-formatter fmt-tui)
(:metaclass hyperobject-class)
(:default-initargs :ui nil :ui2 nil :ui3 nil)
(:user-name "Fully Inherited Set of Releatons (TUI's)")
- (:print-slots ui ui2 ui3))
+ (:default-print-slots ui ui2 ui3))
(defclass sstre2 (umlsclass)
((sty :type string :initarg :ui :reader sty)
(:metaclass hyperobject-class)
(:default-initargs :sty nil :rl nil :sty2 nil)
(:user-name "Fully Inherited Set of Releatons (strings)")
- (:print-slots sty rl sty2))
+ (:default-print-slots sty rl sty2))
;;; Formatting routines
(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)))
-(defun print-umlsclass (obj &key (os *standard-output*) (format :text)
- (label nil) (file-wrapper t) (english-only nil) (subobjects nil)
- (refvars nil))
- (view obj :os os :format format :label label :subobjects subobjects
+(defun print-umlsclass (obj &key (os *standard-output*) (category :compact-text)
+ (file-wrapper t) (english-only nil) (subobjects nil)
+ (refvars nil))
+ (view obj :stream os :category category :subobjects subobjects
:file-wrapper file-wrapper
- :english-only-function (if english-only #'english-term-p nil)
+ :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)))