r3613: *** empty log message ***

diff --git a/classes.lisp b/classes.lisp
index 0ae8ad0d2a42a6770154c266d6f8eb2b747c2439..09b1e9e0b7a7506eee9f36ef8d01bac08ba3a019 100644 (file)
--- a/classes.lisp
+++ b/classes.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
 ;;;; 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.
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.


@@ -31,7 +31,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :sab nil :srl nil)
   (:user-name "Source Restriction Level")
   (: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"))
 
   
   (:description "Custom Table: Source Restriction Level"))
 
   


@@ -43,7 +43,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :rank nil :sab nil :tty nil :supres nil)
   (:user-name "Rank")
   (: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)
 
 (defclass udef (umlsclass)
   ((def :type cdata :initarg :def :reader def)


@@ -51,7 +51,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :def nil :sab nil)
   (:user-name "Definition")
   (: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)
 
 (defclass usat (umlsclass)
   ((sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)


@@ -61,7 +61,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :sab nil :code nil :atn nil :atv nil)
   (:user-name "Simple Attribute")
   (: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)
 
 (defclass usab (umlsclass)
   ((vcui :type fixnum :initarg :vcui :reader vcui :print-formatter fmt-cui)


@@ -94,7 +94,7 @@
                     :ttyl nil :atnl nil :lat nil :cenc nil :curver nil
                     :sabin nil)
   (:user-name "Source Abbreviation")
                     :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))
 
                rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc
                curver sabin))
 


