From db063417a5e61323e4fcb3429c928a7ba252ab9d Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Sun, 4 May 2003 00:30:36 +0000
Subject: [PATCH] r4784: Auto commit for Debian build

---
 sql-classes.lisp | 50 ++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 42 insertions(+), 8 deletions(-)

diff --git a/sql-classes.lisp b/sql-classes.lisp
index ad61636..088aec8 100644
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -7,7 +7,7 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: sql-classes.lisp,v 1.57 2003/05/03 22:48:55 kevin Exp $
+;;;; $Id: sql-classes.lisp,v 1.58 2003/05/04 00:30:36 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -51,6 +51,32 @@
 		  collect (destructuring-bind ,fields tuple
 			    ,@body)))))))
 
+(defmacro with-umlisp-query-eval ((table fields srl where-name where-value
+					 &key (lrl "KCUILRL") distinct single
+					 order like)
+				  &body body)
+  (let ((value (gensym)))
+    (if single
+	`(let ((,value ,where-value))
+	  (when ,value 
+	    (let ((tuple (car (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
+					    :lrl ,lrl :single ,single
+					    :distinct ,distinct :order ,order
+					    :like ,like))))
+	      (when tuple
+		(destructuring-bind ,fields tuple
+		  ,@body)))))
+	`(let ((,value ,where-value))
+	  (when ,value 
+	    (loop for tuple in
+		  (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
+				     :lrl ,lrl :single ,single :distinct ,distinct
+				     :order ,order :like ,like)
+		  collect (destructuring-bind ,fields tuple
+			    ,@body)))))))
+
+
+
 (defmacro umlisp-query (table fields srl where-name where-value
 		     &key (lrl "KCUILRL") single distinct order like)
   "Query the UMLisp database. Return a list of umlisp objects whose name
@@ -59,6 +85,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (query-string-macro ,table ,fields ,srl ,where-name ,where-value 
      :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like)))
 
+(defun umlisp-query-eval (table fields srl where-name where-value
+		     &key (lrl "KCUILRL") single distinct order like)
+  "Query the UMLisp database. Return a list of umlisp objects whose name
+is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
+  (mutex-sql-query
+   (query-string-macro ,table ,fields ,srl ,where-name ,where-value 
+     :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like)))
+
   
 (defmacro query-string-macro (table fields &optional srl where-name where-value
 			&key (lrl "KCUILRL") single distinct order like)
@@ -391,7 +425,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-usab-by-key (key-name key)
   "Find usab for a key"
-  (with-umlisp-query (mrsab (vcui rcui vsab rsab son sf sver mstart mend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) nil key-name key :single t)
+  (with-umlisp-query-eval ('mrsab '(vcui rcui vsab rsab son sf sver mstart mend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) nil key-name key :single t)
     (make-instance 'usab :vcui (ensure-integer vcui) 
 		   :rcui (ensure-integer rcui)
 		   :vsab vsab :rsab rsab :son son :sf sf :sver sver :mstart mstart
@@ -403,11 +437,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-usab-rsab (rsab)
   "Find usab for rsab"
-  (find-usab-by-key "RSAB" rsab))
+  (find-usab-by-key 'rsab rsab))
 
 (defun find-usab-vsab (vsab)
   "Find usab for vsab"
-  (find-usab-by-key "VSAB" vsab))
+  (find-usab-by-key 'vsab vsab))
 
 (defun find-cui-max ()
   (ensure-integer (caar (mutex-sql-query "select max(CUI) from MRCON"))))
@@ -422,14 +456,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   
 (defun find-ucon-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match word. Optionally, use SQL's LIKE syntax"
-  (with-umlisp-query (mrxw_eng (cui) srl wd word :like like :distinct t
-				:lrl klrl :order (cui asc))
+  (with-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t
+				     :lrl klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 
 (defun find-ucon-normalized-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match word, optionally use SQL's LIKE syntax"
-  (with-umlisp-query (mrxnw_eng (cui) srl nwd word :like like :distinct t
-				:lrl klrl :order (cui asc))
+  (with-umlisp-query-eval ('mrxnw_eng '(cui) srl 'nwd word :like like :distinct t
+				      :lrl klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 
 (defun find-ustr-word (word &key (srl *current-srl*))
-- 
2.34.1