Changeset 7324 for branches

Timestamp:

Sep 29, 2007, 5:40:36 PM (17 years ago)

Author:

gz

Message:

Make find-module-pathnames handle wildcards, and put "ccl:examples;;" on *module-search-path*.

Location:

branches/easygui/ccl/level-1

Files:

• l1-files.lisp (modified) (2 diffs)
• l1-pathnames.lisp (modified) (1 diff)

branches/easygui/ccl/level-1/l1-files.lisp

@@ -1256 +1256 @@
 (defun require (module &optional pathname)
   "Loads a module, unless it already has been loaded. PATHNAMES, if supplied,
-   is a designator for a list of pathnames to be loaded if the module
+   is a designator for a list of pathnames to be loaded if the/Users/gz/OpenMCL/trunk/ccl/examples/cocoa/easygui.lisp module
    needs to be. If PATHNAMES is not supplied, functions from the list
    *MODULE-PROVIDER-FUNCTIONS* are called in order with MODULE-NAME
@@ -1286 +1286 @@
   (let ((mod-path (make-pathname :name (string-downcase module) :defaults nil)) path)
         (dolist (path-cand *module-search-path* nil)
-          (when (setq path (find-load-file (merge-pathnames mod-path path-cand)))
-            (return path)))))
+          (let ((mod-cand (merge-pathnames mod-path path-cand)))
+            (if (wild-pathname-p path-cand)
+                (let* ((untyped-p (member (pathname-type mod-cand) '(nil :unspecific)))
+                       (matches (if untyped-p
+                                    (or (directory (merge-pathnames mod-cand *.lisp-pathname*))
+                                        (directory (merge-pathnames mod-cand *.fasl-pathname*)))
+                                    (directory mod-cand))))
+                  (when (and matches (null (cdr matches)))
+                    (return (if untyped-p
+                                (make-pathname :type nil :defaults (car matches))
+                                (car matches)))))
+                (when (setq path (find-load-file (merge-pathnames mod-path path-cand)))
+                  (return path)))))))
 
 (defun wild-pathname-p (pathname &optional field-key)

branches/easygui/ccl/level-1/l1-pathnames.lisp

@@ -701 +701 @@
 (defparameter *module-search-path* (list
                                     (cons-pathname '(:absolute "bin") nil nil "ccl")
-                                    (cons-pathname  '(:absolute "openmcl" "modules") nil nil "home")
+                                    (cons-pathname '(:absolute "openmcl" "modules") nil nil "home")
                                     (cons-pathname '(:absolute "lib") nil nil "ccl")
                                     (cons-pathname '(:absolute "library") nil nil "ccl")
-                                    (cons-pathname '(:absolute "examples") nil nil "ccl")
+                                    (cons-pathname '(:absolute "examples" :wild-inferiors) nil nil "ccl")
                                     (cons-pathname '(:absolute "tools") nil nil "ccl")
                                     (cons-pathname '(:absolute "objc-bridge") nil nil "ccl")