X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=class-support.lisp;h=5de221198d17be93ccdf74e51607b4ad5861ee66;hb=90dcc29376b4e52a1ba4b7b86dd19ce9f81be4c5;hp=3847eb5ef2813d876b4e41be5b76692a7ac20f4f;hpb=011a13e252a94773802021a264400f696d3b3598;p=umlisp.git

diff --git a/class-support.lisp b/class-support.lisp
index 3847eb5..5de2211 100644
--- a/class-support.lisp
+++ b/class-support.lisp
@@ -150,9 +150,9 @@
 
 (defun check-ui (ui start-char len)
   (when (and (stringp ui)
-	     (= (length ui) (1+ len))
-	     (char-equal start-char (schar ui 0))
-	     (ignore-errors (parse-integer ui :start 1)))
+             (= (length ui) (1+ len))
+             (char-equal start-char (schar ui 0))
+             (ignore-errors (parse-integer ui :start 1)))
     t))
 
 
@@ -171,23 +171,23 @@
       (or (not is-term) is-english)))
 
 (defun print-umlsclass (obj &key (stream *standard-output*)
-			(vid :compact-text)
-			(file-wrapper nil) (english-only t) (subobjects nil)
-			(refvars nil) (link-printer nil))
+                        (vid :compact-text)
+                        (file-wrapper nil) (english-only t) (subobjects nil)
+                        (refvars nil) (link-printer nil))
   (view obj :stream stream :vid vid :subobjects subobjects
-	:file-wrapper file-wrapper
-	:filter (if english-only nil #'english-term-filter)
-	:link-printer link-printer
-	:refvars refvars))
+        :file-wrapper file-wrapper
+        :filter (if english-only nil #'english-term-filter)
+        :link-printer link-printer
+        :refvars refvars))
 
 (defmacro define-lookup-display (newfuncname lookup-func)
   "Defines functions for looking up and displaying objects"
   `(defun ,newfuncname  (keyval &key (stream *standard-output*) (vid :compact-text)
-			 (file-wrapper t) (english-only nil) (subobjects nil))
+                         (file-wrapper t) (english-only nil) (subobjects nil))
      (let ((obj (funcall ,lookup-func keyval)))
        (print-umlsclass obj :stream stream :vid vid
-			:file-wrapper file-wrapper :english-only english-only
-			:subobjects subobjects)
+                        :file-wrapper file-wrapper :english-only english-only
+                        :subobjects subobjects)
        obj)))
 
 (define-lookup-display display-con #'find-ucon-cui)
@@ -214,14 +214,14 @@
 
 (defmethod mesh-number ((ustr ustr))
   (let ((codes
-	 (map-and-remove-nils
-	  (lambda (sat)
-	    (when (and (string-equal "MSH" (sab sat))
-		       (string-equal "MN" (atn sat)))
-	      (atv sat)))
-	  (s#sat ustr))))
+         (map-and-remove-nils
+          (lambda (sat)
+            (when (and (string-equal "MSH" (sab sat))
+                       (string-equal "MN" (atn sat)))
+              (atv sat)))
+          (s#sat ustr))))
     (if (= 1 (length codes))
-	(car codes)
+        (car codes)
       codes)))
 
 (defun ucon-ustrs (ucon)
@@ -229,7 +229,7 @@
   (let (res)
     (dolist (term (s#term ucon) (nreverse res))
       (dolist (str (s#str term))
-	(push str res)))))
+        (push str res)))))
 
 
 (defmethod pfstr ((uterm uterm))
@@ -318,44 +318,17 @@
     (setq stt (subseq stt 1)))
   (loop for c across stt
       collect
-	(cond
-	 ((char-equal #\C c)
-	  "Upper/lower case")
-	 ((char-equal #\W c)
-	  "Word order")
-	 ((char-equal #\S c)
-	  "Singular")
-	 ((char-equal #\P c)
-	  "Plural")
-	 ((char-equal #\O c)
-	  "Other"))))
-
-
-(defgeneric cxt-ancestors (obj))
-(defmethod cxt-ancestors ((con ucon))
-  (loop for term in (s#term con)
-      append (cxt-ancestors term)))
-
-
-(defmethod cxt-ancestors ((term uterm))
-  (loop for str in (s#str term)
-      append (cxt-ancestors str)))
-
-(defmethod cxt-ancestors ((str ustr))
-  "Return the ancestory contexts of a ustr"
-  (let* ((anc (remove-if-not
-	       (lambda (cxt) (string-equal "ANC" (cxl cxt)))
-	       (s#cxt str)))
-	 (num-contexts (if anc
-			   (apply #'max (mapcar (lambda (cxt) (cxn cxt)) anc))
-			 0))
-	 (anc-lists '()))
-    (dotimes (i num-contexts (nreverse anc-lists))
-      (let* ((anc-this-cxn (remove-if-not
-			    (lambda (cxt) (= (1+ i) (cxn cxt))) anc)))
-	(push
-	 (sort anc-this-cxn (lambda (a b) (< (rank a) (rank b))))
-	 anc-lists)))))
+        (cond
+         ((char-equal #\C c)
+          "Upper/lower case")
+         ((char-equal #\W c)
+          "Word order")
+         ((char-equal #\S c)
+          "Singular")
+         ((char-equal #\P c)
+          "Plural")
+         ((char-equal #\O c)
+          "Other"))))
 
 (defun uso-unique-codes (usos)
   (let ((sab-codes (make-hash-table :test 'equal)))