@@ -106,7 +106,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :sab nil :code nil :tty nil :srl nil)
   (:user-name "Source")
   (: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)
 
 (defclass ucxt (umlsclass)
   ((sab :type string :initarg :sab :reader sab :hyperlink find-usab-rsab)


@@ -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)
   (:user-name "Context")
   (: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
 
 (defclass ustr (umlsclass)
   ((sui :type fixnum :initarg :sui :reader sui :print-formatter fmt-sui


@@ -144,7 +144,7 @@
   (:default-initargs 
    :sui nil :cui nil :lui nil :cuisui nil :str nil :lrl nil :stt nil)
   (:user-name "String")
   (: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)
 
 (defclass ulo (umlsclass)
   ((isn :type string :initarg :isn :reader isn)


@@ -156,7 +156,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :isn nil :fr nil :un nil :sui nil :sna nil :soui nil)
   (:user-name "Locator")
   (: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
 
 (defclass uterm (umlsclass)
   ((lui :type fixnum :initarg :lui :reader lui :print-formatter fmt-lui


@@ -171,7 +171,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :lui nil :cui nil :lat nil :ts nil :lrl nil)
   (:user-name "Term")
   (: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
 
 (defclass usty (umlsclass)
   ((tui :type fixnum :initarg :tui :reader tui :print-formatter fmt-tui


@@ -180,7 +180,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :tui nil :sty nil)
   (:user-name "Semantic Type")
   (: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)
 
 (defclass urel (umlsclass)
   ((rel :type string :initarg :rel :reader rel :hyperlink find-brel-rel)


@@ -196,7 +196,7 @@
   (:default-initargs 
    :rel nil :cui1 nil :cui2 nil :pfstr2 nil :rela nil :sab nil :sl nil :mg nil)
   (:user-name "Relationship")
   (: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)
        
 (defclass ucoc (umlsclass)
   ((cui1 :type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui)


@@ -211,7 +211,7 @@
   (:default-initargs 
    :cui1 nil :cui2 nil :pfstr2 nil :soc nil :cot nil :cof nil :coa nil)
   (:user-name "Co-occuring Concept")
   (: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)
 
        
 (defclass uatx (umlsclass)


@@ -221,7 +221,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :sab nil :rel nil :atx nil)
   (:user-name "Associated Expression")
   (: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
 
 (defclass ucon (umlsclass)
   ((cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui


@@ -239,7 +239,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :cui nil :pfstr nil :lrl nil)
   (:user-name "Concept")
   (: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)
 
 (defclass uxw (umlsclass)
   ((wd :type string :initarg :wd :reader wd)


@@ -249,7 +249,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :wd nil :cui nil :lui nil :sui nil)
   (:user-name "XW Index")
   (: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)
 
 (defclass uxnw (umlsclass)
   ((lat :type string :initarg :lat :reader lat)


@@ -258,7 +258,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :lat nil :nwd nil :cuilist nil)
   (:user-name "XNW Index")
   (: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)
 
 (defclass uxns (umlsclass)
   ((lat :type string :initarg :lat :reader lat)


@@ -267,7 +267,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :lat nil :nstr nil :cuilist nil)
   (:user-name "XNS Index")
   (: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
 
 
 ;;; LEX objects


@@ -289,7 +289,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :wrd nil)
   (:user-name "Lexical Term")
   (: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)
 
 
 (defclass labr  (umlsclass)


@@ -301,7 +301,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :abr nil :eui2 nil :bas2 nil)
   (:user-name "Abbreviations and Acronyms")
   (: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)
 
 (defclass lagr  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)


@@ -313,7 +313,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :str nil :sca nil :agr nil :cit nil :bas nil)
   (:user-name "Agreement and Inflection")
   (: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)
 
 (defclass lcmp  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)


@@ -323,7 +323,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :sca nil :com nil)
   (:user-name "Complementation")
   (: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)
 
 (defclass lmod  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)


@@ -334,7 +334,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :sca nil :psnmod nil :fea nil)
   (:user-name "Modifiers")
   (: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)
 
 (defclass lnom  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)


@@ -346,7 +346,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :sca nil :eui2 nil :bas2 nil :sca2 nil)
   (:user-name "Nominalizations")
   (: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)
 
 (defclass lprn  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)


@@ -361,7 +361,7 @@
   (:default-initargs :eui nil :bas nil :num nil :gnd nil :cas nil
                     :pos nil :qnt nil :fea nil)
   (:user-name "Pronouns")
   (: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)
 
 (defclass lprp  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)


@@ -372,7 +372,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :str nil :sca nil :fea nil)
   (:user-name "Properties")
   (: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)
 
 
 (defclass lspl  (umlsclass)


@@ -382,7 +382,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :spv nil :bas nil)
   (:user-name "Spelling Variants")
   (: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)
 
 
 (defclass ltrm  (umlsclass)


@@ -392,7 +392,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :gen nil)
   (:user-name "Trade Marks")
   (: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)
 
 (defclass ltyp  (umlsclass)
   ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)


@@ -402,7 +402,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :eui nil :bas nil :sca nil :typ nil)
   (:user-name "Inflection Type")
   (: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)
 
 (defclass lwd (umlsclass)
   ((wrd :type string :initarg :wrd :reader wrd)


@@ -410,7 +410,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :wrd nil :euilist nil)
   (:user-name "Lexical Word Index")
   (: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
 
 
 ;;; Semantic NET objects
 


@@ -430,7 +430,7 @@
    :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")
    :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)
 
 (defclass sstr (umlsclass)
   ((styrl :type string :initarg :styrl :reader styrl)


@@ -440,7 +440,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :styrl nil :rl nil :styrl2 nil :ls nil)
   (:user-name "Structure of the Network")
   (: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)
 
 (defclass sstre1 (umlsclass)
   ((ui :type integer :initarg :ui :reader ui :print-formatter fmt-tui)


@@ -449,7 +449,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :ui nil :ui2 nil :ui3 nil)
   (:user-name "Fully Inherited Set of Releatons (TUI's)")
   (: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)
 
 (defclass sstre2 (umlsclass)
   ((sty :type string :initarg :ui :reader sty)


@@ -458,7 +458,7 @@
   (:metaclass hyperobject-class)
   (:default-initargs :sty nil :rl nil :sty2 nil)
   (:user-name "Fully Inherited Set of Releatons (strings)")
   (: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
 
 
 ;;; Formatting routines
 


@@ -531,22 +531,25 @@
       (values (string-equal (lat obj) "ENG") t)
     (values nil nil))))
 
       (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
        :file-wrapper file-wrapper

-       :english-only-function (if english-only #'english-term-p nil)
+       :filter (if english-only nil #'english-term-filter)

        :refvars refvars))
 
        :refvars refvars))
 

-

 (defmacro define-lookup-display (newfuncname lookup-func)
   "Defines functions for looking up and displaying objects"
 (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)))
      (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)))
                        :file-wrapper file-wrapper :english-only english-only
                        :subobjects subobjects)
        obj)))

diff --git a/composite.lisp b/composite.lisp
index c9f8dc0deb4fe82a668d5309204caef64f16e5fc..0489853ff1fc11461c39d033620e6cc5ecc04bb8 100644 (file)
--- a/composite.lisp
+++ b/composite.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;

-;;;; $Id: composite.lisp,v 1.17 2002/12/09 14:11:09 kevin Exp $
+;;;; $Id: composite.lisp,v 1.18 2002/12/13 05:43:38 kevin Exp $

 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.


@@ -50,8 +50,7 @@
        (aif (funcall cui2-func c)
             (let ((ucon2 (find-ucon-cui it)))
               (when (ucon-is-tui? ucon2 tui)
        (aif (funcall cui2-func c)
             (let ((ucon2 (find-ucon-cui it)))
               (when (ucon-is-tui? ucon2 tui)

-                ucon2))
-            nil))
+                ucon2)) nil))

     (funcall related-con-func ucon))
    :key #'cui))
 
     (funcall related-con-func ucon))
    :key #'cui))
 


@@ -70,28 +69,28 @@
   (:metaclass hyperobject-class)
   (:default-initargs :freq 0)
   (:user-name "Frequency class")
   (:metaclass hyperobject-class)
   (:default-initargs :freq 0)
   (:user-name "Frequency class")

-  (:print-slots freq)
+  (:default-print-slots freq)

   (:description "Base class containing frequency slot, used for multi-inherited objects"))
 
 (defclass ucon_freq (ucon freq)
   ()
   (:metaclass hyperobject-class)
   (:user-name "Concept and Count")
   (:description "Base class containing frequency slot, used for multi-inherited objects"))
 
 (defclass ucon_freq (ucon freq)
   ()
   (:metaclass hyperobject-class)
   (:user-name "Concept and Count")

-  (:print-slots cui freq pfstr)
+  (:default-print-slots cui freq pfstr)

   (:description "Composite object of ucon/freq"))
 
 (defclass ustr_freq (ustr freq)
   ()
   (:metaclass hyperobject-class)
   (:user-name "String and Count")
   (:description "Composite object of ucon/freq"))
 
 (defclass ustr_freq (ustr freq)
   ()
   (:metaclass hyperobject-class)
   (:user-name "String and Count")

-  (:print-slots sui freq stt lrl str)
+  (:default-print-slots sui freq stt lrl str)

   (:description "Composite object of ustr/freq"))
 
 (defclass usty_freq (usty freq)
   ((freq :type fixnum :initarg :freq :accessor freq))
   (:metaclass hyperobject-class)
   (:user-name "Semantic Type and Count")
   (:description "Composite object of ustr/freq"))
 
 (defclass usty_freq (usty freq)
   ((freq :type fixnum :initarg :freq :accessor freq))
   (:metaclass hyperobject-class)
   (:user-name "Semantic Type and Count")

-  (:print-slots tui freq sty)
+  (:default-print-slots tui freq sty)

   (:description "Composite object of usty/freq"))
 
 (defun find-usty_freq-all ()
   (:description "Composite object of usty/freq"))
 
 (defun find-usty_freq-all ()


@@ -109,7 +108,7 @@
   ()
   (:metaclass hyperobject-class)
   (:user-name "Source and Count")
   ()
   (:metaclass hyperobject-class)
   (:user-name "Source and Count")

-  (:print-slots sab freq srl)
+  (:default-print-slots sab freq srl)

   (:description "Composite object of usrl/freq"))
 
 ;; Frequency finding functions
   (:description "Composite object of usrl/freq"))
 
 ;; Frequency finding functions