From d4872fa198cddc32213c749e4c30a8ab2f01a19b Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 1 Apr 2002 20:40:36 +0000 Subject: [PATCH] r1717: *** empty log message *** --- src/libraries.cl | 47 +++++++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/src/libraries.cl b/src/libraries.cl index b58013d..e5bb757 100644 --- a/src/libraries.cl +++ b/src/libraries.cl @@ -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 ;;;; @@ -27,12 +27,14 @@ #+(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) -- 2.34.1