diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-21 20:37:17 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-22 08:55:19 -0700 |
| commit | 8f5b4d1c4417cb96859c51ddef1f26b61c553328 (patch) | |
| tree | 687273ca9e09c218f26b507843ac72536495a7eb /src/property.lisp | |
| parent | b63669ed5af088193d7e9ffe15d64840b50361ca (diff) | |
| download | consfigurator-8f5b4d1c4417cb96859c51ddef1f26b61c553328.tar.gz | |
use %CONSFIGURE so we can define functions for more properties
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src/property.lisp')
| -rw-r--r-- | src/property.lisp | 34 |
1 files changed, 13 insertions, 21 deletions
diff --git a/src/property.lisp b/src/property.lisp index 8fd8436..3ee663e 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -234,13 +234,7 @@ parsing FORMSV and pushing SETPROP keyword argument pairs to plist SLOTSV." (when (> (length ,declarations) 1) (error "Multiple DECLARE forms unsupported.")) ,@mforms - (let ((indent (cadr (assoc 'indent (cdar ,declarations)))) - ;; Current implementation can DEFUN the property only when - ;; its :APPLY subroutine has the property's lambda list; - ;; this will fail to hold only for DEFPROPLIST/DEFPROPSPEC. - (can-defun - (and (getf ,slotsv :apply) - (equal (cadr (getf ,slotsv :apply)) ,lambdav)))) + (let ((indent (cadr (assoc 'indent (cdar ,declarations))))) `(progn (eval-when (:compile-toplevel :load-toplevel :execute) (record-known-property ',,name)) @@ -253,22 +247,20 @@ parsing FORMSV and pushing SETPROP keyword argument pairs to plist SLOTSV." ;; code than going via DEFPROPSPEC/DEFPROPLIST for simple ;; things like installing packages. ,@(and - can-defun - `((defun-which-calls ,,name (propapply ',,name) ,,lambdav - ;; Have to insert code to check connection type - ;; because %CONSFIGURE won't see a programmatic call - ;; and check this as is does for regular propapps. - ,@(and (eq ,typev :lisp) - '((assert-connection-supports :lisp))) + (getf ,slotsv :apply) + `((defun-with-args ,,name args ,,lambdav ;; Properties with :HOSTATTRS subroutines which set ;; new hostattrs should not be used programmatically - ;; in this way, and using properties with :HOSTATTRS - ;; subroutines which only look at existing hostattrs - ;; has the potential for trouble too, so issue a - ;; warning. - ,@(and - (getf ,slotsv :hostattrs) - '((warn-programmatic-apply-hostattrs)))))))))))))) + ;; in this way, so issue a warning. + ,@(and (getf ,slotsv :hostattrs) + '((warn-programmatic-apply-hostattrs))) + (%consfigure + nil + (make-host + :propspec + (make-propspec + :systems nil + :propspec (cons ',,name args))))))))))))))) (defun warn-programmatic-apply-hostattrs () (warn "Calling property which has :HOSTATTRS subroutine programmatically. |