r9104: update dates/headers

[umlisp.git] / classes.lisp

diff --git a/classes.lisp b/classes.lisp
index fe8bf41b2aae859fb263706591fe91d3f2eedf2b..7c3b9a86f19bad14e7596d649aa8ae5a6b9362b6 100644 (file)
--- a/classes.lisp
+++ b/classes.lisp
@@ -2,22 +2,21 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; Name:          classes.lisp
-;;;; Purpose:       Class defintions for UMLisp
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Apr 2000
+;;;; Name:     classes.lisp
+;;;; Purpose:  Class defintions for UMLisp
+;;;; Author:   Kevin M. Rosenberg
+;;;; Created:  Apr 2000

 ;;;;
 ;;;;

-;;;; $Id: classes.lisp,v 1.31 2003/04/17 05:39:31 kevin Exp $
+;;;; $Id$

 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;
 ;;;; This file, part of UMLisp, is

-;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;    Copyright (c) 2000-2004 by Kevin M. Rosenberg, M.D.

 ;;;;
 ;;;; UMLisp users are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the GNU General Public License.
 ;;;; *************************************************************************
 
 ;;;;
 ;;;; UMLisp users are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the GNU General Public License.
 ;;;; *************************************************************************
 

-(in-package :umlisp)
-(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
+(in-package #:umlisp)

 
 (defclass umlsclass (hyperobject)
   ()
 
 (defclass umlsclass (hyperobject)
   ()


@@ -63,12 +62,13 @@
   ((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)
   ((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)
+   (rsab :value-type string :initarg :rsab :reader rsab :hyperlink find-ustr-sab
+        :hyperlink-parameters (("subobjects" . "no")))

    (son :value-type string :initarg :son :reader son)
    (sf :value-type string :initarg :sf :reader sf)
    (sver :value-type string :initarg :sver :reader sver)
    (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)
+   (vstart :value-type string :initarg :vstart :reader vstart)
+   (vend :value-type string :initarg :vend :reader vend)

    (imeta :value-type string :initarg :imeta :reader imeta)
    (rmeta :value-type string :initarg :rmeta :reader rmeta)
    (slc :value-type cdata :initarg :slc :reader slc)
    (imeta :value-type string :initarg :imeta :reader imeta)
    (rmeta :value-type string :initarg :rmeta :reader rmeta)
    (slc :value-type cdata :initarg :slc :reader slc)


@@ -85,7 +85,7 @@
    (sabin :value-type string :initarg :sabin :reader sabin))
   (:metaclass hyperobject-class)
   (:user-name "Source Abbreviation")
    (sabin :value-type string :initarg :sabin :reader sabin))
   (:metaclass hyperobject-class)
   (:user-name "Source Abbreviation")

-  (:default-print-slots vcui rcui vsab rsab son sf sver mstart mend imeta
+  (:default-print-slots vcui rcui vsab rsab son sf sver vstart vend imeta

                rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc
                curver sabin))
 
                rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc
                curver sabin))
 


@@ -159,7 +159,8 @@
 
 (defclass usty (umlsclass)
   ((tui :value-type fixnum :initarg :tui :reader tui :print-formatter fmt-tui
 
 (defclass usty (umlsclass)
   ((tui :value-type fixnum :initarg :tui :reader tui :print-formatter fmt-tui

-       :hyperlink (find-ucon-tui ("subobjects" "no")))
+       :hyperlink find-ucon-tui
+       :hyperlink-parameters (("subobjects" . "no")))

    (sty :value-type string :initarg :sty :reader sty))
   (:metaclass hyperobject-class)
   (:user-name "Semantic Type")
    (sty :value-type string :initarg :sty :reader sty))
   (:metaclass hyperobject-class)
   (:user-name "Semantic Type")


@@ -224,7 +225,18 @@
    (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)
    (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)

-  (:user-name "XW Index")
+  (:user-name "XW Index" "XW Indices")
+  (:default-print-slots wd cui lui sui))
+
+(defclass uxw-noneng (umlsclass)
+  ((lat :value-type string :initarg :lat :reader lat)
+   (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)
+   (lrl :value-type fixnum :initform nil :initarg :lrl :reader lrl))
+  (:metaclass hyperobject-class)
+  (:user-name "XW Non-English Index" "XW Non-English Indices")

   (:default-print-slots wd cui lui sui))
 
 (defclass uxnw (umlsclass)
   (:default-print-slots wd cui lui sui))
 
 (defclass uxnw (umlsclass)


@@ -232,7 +244,7 @@
    (nwd :value-type string :initarg :nwd :reader nwd)
    (cuilist :value-type list :initarg :cuilist :reader uxnw-cuilist))
   (:metaclass hyperobject-class)
    (nwd :value-type string :initarg :nwd :reader nwd)
    (cuilist :value-type list :initarg :cuilist :reader uxnw-cuilist))
   (:metaclass hyperobject-class)

-  (:user-name "XNW Index")
+  (:user-name "XNW Index" "XNW Indices")

   (:default-print-slots lat nwd cuilist))
 
 (defclass uxns (umlsclass)
   (:default-print-slots lat nwd cuilist))
 
 (defclass uxns (umlsclass)


@@ -240,7 +252,7 @@
    (nstr :value-type string :initarg :nstr :reader nstr)
    (cuilist :value-type list :initarg :cuilist :reader cuilist))
   (:metaclass hyperobject-class)
    (nstr :value-type string :initarg :nstr :reader nstr)
    (cuilist :value-type list :initarg :cuilist :reader cuilist))
   (:metaclass hyperobject-class)

