r4840: Auto commit for Debian build

[umlisp.git] / parse-2002.lisp

diff --git a/parse-2002.lisp b/parse-2002.lisp
index 79119fd9639192d15c498a00b4b6fe739256ab93..8bbb00915f2ea7781115ce95241ff794e43ce9d3 100644 (file)
--- a/parse-2002.lisp
+++ b/parse-2002.lisp
@@ -8,7 +8,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: parse-2002.lisp,v 1.6 2003/05/06 06:09:29 kevin Exp $
+;;;; $Id: parse-2002.lisp,v 1.7 2003/05/06 07:17:35 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -279,7 +279,7 @@
   (let ((cols '()))
     (with-umls-file (line "MRCOLS")
       (destructuring-bind (col des ref min av max fil dty) line
-       (let ((c (make-umls-col       
+       (let ((c (make-instance 'ucol
                  :col col
                  :des des
                  :ref ref
@@ -289,8 +289,8 @@
                  :fil fil
                  :dty dty  ;; new in 2002 UMLS
                  :sqltype "VARCHAR"    ; default data type
-                 :parsefunc #'add-sql-quotes
-                 :custom-value-func nil
+                 :parse-fun #'add-sql-quotes
+                 :custom-value-fun nil
                  :quotechar "'")))
          (add-datatype-to-col c (datatype-for-col col))
          (push c cols))))
@@ -300,17 +300,10 @@
 "Initialize umls columns for custom columns"  
   (let ((cols '()))
     (dolist (customcol +custom-cols+)
-      (let ((c (make-umls-col :col (nth 1 customcol)
-                             :des ""
-                             :ref 0
-                             :min 0
-                             :max (nth 3 customcol)
-                             :av 0
-                             :dty nil
-                             :fil (nth 0 customcol)
-                             :sqltype (nth 2 customcol)
-                             :parsefunc #'add-sql-quotes
-                             :custom-value-func (nth 4 customcol)
+      (let ((c (make-instance 'ucol
+                             :col (nth 1 customcol) :des "" :ref 0 :min 0 :max (nth 3 customcol)
+                             :av 0 :dty nil :fil (nth 0 customcol) :sqltype (nth 2 customcol)
+                             :parse-fun #'add-sql-quotes  :custom-value-fun (nth 4 customcol)
                              :quotechar "'")))
        (add-datatype-to-col c (datatype-for-col (nth 1 customcol)))
        (push c cols)))
@@ -326,7 +319,7 @@
       (destructuring-bind (nam des ref fil) line
        (setq nam (escape-column-name nam))
        (dolist (file (delimited-string-to-list fil #\,))
-         (let ((c (make-umls-col             
+         (let ((c (make-instance 'ucol       
                  :col nam
                  :des des
                  :ref ref
@@ -336,8 +329,8 @@
                  :fil file
                  :dty nil
                  :sqltype "VARCHAR"    ; default data type
-                 :parsefunc #'add-sql-quotes
-                 :custom-value-func nil
+                 :parse-fun #'add-sql-quotes
+                 :custom-value-fun nil
                  :quotechar "'")))
            (add-datatype-to-col c (datatype-for-col nam))
            (push c cols)))))
@@ -375,7 +368,7 @@ append a unique number (starting at 2) onto a column name that is repeated in th
   (let ((files '()))
   (with-umls-file (line files-filename)
     (destructuring-bind (fil des fmt cls rws bts) line
-      (let ((f (make-umls-file 
+      (let ((f (make-instance 'ufile 
                :fil fil
                :table (substitute #\_ #\. fil)
                :des des
@@ -386,20 +379,16 @@ append a unique number (starting at 2) onto a column name that is repeated in th
                :fields (concatenate 'list
                          (umls-field-string-to-list fmt)
                          (custom-colnames-for-filename fil)))))
-       (setf (umls-file-colstructs f) (umls-cols-for-umls-file f))
+       (setf (ucols f) (ucols-for-umls-file f))
        (push f files))))
   (nreverse files)))
 
 (defun init-custom-files ()
-  (let ((ffile (make-umls-file :fil "MRXW.NONENG"
-                              :des "Custom NonEnglish Index"
-                              :table "MRXW_NONENG"
-                              :cls 5
-                              :rws 0
-                              :bts 0
-                              :fields (umls-file-fields (find-umls-file "MRXW.ENG")))))
-    (setf (umls-file-colstructs ffile)
-      (umls-cols-for-umls-file ffile))
+  (let ((ffile (make-instance 'ufile
+                    :fil "MRXW.NONENG" :des "Custom NonEnglish Index" :table "MRXW_NONENG"
+                    :cls 5 :rws 0 :bts 0 :fields (fields (find-umls-file "MRXW.ENG")))))
+    (setf (ucols ffile)
+      (ucols-for-umls-file ffile))
     (list ffile)))
 
 (defun datatype-for-col (colname)
@@ -408,32 +397,32 @@ append a unique number (starting at 2) onto a column name that is repeated in th
 
 (defun add-datatype-to-col (col datatype)
 "Add data type information to column"
-  (setf (umls-col-datatype col) datatype)
+  (setf (datatype col) datatype)
   (case datatype
-    (sql-u (setf (umls-col-sqltype col) "INTEGER"
-                (umls-col-parsefunc col) #'parse-ui
-                (umls-col-quotechar col) ""))
-    (sql-s (setf (umls-col-sqltype col) "SMALLINT" 
-                (umls-col-parsefunc col) #'parse-integer
-                (umls-col-quotechar col) ""))
-    (sql-l (setf (umls-col-sqltype col) "BIGINT" 
-                (umls-col-parsefunc col) #'parse-integer
-                (umls-col-quotechar col) ""))
-    (sql-i (setf (umls-col-sqltype col) "INTEGER" 
-                (umls-col-parsefunc col) #'parse-integer
-                (umls-col-quotechar col) ""))
-    (sql-f (setf (umls-col-sqltype col) "NUMERIC" 
-                (umls-col-parsefunc col) #'read-from-string
-                (umls-col-quotechar col) ""))
+    (sql-u (setf (sqltype col) "INTEGER"
+                (parse-fun col) #'parse-ui
+                (quotechar col) ""))
+    (sql-s (setf (sqltype col) "SMALLINT" 
+                (parse-fun col) #'parse-integer
+                (quotechar col) ""))
+    (sql-l (setf (sqltype col) "BIGINT" 
+                (parse-fun col) #'parse-integer
+                (quotechar col) ""))
+    (sql-i (setf (sqltype col) "INTEGER" 
+                (parse-fun col) #'parse-integer
+                (quotechar col) ""))
+    (sql-f (setf (sqltype col) "NUMERIC" 
+                (parse-fun col) #'read-from-string
+                (quotechar col) ""))
     (t                      ; Default column type, optimized text storage
-     (setf (umls-col-parsefunc col) #'add-sql-quotes 
-          (umls-col-quotechar col) "'")
-     (when (and (umls-col-max col) (umls-col-av col))
-       (if (> (umls-col-max col) 255)
-          (setf (umls-col-sqltype col) "TEXT")
-        (if (< (- (umls-col-max col) (umls-col-av col)) 4) 
-            (setf (umls-col-sqltype col) "CHAR") ; if average bytes wasted < 4
-          (setf (umls-col-sqltype col) "VARCHAR")))))))
+     (setf (parse-fun col) #'add-sql-quotes 
+          (quotechar col) "'")
+     (when (and (cmax col) (av col))
+       (if (> (cmax col) 255)
+          (setf (sqltype col) "TEXT")
+        (if (< (- (cmax col) (av col)) 4) 
+            (setf (sqltype col) "CHAR") ; if average bytes wasted < 4
+          (setf (sqltype col) "VARCHAR")))))))