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
 ;;;;
-;;;; $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.
@@ -31,7 +31,7 @@
   (: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"))
 
   
@@ -43,7 +43,7 @@
   (: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)
@@ -51,7 +51,7 @@
   (: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)
@@ -61,7 +61,7 @@
   (: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)
@@ -94,7 +94,7 @@
                     :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))
 
@@ -106,7 +106,7 @@
   (: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)
@@ -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")
-  (: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
@@ -144,7 +144,7 @@
   (: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)
@@ -156,7 +156,7 @@
   (: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
@@ -171,7 +171,7 @@
   (: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
@@ -180,7 +180,7 @@
   (: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)
@@ -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")
-  (: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)
@@ -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")
-  (:print-slots soc cot cof coa cui2 pfstr2))
+  (:default-print-slots soc cot cof coa cui2 pfstr2))
 
        
 (defclass uatx (umlsclass)
@@ -221,7 +221,7 @@
   (: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
@@ -239,7 +239,7 @@
   (: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)
@@ -249,7 +249,7 @@
   (: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)
@@ -258,7 +258,7 @@
   (: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)
@@ -267,7 +267,7 @@
   (: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
@@ -289,7 +289,7 @@
   (: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)
@@ -301,7 +301,7 @@
   (: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)
@@ -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")
-  (: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)
@@ -323,7 +323,7 @@
   (: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)
@@ -334,7 +334,7 @@
   (: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)
@@ -346,7 +346,7 @@
   (: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)
@@ -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")
-  (: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)
@@ -372,7 +372,7 @@
   (: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)
@@ -382,7 +382,7 @@
   (: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)
@@ -392,7 +392,7 @@
   (: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)
@@ -402,7 +402,7 @@
   (: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)
@@ -410,7 +410,7 @@
   (: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
 
@@ -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")
-  (: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)
@@ -440,7 +440,7 @@
   (: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)
@@ -449,7 +449,7 @@
   (: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)
@@ -458,7 +458,7 @@
   (: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
 
@@ -531,22 +531,25 @@
       (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)))

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
 ;;;;
-;;;; $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.
@@ -50,8 +50,7 @@
        (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))
 
@@ -70,28 +69,28 @@
   (: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")
-  (: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")
-  (: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")
-  (:print-slots tui freq sty)
+  (:default-print-slots tui freq sty)
   (:description "Composite object of usty/freq"))
 
 (defun find-usty_freq-all ()
@@ -109,7 +108,7 @@
   ()
   (: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