-  (:user-name "XNS Index")
+  (:user-name "XNS Index" "XNS Indices")

   (:default-print-slots lat nstr cuilist))
 
 
   (:default-print-slots lat nstr cuilist))
 
 


@@ -272,7 +284,7 @@
    (eui2 :value-type integer :initarg :eui2 :reader eui2 :print-formatter fmt-eui)
    (bas2 :value-type string :initarg :bas2 :reader bas2))
   (:metaclass hyperobject-class)
    (eui2 :value-type integer :initarg :eui2 :reader eui2 :print-formatter fmt-eui)
    (bas2 :value-type string :initarg :bas2 :reader bas2))
   (:metaclass hyperobject-class)

-  (:user-name "Abbreviations and Acronyms")
+  (:user-name "Abbreviations and Acronym")

   (:default-print-slots eui bas abr eui2 bas2))
 
 (defclass lagr  (umlsclass)
   (:default-print-slots eui bas abr eui2 bas2))
 
 (defclass lagr  (umlsclass)


@@ -302,7 +314,7 @@
    (psnmod :value-type string :initarg :psnmod :reader psnmod)
    (fea :value-type string :initarg :fea :reader fea))
   (:metaclass hyperobject-class)
    (psnmod :value-type string :initarg :psnmod :reader psnmod)
    (fea :value-type string :initarg :fea :reader fea))
   (:metaclass hyperobject-class)

-  (:user-name "Modifiers")
+  (:user-name "Modifier")

   (:default-print-slots eui bas sca psnmod fea))
 
 (defclass lnom  (umlsclass)
   (:default-print-slots eui bas sca psnmod fea))
 
 (defclass lnom  (umlsclass)


@@ -313,7 +325,7 @@
    (bas2 :value-type string :initarg :bas2 :reader bas2)
    (sca2 :value-type string :initarg :sca2 :reader sca2))
   (:metaclass hyperobject-class)
    (bas2 :value-type string :initarg :bas2 :reader bas2)
    (sca2 :value-type string :initarg :sca2 :reader sca2))
   (:metaclass hyperobject-class)

