r11099: add error checking

[umlisp.git] / class-support.lisp

diff --git a/class-support.lisp b/class-support.lisp
index 8cec597731d5aa6828c84e7dcdf4056f74142531..a9fae985c89b54108da0d916d6c52c6c7ea19571 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$
 ;;;;
 ;;;; This file, part of UMLisp, is
-;;;;    Copyright (c) 2000-2003 by Kevin M. Rosenberg, M.D.
+;;;;    Copyright (c) 2000-2006 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,15 +18,18 @@
 
 (in-package #:umlisp)
 
-
 ;;; Formatting routines
 
 (defgeneric fmt-cui (c))
 (defmethod fmt-cui ((c ucon))
   (fmt-cui (cui c)))
 
-(defmethod fmt-cui ((c fixnum))
-  (prefixed-fixnum-string c #\C 7))
+(when *has-fixnum-class*
+  (defmethod fmt-cui ((c fixnum))
+    (prefixed-fixnum-string c #\C 7)))
+
+(defmethod fmt-cui ((c integer))
+    (prefixed-integer-string c #\C 7))
 
 (defmethod fmt-cui ((c string))
   (if (eql (aref c 0) #\C)
@@ -40,8 +43,12 @@
 (defmethod fmt-lui ((l uterm))
   (fmt-lui (lui l)))
 
-(defmethod fmt-lui ((l fixnum))
-  (prefixed-fixnum-string l #\L 7))
+(when *has-fixnum-class*
+  (defmethod fmt-lui ((l fixnum))
+    (prefixed-fixnum-string l #\L 7)))
+
+(defmethod fmt-lui ((l integer))
+  (prefixed-integer-string l #\L 7))
 
 (defmethod fmt-lui ((l string))
   (if (eql (aref l 0) #\L)
@@ -52,8 +59,12 @@
 (defmethod fmt-sui ((s ustr))
   (fmt-sui (sui s)))
 
-(defmethod fmt-sui ((s fixnum))
-  (prefixed-fixnum-string s #\S 7))
+(when *has-fixnum-class*
+  (defmethod fmt-sui ((s fixnum))
+    (prefixed-fixnum-string s #\S 7)))
+
+(defmethod fmt-sui ((s integer))
+  (prefixed-integer-string s #\S 7))
 
 (defmethod fmt-sui ((s string))
   (if (eql (aref s 0) #\S)
@@ -61,17 +72,38 @@
       (fmt-sui (parse-integer s))))
 
 (defgeneric fmt-tui (tui))
-(defmethod fmt-tui ((tui fixnum))
-  (prefixed-fixnum-string tui #\T 3))
+(when *has-fixnum-class*
+  (defmethod fmt-tui ((tui fixnum))
+    (prefixed-fixnum-string tui #\T 3)))
+
+(defmethod fmt-tui ((tui integer))
+  (prefixed-integer-string tui #\T 3))
 
 (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))
+(when *has-fixnum-class*
+  (defmethod fmt-aui ((aui fixnum))
+    (prefixed-fixnum-string aui #\A 7)))
+
+(defmethod fmt-aui ((aui integer))
+  (prefixed-integer-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))
-  (prefixed-fixnum-string e #\E 7))
+(when *has-fixnum-class*
+  (defmethod fmt-eui ((e fixnum))
+    (prefixed-fixnum-string e #\E 7)))
+
+(defmethod fmt-eui ((e integer))
+  (prefixed-integer-string e #\E 7))
 
 (defmethod fmt-eui ((e string))
   (if (eql (aref e 0) #\E)
@@ -234,21 +266,23 @@
 
 
 (defvar +language-abbreviations+
-  '(("BAQ" . "Basque")
-    ("DAN" . "Danish")
-    ("DUT" . "Dutch")
-    ("ENG" . "English")
-    ("FIN" . "Finnish")
-    ("FRE" . "French")
-    ("GER" . "German")
-    ("HEB" . "Hebrew")
-    ("HUN" . "Hungarian")
-    ("ITA" . "Italian")
-    ("NOR" . "Norwegian")
-    ("POR" . "Portuguese")
-    ("RUS" . "Russian")
-    ("SPA" . "Spanish")
-    ("SWE" . "Swedish")))
+    '(("BAQ" . "Basque")
+      ("CZE" . "Chech")
+      ("DAN" . "Danish")
+      ("DUT" . "Dutch")
+      ("ENG" . "English")
+      ("FIN" . "Finnish")
+      ("FRE" . "French")
+      ("GER" . "German")
+      ("HEB" . "Hebrew")
+      ("HUN" . "Hungarian")
+      ("ITA" . "Italian")
+      ("JPN" . "Japanese")
+      ("NOR" . "Norwegian")
+      ("POR" . "Portuguese")
+      ("RUS" . "Russian")
+      ("SPA" . "Spanish")
+      ("SWE" . "Swedish")))
 
 (defvar *lat-info-table* (make-hash-table :size 30 :test 'equal))
 (defvar *is-lat-table-init* nil)
@@ -259,7 +293,10 @@
   (setq *is-lat-table-init* t))
 
 (defun lat-abbr-info (lat)
-  (nth-value 0 (gethash (string-downcase lat) *lat-info-table*)))
+  (aif (nth-value 0 (gethash (string-downcase lat) *lat-info-table*))
+       it
+       lat))
+
 
 
 (defun stt-abbr-info (stt)
@@ -324,7 +361,7 @@
       (let* ((anc-this-cxn (remove-if-not
                            (lambda (cxt) (= (1+ i) (cxn cxt))) anc)))
        (push
-        (sort anc-this-cxn (lambda (a b) (< (rnk a) (rnk b))))
+        (sort anc-this-cxn (lambda (a b) (< (rank a) (rank b))))
         anc-lists)))))