diff options
| -rw-r--r-- | src/deployment.lisp | 8 | ||||
| -rw-r--r-- | src/property.lisp | 59 |
2 files changed, 49 insertions, 18 deletions
diff --git a/src/deployment.lisp b/src/deployment.lisp index 5dbafbb..d4a7500 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -25,7 +25,11 @@ Assumes HOST has already had its :HOSTATTRS subroutines run, and arguments to connections in CONNECTIONS have been both normalised and preprocessed." (labels - ((connect (connections) + ((apply-propspec (propspec) + (let ((propapp (eval-propspec propspec))) + (assert-connection-supports (propapptype propapp)) + (propappapply propapp))) + (connect (connections) (destructuring-bind ((type . args) . remaining) connections ;; implementations of ESTABLISH-CONNECTION which call ;; CONTINUE-DEPLOY* or CONTINUE-DEPLOY*-PROGRAM return nil to us @@ -33,7 +37,7 @@ connections in CONNECTIONS have been both normalised and preprocessed." (apply #'establish-connection type remaining args))) (if remaining (connect remaining) - (propappapply (eval-propspec (host-propspec *host*)))) + (apply-propspec (host-propspec *host*))) (connection-teardown *connection*))))) (let ((*host* (preprocess-host host))) (connect (if (eq :local (caar connections)) diff --git a/src/property.lisp b/src/property.lisp index 0219e42..b965bc8 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -220,22 +220,53 @@ 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))))) + (let ((indent (cadr (assoc 'indent (cdar ,declarations)))) + ;; In the DEFUN below for calling the property + ;; programmatically, we can only call the :CHECK subroutine + ;; if it has the same lambda list as the :APPLY subroutine + ;; (as it will for properties defined with DEFPROP). + (check (and (getf ,slotsv :check) + (equal (cadr (getf ,slotsv :check)) + (cadr (getf ,slotsv :apply))) + `(when (progn ,@(cddr (getf ,slotsv :check))) + (return-from ,,name :no-change))))) `(progn (eval-when (:compile-toplevel :load-toplevel :execute) (record-known-property ',,name)) (store-indentation-info-for-emacs ',,name ',,lambdav ,indent) (setprop ',,name ,@,slotsv) - ;; TODO Ideally we would use ,(ordinary-ll-without-&aux - ;; ,lambdav) instead of (&rest args) here so that Emacs can - ;; show you what arguments the property really takes when - ;; you're typing propapps and also programmatic calls to the - ;; property. But not sure what the cleanest way is to pass - ;; all the args to propapply/propappapply, or whether we - ;; should be doing that. - (defun ,,name (&rest args) - (apply #'propappapply ',,name args)) - (define-dotted-property-macro ,,name ,,lambdav))))))))) + (define-dotted-property-macro ,,name ,,lambdav) + ;; Now prepare a DEFUN for the property, to enable calling + ;; it programmatically within the :APPLY and :UNAPPLY + ;; routines of other properties. This can lead to clearer + ;; code than going via DEFPROPSPEC/DEFPROPLIST for simple + ;; things like installing packages. + ,@(and + (getf ,slotsv :apply) + (destructuring-bind (sym ll . forms) + (getf ,slotsv :apply) + (declare (ignore sym)) + `((defun ,,name ,ll + ;; 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))) + ;; 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))) + ,@(and check `(,check)) + ,@forms)))))))))))) + +(defun warn-programmatic-apply-hostattrs () + (warn "Calling property which has :HOSTATTRS subroutine programmatically. +Use DEFPROPLIST/DEFPROPSPEC to avoid trouble.")) ;; supported ways to write properties are DEFPROP, DEFPROPSPEC and DEFPROPLIST @@ -247,11 +278,7 @@ parsing FORMSV and pushing SETPROP keyword argument pairs to plist SLOTSV." (loop for kw in '(:desc :preprocess :hostattrs :check :apply :unapply) do (if-let ((slot (getf slots kw))) (setf (getf slots kw) - `(lambda ,lambda - ,@(and (eq type :lisp) - (member kw '(:check :apply :unapply)) - `((assert-connection-supports :lisp))) - ,@slot))))) + `(lambda ,lambda ,@slot))))) (defun defpropspec-preprocess (&rest args) (list (list :propspec nil :orig-args args))) |