-  (:user-name "Nominalizations")
+  (:user-name "Nominalization")

   (:default-print-slots eui bas sca eui2 bas2 sca2))
 
 (defclass lprn  (umlsclass)
   (:default-print-slots eui bas sca eui2 bas2 sca2))
 
 (defclass lprn  (umlsclass)


@@ -326,7 +338,7 @@
    (qnt :value-type string :initarg :qnt :reader qnt)
    (fea :value-type string :initarg :fea :reader fea))
   (:metaclass hyperobject-class)
    (qnt :value-type string :initarg :qnt :reader qnt)
    (fea :value-type string :initarg :fea :reader fea))
   (:metaclass hyperobject-class)

-  (:user-name "Pronouns")
+  (:user-name "Pronoun")

   (:default-print-slots eui bas num gnd cas pos qnt fea))
 
 (defclass lprp  (umlsclass)
   (:default-print-slots eui bas num gnd cas pos qnt fea))
 
 (defclass lprp  (umlsclass)


@@ -336,7 +348,7 @@
    (sca :value-type string :initarg :sca :reader sca)
    (fea :value-type string :initarg :fea :reader fea))
   (:metaclass hyperobject-class)
    (sca :value-type string :initarg :sca :reader sca)
    (fea :value-type string :initarg :fea :reader fea))
   (:metaclass hyperobject-class)

-  (:user-name "Properties")
+  (:user-name "Property" "Properties")

   (:default-print-slots eui bas str sca fea))
 
 
   (:default-print-slots eui bas str sca fea))
 
 


@@ -345,7 +357,7 @@
    (spv :value-type string :initarg :spv :reader spv)
    (bas :value-type string :initarg :bas :reader bas))
   (:metaclass hyperobject-class)
    (spv :value-type string :initarg :spv :reader spv)
    (bas :value-type string :initarg :bas :reader bas))
   (:metaclass hyperobject-class)

-  (:user-name "Spelling Variants")
+  (:user-name "Spelling Variant")

   (:default-print-slots eui spv bas))
 
 
   (:default-print-slots eui spv bas))
 
 


@@ -354,7 +366,7 @@
    (bas :value-type string :initarg :bas :reader bas)
    (gen :value-type string :initarg :gen :reader gen))
   (:metaclass hyperobject-class)
    (bas :value-type string :initarg :bas :reader bas)
    (gen :value-type string :initarg :gen :reader gen))
   (:metaclass hyperobject-class)

-  (:user-name "Trade Marks")
+  (:user-name "Trade Mark")

   (:default-print-slots eui bas gen))
 
 (defclass ltyp  (umlsclass)
   (:default-print-slots eui bas gen))
 
 (defclass ltyp  (umlsclass)


@@ -370,7 +382,7 @@
   ((wrd :value-type string :initarg :wrd :reader wrd)
    (euilist :value-type list :initarg :euilist :reader euilist))
   (:metaclass hyperobject-class)
   ((wrd :value-type string :initarg :wrd :reader wrd)
    (euilist :value-type list :initarg :euilist :reader euilist))
   (:metaclass hyperobject-class)

-  (:user-name "Lexical Word Index")
+  (:user-name "Lexical Word Index" "Lexical Word Indices")

   (:default-print-slots wrd euilist))
 
 ;;; Semantic NET objects
   (:default-print-slots wrd euilist))
 
 ;;; Semantic NET objects


@@ -387,7 +399,7 @@
    (abr :value-type string :initarg :abr :reader abr)
    (rin :value-type string :initarg :rin :reader rin))
   (:metaclass hyperobject-class)
    (abr :value-type string :initarg :abr :reader abr)
    (rin :value-type string :initarg :rin :reader rin))
   (:metaclass hyperobject-class)

