r9507: rrf updates

[umlisp.git] / class-support.lisp

diff --git a/class-support.lisp b/class-support.lisp
index a085828956576010adfb476ebf66fd5a30da0af6..208e1a3e23f368d710089a6312a06b3030dd30e8 100644 (file)
--- a/class-support.lisp
+++ b/class-support.lisp
@@ -2,15 +2,15 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Name:         classes-support.lisp
-;;;; Purpose:      Support for UMLisp classes
-;;;; Author:       Kevin M. Rosenberg
-;;;; Date Started: Apr 2000
+;;;; Name:     classes-support.lisp
+;;;; Purpose:  Support for UMLisp classes
+;;;; Author:   Kevin M. Rosenberg
+;;;; Created:  Apr 2000
 ;;;;
-;;;; $Id: class-support.lisp,v 1.19 2003/07/21 08:41:44 kevin Exp $
+;;;; $Id$
 ;;;;
 ;;;; This file, part of UMLisp, is
-;;;;    Copyright (c) 2000-2003 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.
@@ -18,7 +18,6 @@
 
 (in-package #:umlisp)
 
-
 ;;; Formatting routines
 
 (defgeneric fmt-cui (c))
@@ -67,7 +66,16 @@
 (defmethod fmt-tui ((tui string))
   (if (eql (aref tui 0) #\T)
       tui
-      (fmt-tui (parse-integer tui))))
+    (fmt-tui (parse-integer tui))))
+
+(defgeneric fmt-aui (aui))
+(defmethod fmt-aui ((aui fixnum))
+  (prefixed-fixnum-string aui #\A 7))
+
+(defmethod fmt-aui ((aui string))
+  (if (eql (aref aui 0) #\A)
+      aui
+      (fmt-aui (parse-integer aui))))
 
 (defgeneric fmt-eui (e))
 (defmethod fmt-eui ((e fixnum))
@@ -170,11 +178,12 @@
 
 (defmethod mesh-number ((ustr ustr))
   (let ((codes
-        (filter (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)
       codes)))