@@ -3,4 +3,26 @@

 (defmacro with-accessors* ((&rest accessors) object &body body)

   `(with-accessors ,(ensure-mapping accessors) ,object

      ,@body))

-       

+

+(defmacro new (class &rest initializer-syms)

+  (multiple-value-bind (required optional rest) (parse-ordinary-lambda-list initializer-syms)

+    (when optional

+      (error "new doesn't handle optional arguments"))

+    (if rest

+        `(make-instance ,class

+                        ,@(mapcan (serapeum:op (list (alexandria:make-keyword _1) _1))

+                                  required)

+                        ,(make-keyword rest) ,rest)

+        `(make-instance ,class

+                        ,@(mapcan (serapeum:op (list (alexandria:make-keyword _1) _1))

+                                  initializer-syms)))))

+

+(defun-ct %constructor-name (class)

+  (format nil "~a-~a" '#:make class))

+

+(defmacro make-constructor (class &rest args)

+  (destructuring-bind (class &optional (constructor-name (intern (%constructor-name class))))

+      (ensure-list class)

+    `(defgeneric ,constructor-name (,@args)

+       (:method (,@args)

+         (new ',class ,@args)))))

@@ -3,3 +3,16 @@

 (defmacro twice (&body body)

   `(progn ,@body

           ,@body))

+

+(defmacro define-cluser-entrypoint ((&rest args) &body body)

+  "Use the current package name to generate a <PACKAGE-NAME>.MAIN function in CL-USER.

+

+This will throw an error if :FW.DEV is not in features as it's not

+intended to be usd in distributed code."

+  (unless (featurep :fw.dev)

+    (error "will not define cluser entrypoint without :FW.DEV in *FEATURES*"))

+  (let ((entrypoint-symbol (intern (format nil "~a.~a" (package-name *package*) '#:main)

+                                   :cl-user)))

+    `(progn (defun ,entrypoint-symbol ,args

+              ,@body)

+            (export ',entrypoint-symbol :cl-user))))

@@ -29,7 +29,10 @@

            #+null #:ensure-list #:pick #:vector-destructuring-bind #:with-accessors*

            #:skip-values #:limit-values #:substitute-values #:op #:pick/r

            #:pick-error #:twice #:glambda #:default-unless #:transform-first-value

-           #:may #:defun-ct)) 

+           #:may #:defun-ct

+           #:define-cluser-entrypoint

+           #:new

+           #:make-constructor)) 

 (defpackage :fwoar.lisputils.shortcuts