Commit 9804b01a authored by Gary King's avatar Gary King

main change is the addition of system-relative-pathname function. This takes a

system name and a partial pathname and combines them to return a new pathname
_relative_ to the system. This is exported and lightly documented.

this patch also updates preference-file-for-system/operation in an effort
to prevent it from being confused by *default-pathname-defaults* that include
a specific name and type.
parent f0a5ff84
;;; This is asdf: Another System Definition Facility. $Revision: 1.106 $
;;; This is asdf: Another System Definition Facility. $Revision: 1.107 $
;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical
......@@ -13,7 +13,7 @@
;;; is the latest development version, whereas the revision tagged
;;; RELEASE may be slightly older but is considered `stable'
;;; Copyright (c) 2001-2003 Daniel Barlow and contributors
;;; Copyright (c) 2001-2007 Daniel Barlow and contributors
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining
;;; a copy of this software and associated documentation files (the
......@@ -79,7 +79,9 @@
#:system-maintainer
#:system-license
#:system-licence
#:system-source-file
#:system-relative-pathname
#:operation-on-warnings
#:operation-on-failure
......@@ -112,7 +114,7 @@
(in-package #:asdf)
(defvar *asdf-revision* (let* ((v "$Revision: 1.106 $")
(defvar *asdf-revision* (let* ((v "$Revision: 1.107 $")
(colon (or (position #\: v) -1))
(dot (position #\. v)))
(and v colon dot
......@@ -122,6 +124,7 @@
:junk-allowed t)))))
(defvar *compile-file-warnings-behaviour* :warn)
(defvar *compile-file-failure-behaviour* #+sbcl :error #-sbcl :warn)
(defvar *verbose-out* nil)
......@@ -876,11 +879,14 @@ system."))
(preference-file-for-system/operation (find-system system t) operation))
(defmethod preference-file-for-system/operation ((s system) (operation t))
(merge-pathnames
(make-pathname :name (component-name s)
:type "lisp"
:directory '(:relative ".asdf"))
(truename (user-homedir-pathname))))
(let ((*default-pathname-defaults*
(make-pathname :name nil :type nil
:defaults *default-pathname-defaults*)))
(merge-pathnames
(make-pathname :name (component-name s)
:type "lisp"
:directory '(:relative ".asdf"))
(truename (user-homedir-pathname)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; invoking operations
......@@ -1190,6 +1196,28 @@ output to *VERBOSE-OUT*. Returns the shell's exit code."
(defun hyperdoc (name doc-type)
(hyperdocumentation (symbol-package name) name doc-type))
(defun system-source-file (system-name)
(let ((system (asdf:find-system system-name)))
(make-pathname
:type "asd"
:name (asdf:component-name system)
:defaults (asdf:component-relative-pathname system))))
(defun system-source-directory (system-name)
(make-pathname :name nil
:type nil
:defaults (system-source-file system-name)))
(defun system-relative-pathname (system pathname &key name type)
(let ((directory (pathname-directory pathname)))
(when (eq (car directory) :absolute)
(setf (car directory) :relative))
(merge-pathnames
(make-pathname :name (or name (pathname-name pathname))
:type (or type (pathname-type pathname))
:directory directory)
(system-source-directory system))))
(pushnew :asdf *features*)
......
......@@ -69,6 +69,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
* The object model of asdf::
* Error handling::
* Compilation error and warning handling::
* Miscellaneous additional functionality::
* Getting the latest version::
* TODO list::
* missing bits in implementation::
......@@ -987,7 +988,7 @@ Operations may go wrong (for example when source files contain
errors). These are signalled using generalised instances of
@code{OPERATION-ERROR}.
@node Compilation error and warning handling, Getting the latest version, Error handling, Top
@node Compilation error and warning handling, Miscellaneous additional functionality, Error handling, Top
@comment node-name, next, previous, up
@chapter Compilation error and warning handling
@vindex *compile-file-warnings-behaviour*
......@@ -999,7 +1000,39 @@ variables @code{*compile-file-warnings-behaviour*} and
such events. The valid values for these variables are @code{:error},
@code{:warn}, and @code{:ignore}.
@node Getting the latest version, TODO list, Compilation error and warning handling, Top
@node Miscellaneous additional functionality, Getting the latest version, Compilation error and warning handling, Top
@comment node-name, next, previous, up
@chapter Additional Functionality
ASDF includes several additional features that are generally
useful for system definition and development. These include:
@enumerate
@item
system-relative-pathname
It's often handy to locate a file relative to some system. The system-relative-pathname function meets this need. It takes two arguments: the name of a system and a relative pathname. It returns a pathname built from the
location of the system's source file and the relative pathname. For example
@lisp
> (asdf:system-relative-pathname 'cl-ppcre "regex.data")
#P"/repository/other/cl-ppcre/regex.data"
@end lisp
@item
hyperdocumentation
to be documented
@item
hyperdoc
to be documented
@end enumerate
@node Getting the latest version, TODO list, Miscellaneous additional functionality, Top
@comment node-name, next, previous, up
@chapter Getting the latest version
......
#!/bin/sh
sok=1
do_tests() {
rm *.$2 || true
( cd .. && echo '(compile-file "asdf")' |$1 )
......@@ -10,10 +12,11 @@ do
echo "Using $1, $i passed" >&2
else
echo "Using $1, $i failed" >&2
sok=0
exit 1
fi
done
echo "Using $1, all tests apparently successful" >&2
echo "Using $1, all tests apparently successful ($sok)" >&2
}
# do_tests {lisp invocation} {fasl extension}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment