anchor.diff: -;;; This is asdf+ some useful extensions to ASDF (Another System Definition Facility).  
  -;;; $Revision: 1.8 $
  +;;; This is asdf+ some useful extensions to ASDF (Another System
  +;;; Definition Facility).
  +;;; $Revision: 1.9 $
   
  -;;; You may load this file instead of ASDF.lisp, provided that either ASDF.lisp has
  -;;; already been loaded or is present in the same folder as this file.
  +;;; You may load this file instead of ASDF.lisp, provided that either
  +;;; ASDF.lisp has already been loaded or is present in the same folder
  +;;; as this file.
   
   ;;;
   ;;; Feedback, bug reports, and patches are all welcome: please mail to
  
positive.code:    :key #'component-pathname
     :test #'pathname-match-p))
  
  (defun sysdef-central-registry-subsearch (name)
    "Looks in each *central-registry* folder for NAME.asd or system.asd in 
     the subdirectory named NAME."
    (block nil
        (dolist (form *central-registry*)
          (let* ((dir (merge-pathnames (make-pathname :directory `(:relative ,name))
                                       (eval form)))
                 (path (when dir
                         (or (probe-file (make-pathname :defaults dir :version :newest
                                                        :name name :type "asd" :case :local))
                             (probe-file (make-pathname :defaults dir :version :newest
                                                        :name "system" :type "asd" :case :local))))))
            (if path (return path))))))
  
  (setf *system-definition-search-functions* (nconc *system-definition-search-functions*
                                                    (list 'sysdef-central-registry-subsearch)))
  
  (export 'platform-name)
  (defun platform-name ()
    "Provides a short string which names the current Lisp implementation.  This may
  be used to generate directory names for example to store different platform FASL files."
    (flet ((feature-select (elts &optional (default "Unknown"))
             (let ((name (or (first (intersection elts *features*)) default)))
               (if (symbolp name) (string-capitalize (symbol-name name)) name)))
           (make-safe-dir-name (&rest strs)
             (substitute-if-not #\- #'alphanumericp (format nil "~{~A~^-~}" strs))))
      (make-safe-dir-name
       (feature-select '(:allegro :clisp :lispworks :sbcl :cmucl)
                       (lisp-implementation-type))
  
negative.code:   (let* ((system (find-system system))
          (path   (pathname value))
          (sysname (component-name system))
          (existing (find sysname *system-bin-directories*
                          :key #'car :test #'equalp)))
      (cond
       (existing (setf (cdr existing) path))
       (t (push (cons sysname path) *system-bin-directories*)))))
  