r1717: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Mon, 1 Apr 2002 20:40:36 +0000 (20:40 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Mon, 1 Apr 2002 20:40:36 +0000 (20:40 +0000)
src/libraries.cl

index b58013da9df924677232e58f039ac4c2f10f931c..e5bb757ba1029780c30b08995d544341678f19b9 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: libraries.cl,v 1.10 2002/04/01 17:16:15 kevin Exp $
+;;;; $Id: libraries.cl,v 1.11 2002/04/01 20:40:36 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
   #+(or win32 mswindows) "dll"
   #-(or win32 mswindows) "so")
 
-(defun find-foreign-library (names directories &key type drive-letters)  
+(defun find-foreign-library (names directories &key types drive-letters)  
   "Looks for a foreign library. directories can be a single
 string or a list of strings of candidate directories. Use default
 library type if type is not specified."
-  (unless type
-    (setq type (default-foreign-library-type)))
+  (unless types
+    (setq types (default-foreign-library-type)))
+  (unless (listp types)
+    (setq types (list types)))
   (unless (listp names)
     (setq names (list names)))
   (unless (listp directories)
@@ -45,24 +47,25 @@ library type if type is not specified."
   (dolist (drive-letter drive-letters)
     (dolist (name names)
       (dolist (dir directories)
-       (let ((path (make-pathname 
-                    #+lispworks :host
-                    #+lispworks (when drive-letter drive-letter)
-                    #-lispworks :device
-                    #-lispworks (when drive-letter drive-letter)
-                    :name name 
-                    :type type
-                    :directory 
-                    (etypecase dir
-                      (pathname
-                       (pathname-directory dir))
-                      (list
-                       dir)
-                      (string
-                       (pathname-directory 
-                        (parse-namestring dir)))))))
-         (when (probe-file path)
-           (return-from find-foreign-library path))))))
+       (dolist (type types)
+         (let ((path (make-pathname 
+                      #+lispworks :host
+                      #+lispworks (when drive-letter drive-letter)
+                      #-lispworks :device
+                      #-lispworks (when drive-letter drive-letter)
+                      :name name 
+                      :type type
+                      :directory 
+                      (etypecase dir
+                        (pathname
+                         (pathname-directory dir))
+                        (list
+                         dir)
+                        (string
+                         (pathname-directory 
+                          (parse-namestring dir)))))))
+           (when (probe-file path)
+             (return-from find-foreign-library path)))))))
    nil)