New (more complicate) code:
(defun directory-pathname-p (pathname) (and (member (pathname-name pathname) (list nil :unspecific)) (member (pathname-type pathname) (list nil :unspecific))))
(defun pathname-name+type (pathname) "Returns a new pathname consisting of only the name and type from a non-wild pathname." (make-pathname :name (pathname-name pathname) :type (pathname-type pathname)))
(defun ensure-directory-pathname (pathname) (if (directory-pathname-p pathname) pathname (make-pathname :directory `(,@(pathname-directory pathname) ,(namestring (pathname-name+type pathname))))))
(defun sysdef-central-registry-search (system) (let ((name (coerce-name system)) (to-remove nil) (to-replace nil)) (block nil (unwind-protect (dolist (dir *central-registry*) (let ((defaults (eval dir))) (cond ((directory-pathname-p defaults) (let ((file (and defaults (make-pathname :defaults defaults :version :newest :name name :type "asd" :case :local)))) (if (and file (probe-file file)) (return file)))) (t (restart-case (let ((*print-circle* nil)) (error "~@<While searching for system `~a`: `~a` evaluated to `~a` which is not a directory.~@:>" system dir defaults)) (remove-entry-from-registry () :report "Remove entry from *central-registry* and continue" (push dir to-remove)) (coerce-entry-to-directory () :report (lambda (s) (format s "Coerce entry to ~a, replace ~a and continue." (ensure-directory-pathname defaults) dir)) (push (cons dir (ensure-directory-pathname defaults)) to- replace))))))) ;; cleanup (dolist (dir to-remove) (setf *central-registry* (remove dir *central-registry*))) (dolist (pair to-replace) (let* ((current (car pair)) (new (cdr pair)) (position (position current *central-registry*))) (setf *central-registry* (append (subseq *central-registry* 0 position) (list new) (subseq *central-registry* (1+ position))))))))))
On Jul 9, 2009, at 4:04 PM, Tobias C. Rittweiler wrote:
Richard M Kreuter writes:
Wouldn't it be more user-friendly to coerce such pathnames to ones that denote directory names?
Small addendum to my previous mail:
Even in the case of automatic coercing, I think ASDF should signal a style-warning for educational purposes.
-T.
asdf-devel mailing list asdf-devel@common-lisp.net http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel
-- Gary Warren King, metabang.com Cell: (413) 559 8738 Fax: (206) 338-4052 gwkkwg on Skype * garethsan on AIM * gwking on twitter