X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=classes.lisp;h=2ca6b778f1484cd0c3dc01c3ddb8912ebb30c873;hb=231bc1b070a4f93e7d58a88ea8ffaeafd6ebc0bb;hp=dbb4bc1b8c91e7edc7131bff5b8f13560b99f7c4;hpb=d17db83f9f6dc74ea41cc960770dcbfafa3fef30;p=umlisp.git diff --git a/classes.lisp b/classes.lisp index dbb4bc1..2ca6b77 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.17 2002/11/25 07:45:36 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) @@ -32,7 +32,7 @@ (:default-initargs :sab nil :srl nil) (:title "Source Restriction Level") (:print-slots sab srl) - (:documentation "Custom Table: Source Restriction Level")) + (:description "Custom Table: Source Restriction Level")) (defclass urank (umlsclass) @@ -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) @@ -94,8 +94,8 @@ :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 + (: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) @@ -124,7 +124,7 @@ (: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)) + (: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 @@ -155,7 +155,7 @@ (: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)) + (:print-slots isn fr un sna soui sui)) (defclass uterm (umlsclass) ((lui :type fixnum :initarg :lui :reader lui :reference find-uterm-lui) @@ -298,7 +298,7 @@ (: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)) + (:print-slots eui bas abr eui2 bas2)) (defclass lagr (umlsclass) ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui) @@ -320,7 +320,7 @@ (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :sca nil :com nil) (:title "Complementation") - (:print-slots eui bas sca cam)) + (:print-slots eui bas sca com)) (defclass lmod (umlsclass) ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui) @@ -331,7 +331,7 @@ (:metaclass hyperobject-class) (:default-initargs :eui nil :bas nil :sca nil :psnmod nil :fea nil) (:title "Modifiers") - (:print-slots eui bas scan psnmod fea)) + (:print-slots eui bas sca psnmod fea)) (defclass lnom (umlsclass) ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui) @@ -343,7 +343,7 @@ (: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)) + (:print-slots eui bas sca eui2 bas2 sca2)) (defclass lprn (umlsclass) ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui) @@ -437,7 +437,7 @@ (:metaclass hyperobject-class) (:default-initargs :styrl nil :rl nil :styrl2 nil :ls nil) (:title "Structure of the Network") - (:print-slots styrl rl styl2 ls)) + (:print-slots styrl rl styrl2 ls)) (defclass sstre1 (umlsclass) ((ui :type integer :initarg :ui :reader ui :print-formatter fmt-tui) @@ -459,6 +459,9 @@ ;;; Formatting routines +(defun fmt-comma-integer (i) + (format nil "~:d" i)) + (defgeneric fmt-cui (c)) (defmethod fmt-cui ((c ucon)) (format nil "C~7,'0d" (cui c))) @@ -524,7 +527,7 @@ (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)))) @@ -535,10 +538,10 @@ (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)) + (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)