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
_______________________________________________
asdf-devel mailing list
asdf-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel
