use %CONSFIGURE so we can define functions for more properties

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

1 files changed, 34 insertions, 37 deletions

diff --git a/src/util.lisp b/src/util.lisp
index a607f4d..242fbdb 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -72,43 +72,40 @@ supported."
 	unless (char= #\& (char (symbol-name arg*) 0))
 	  collect arg*))
 
-(defmacro defun-which-calls (name call lambda-list &body forms &aux remaining)
-  (with-gensyms (result)
-    (multiple-value-bind (required optional rest kwargs aokeys)
-	(parse-ordinary-lambda-list lambda-list)
-      (when (and aokeys (not rest))
-	(simple-program-error
-	 "&ALLOW-OTHER-KEYS without &REST in property lambda list not supported."))
-      (let ((call* (destructuring-bind (first . rest) (ensure-cons call)
-		     `(#',first ,@rest)))
-	    (normalisedll (reverse required)))
-	(when optional
-	  (push '&optional normalisedll)
-	  (loop for (name init suppliedp) in optional
-		for suppliedp* = (or suppliedp (gensym))
-		do (push `(,name ,init ,suppliedp*) normalisedll)
-		do (push `(when ,suppliedp* (push ,name ,result)) remaining)))
-	(when rest
-	  (push '&rest normalisedll)
-	  (push rest normalisedll)
-	  (push `(dolist (r ,rest) (push r ,result)) remaining))
-	(when kwargs
-	  (push '&key normalisedll)
-	  (loop for ((keyword-name name) init suppliedp) in kwargs
-		for suppliedp* = (if (or rest suppliedp) suppliedp (gensym))
-		do (push `((,keyword-name ,name) ,init ,suppliedp*)
-			 normalisedll)
-		unless rest do (push `(when ,suppliedp*
-					(push ,keyword-name ,result)
-					(push ,name ,result))
-				     remaining)))
-	(when aokeys
-	  (push '&allow-other-keys normalisedll))
-	`(defun ,name ,(nreverse normalisedll)
-	   ,@forms
-	   (apply ,@call* ,@required (let (,result)
-				       ,@(nreverse remaining)
-				       (nreverse ,result))))))))
+(defmacro defun-with-args (name argsym lambda-list &body forms &aux remaining)
+  (multiple-value-bind (required optional rest kwargs aokeys)
+      (parse-ordinary-lambda-list lambda-list)
+    (when (and aokeys (not rest))
+      (simple-program-error
+       "&ALLOW-OTHER-KEYS without &REST in property lambda list not supported."))
+    (let ((normalisedll (reverse required)))
+      (when optional
+	(push '&optional normalisedll)
+	(loop for (name init suppliedp) in optional
+	      for suppliedp* = (or suppliedp (gensym))
+	      do (push `(,name ,init ,suppliedp*) normalisedll)
+	      do (push `(when ,suppliedp* (push ,name ,argsym)) remaining)))
+      (when rest
+	(push '&rest normalisedll)
+	(push rest normalisedll)
+	(push `(dolist (r ,rest) (push r ,argsym)) remaining))
+      (when kwargs
+	(push '&key normalisedll)
+	(loop for ((keyword-name name) init suppliedp) in kwargs
+	      for suppliedp* = (if (or rest suppliedp) suppliedp (gensym))
+	      do (push `((,keyword-name ,name) ,init ,suppliedp*)
+		       normalisedll)
+	      unless rest do (push `(when ,suppliedp*
+				      (push ,keyword-name ,argsym)
+				      (push ,name ,argsym))
+				   remaining)))
+      (when aokeys
+	(push '&allow-other-keys normalisedll))
+      `(defun ,name ,(nreverse normalisedll)
+	 (let ((,argsym (list ,@(reverse required))))
+	   ,@(nreverse remaining)
+	   (nreversef ,argsym)
+	   ,@forms)))))
 
 (defmacro define-simple-error (name &optional docstring)
   `(progn