diff options
Diffstat (limited to 'src/propspec.lisp')
| -rw-r--r-- | src/propspec.lisp | 25 |
1 files changed, 20 insertions, 5 deletions
diff --git a/src/propspec.lisp b/src/propspec.lisp index 4524501..45f4f18 100644 --- a/src/propspec.lisp +++ b/src/propspec.lisp @@ -227,15 +227,30 @@ that the returned code should produce. Intended for use by macros which allow the user to provide expressions instead of values as the arguments to properties when building a property application specification." - (labels ((make-eval-propspec (form) + (labels ((dedot-symbol (s) + (let ((n (symbol-name s))) + (intern (subseq n 0 (1- (length n))) (symbol-package s)))) + (special-eval (args) + (let ((first (if (and (listp (car args)) + (or (keywordp (caar args)) + (and (listp (caar args)) + (keywordp (caaar args))))) + `(quote ,(car args)) + (car args))) + (rest (nreverse (cdr (reverse (cdr args)))))) + `(,first ,@rest ,(props (lastcar args))))) + (make-eval-propspec (form) (if (atom form) `(quote ,form) (destructuring-bind (first . rest) form (if (and (symbolp first) - (not (member (symbol-name first) - '("UNAPPLY") - :test #'string=))) - `(list ',first ,@rest) + (not (member (symbol-name first) + '("UNAPPLY") + :test #'string=))) + (if (char= #\. (last-char (symbol-name first))) + `(list ',(dedot-symbol first) + ,@(special-eval rest)) + `(list ',first ,@rest)) `(list ,@(mapcar #'make-eval-propspec form))))))) `(make-propspec ,@(and systems-supplied-p `(:systems ,systems)) |