-  (:user-name "Basic information about Semantic Types and Relations")
+  (:user-name "Basic information about Semantic Types and Relation")

   (:default-print-slots rt ui styrl stnrtn def ex un rh abr rin))
 
 (defclass sstr (umlsclass)
   (:default-print-slots rt ui styrl stnrtn def ex un rh abr rin))
 
 (defclass sstr (umlsclass)


@@ -404,7 +416,8 @@
    (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)
    (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)

-  (:user-name "Fully Inherited Set of Releatons (TUI's)")
+  (:user-name "Fully Inherited Set of Relation (TUIs)"
+             "Fully Inherited Set of Relations (TUIs)")

   (:default-print-slots ui ui2 ui3))
 
 (defclass sstre2 (umlsclass)
   (:default-print-slots ui ui2 ui3))
 
 (defclass sstre2 (umlsclass)


@@ -412,6 +425,76 @@
    (rl :value-type string :initarg :ui2 :reader rl)
    (sty2 :value-type string :initarg :ui3 :reader sty2))
   (:metaclass hyperobject-class)
    (rl :value-type string :initarg :ui2 :reader rl)
    (sty2 :value-type string :initarg :ui3 :reader sty2))
   (:metaclass hyperobject-class)

-  (:user-name "Fully Inherited Set of Releatons (strings)")
+  (:user-name "Fully Inherited Set of Relation (strings)"
+             "Fully Inherited Set of Relations (strings)")

   (:default-print-slots sty rl sty2))
 
   (:default-print-slots sty rl sty2))
 

+
+;;; **************************
+;;; Local Classes
+;;; **************************
+
+(defclass ustats (umlsclass)
+  ((name :value-type string :initarg :name :reader name)
+   (hits :value-type integer :initarg :hits :reader hits
+        :user-name "count"
+        :print-formatter fmt-comma-integer)
+   (srl :value-type fixnum :initarg :srl :reader srl))
+  (:metaclass hyperobject-class)
+  (:default-initargs :name nil :hits nil :srl nil)
+  (:user-name "UMLS Statistic")
+  (:default-print-slots name hits srl)
+  (:documentation "Custom Table: UMLS Database statistics."))
+
+  
+(defclass bsab (umlsclass)
+  ((sab :value-type string :initarg :sab :reader sab
+       :hyperlink find-ustr-sab
+       :hyperlink-parameters (("subobjects" . "no")))
+   (name :value-type string :initarg :name :reader name)
+   (hits :value-type fixnum :initarg :hits :reader hits
+        :user-name "count"
+        :print-formatter fmt-comma-integer))
+  (:metaclass hyperobject-class)
+  (:default-initargs :sab nil :name nil :hits nil)
+  (:user-name "Source of Abbreviation")
+  (:default-print-slots sab name hits)
+  (:documentation "Bonus SAB file"))
+  
+(defclass btty (umlsclass)
+  ((tty :value-type string :initarg :tty :reader tty)
+   (name :value-type string :initarg :name :reader name)
+   (hits :value-type fixnum :initarg :hits :reader hits
+        :user-name "count"
+        :print-formatter fmt-comma-integer))
+  (:metaclass hyperobject-class)
+  (:default-initargs :tty nil :name nil :hits nil)
+  (:user-name "Bonus TTY")
+  (:default-print-slots tty name hits)
+  (:documentation "Bonus TTY file"))
+  
+(defclass brel (umlsclass)
+  ((sab :value-type string :initarg :sab :reader sab)
+   (sl :value-type string :initarg :sl :reader sl)
+   (rel :value-type string :initarg :rel :reader rel)
+   (rela :value-type string :initarg :rela :reader rela)
+   (hits :value-type fixnum :initarg :hits :reader hits
+        :user-name "count"
+        :print-formatter fmt-comma-integer))
+  (:metaclass hyperobject-class)
+  (:default-initargs :sab nil :sl nil :rel nil :rela nil :hits nil)
+  (:user-name "Bonus REL")
+  (:default-print-slots sab sl rel rela hits)
+  (:documentation "Bonus REL file"))
+
+(defclass batn (umlsclass)
+  ((sab :value-type string :initarg :sab :reader sab)
+   (atn :value-type string :initarg :atn :reader atn)
+   (hits :value-type fixnum :initarg :hits :reader hits
+        :user-name "count"
+        :print-formatter fmt-comma-intger))
+  (:metaclass hyperobject-class)
+  (:default-initargs :sab nil :atn nil)
+  (:user-name "Bonus ATN")
+  (:default-print-slots sab atn hits)
+  (:documentation "Bonus ATN file"))