From 6df0471a21cf133e85380e3a7a10035630bee93f Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Mon, 19 Apr 2010 13:54:43 -0400 Subject: [PATCH] 1.704: system-dependencies allows to specify prerequisites for parsing the defsystem form itself. Also, *asdf-verbose* controls the default verbosity of asdf operations (or should I have reused *verbose-out* ?) --- asdf.lisp | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index e1c56210..3fe58bcb 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -63,7 +63,7 @@ (remove "asdf" excl::*autoload-package-name-alist* :test 'equalp :key 'car)) (let* ((asdf-version ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace - (subseq "VERSION:1.703" (1+ (length "VERSION")))) + (subseq "VERSION:1.704" (1+ (length "VERSION")))) (existing-asdf (find-package :asdf)) (versym '#:*asdf-version*) (existing-version (and existing-asdf @@ -238,6 +238,7 @@ #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour* #:*resolve-symlinks* + #:*asdf-verbose* #:asdf-version @@ -285,7 +286,7 @@ (defun asdf-version () "Exported interface to the version of ASDF currently installed. A string. You can compare this string with e.g.: -(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"1.661\")." +(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"1.704\")." *asdf-version*) (defvar *resolve-symlinks* t @@ -299,6 +300,8 @@ Defaults to `t`.") (defvar *verbose-out* nil) +(defvar *asdf-verbose* t) + (defparameter +asdf-methods+ '(perform-with-restarts perform explain output-files operation-done-p)) @@ -679,7 +682,7 @@ actually-existing directory." #-(or cmu sbcl clisp allegro ecl) (defun get-uid () (let ((uid-string - (with-output-to-string (asdf::*VERBOSE-OUT*) + (with-output-to-string (*verbose-out*) (asdf:run-shell-command "id -ur")))) (with-input-from-string (stream uid-string) (read-line stream) @@ -1756,7 +1759,8 @@ recursive calls to traverse.") ;;;; ------------------------------------------------------------------------- ;;;; Invoking Operations -(defun operate (operation-class system &rest args &key (verbose t) version force +(defun operate (operation-class system &rest args + &key ((:verbose *asdf-verbose*) *asdf-verbose*) version force &allow-other-keys) (declare (ignore force)) (let* ((*package* *package*) @@ -1764,7 +1768,7 @@ recursive calls to traverse.") (op (apply #'make-instance operation-class :original-initargs args args)) - (*verbose-out* (if verbose *standard-output* (make-broadcast-stream))) + (*verbose-out* (if *asdf-verbose* *standard-output* (make-broadcast-stream))) (system (if (typep system 'component) system (find-system system)))) (unless (version-satisfies system version) (error 'missing-component-of-version :requires system :version version)) @@ -1792,7 +1796,7 @@ recursive calls to traverse.") (return))))))) op)) -(defun oos (operation-class system &rest args &key force (verbose t) version +(defun oos (operation-class system &rest args &key force verbose version &allow-other-keys) (declare (ignore force verbose version)) (apply #'operate operation-class system args)) @@ -1822,21 +1826,21 @@ created with the same initargs as the original one. (setf (documentation 'operate 'function) operate-docstring)) -(defun load-system (system &rest args &key force (verbose t) version +(defun load-system (system &rest args &key force verbose version &allow-other-keys) "Shorthand for `(operate 'asdf:load-op system)`. See OPERATE for details." (declare (ignore force verbose version)) (apply #'operate 'load-op system args)) -(defun compile-system (system &rest args &key force (verbose t) version +(defun compile-system (system &rest args &key force verbose version &allow-other-keys) "Shorthand for `(operate 'asdf:compile-op system)`. See OPERATE for details." (declare (ignore force verbose version)) (apply #'operate 'compile-op system args)) -(defun test-system (system &rest args &key force (verbose t) version +(defun test-system (system &rest args &key force verbose version &allow-other-keys) "Shorthand for `(operate 'asdf:test-op system)`. See OPERATE for details." @@ -1869,13 +1873,15 @@ details." (defmacro defsystem (name &body options) (destructuring-bind (&key (pathname nil pathname-arg-p) (class 'system) - &allow-other-keys) + system-dependencies &allow-other-keys) options - (let ((component-options (remove-keyword :class options))) + (let ((component-options (remove-keys '(:system-dependencies :class) options))) `(progn ;; system must be registered before we parse the body, otherwise ;; we recur when trying to find an existing system of the same name ;; to reuse options (e.g. pathname) from + ,@(loop for system in system-dependencies + collect `(asdf:load-system ,system)) (let ((s (system-registered-p ',name))) (cond ((and s (eq (type-of (cdr s)) ',class)) (setf (car s) (get-universal-time))) -- GitLab