Coerce system name in SEARCH-SYSTEM-IN-SHELVES (unbreaks Weblocks)
Sat May 16 15:05:24 PDT 2009 Maciej Pasternacki <maciej@pasternacki.net>
* Coerce system name in SEARCH-SYSTEM-IN-SHELVES (unbreaks Weblocks)
diff -rN -u old-cl-librarian/src/shelves.lisp new-cl-librarian/src/shelves.lisp
--- old-cl-librarian/src/shelves.lisp 2014-07-25 02:00:52.000000000 -0700
+++ new-cl-librarian/src/shelves.lisp 2014-07-25 02:00:52.000000000 -0700
@@ -192,20 +192,20 @@
(merge-directory-pathname (repo-name-as-string repo)
(shelf-subdir shelf "site"))))
-(defun search-system-in-shelves (system)
+(defun search-system-in-shelves (system &aux (system-name (asdf::coerce-name system)))
"Search for ASDF system SYSTEM in used shelves.
This function is added to ASDF:*SYSTEM-DEFINITION-SEARCH-FUNCTIONS*."
(some #'(lambda (shelf)
- (some #'(lambda (repo)
- (some #'(lambda (pathname)
- (and (string= (pathname-name pathname)
- system)
- pathname))
- (directory
- (shelf&repo-systems-pathname shelf repo))))
- (shelf-contents shelf)))
- *used-shelves*))
+ (some #'(lambda (repo)
+ (some #'(lambda (pathname)
+ (and (string= (pathname-name pathname)
+ system-name)
+ pathname))
+ (directory
+ (shelf&repo-systems-pathname shelf repo))))
+ (shelf-contents shelf)))
+ *used-shelves*))
;; EVAL-WHEN anyone?
(pushnew 'search-system-in-shelves asdf:*system-definition-search-functions*)