Weblocks forms with callback support

weblocks-forms.lisp

(defpackage :weblocks/forms
  (:use :cl)
  (:import-from #:weblocks/actions
                #:make-action-url
                #:function-or-action->action
                #:get-request-action)
  (:import-from #:weblocks/html
                #:with-html)
  (:import-from #:weblocks/request
                #:get-path)
  (:import-from #:weblocks/utils/string
                #:humanize-name
                #:attributize-name)
  (:import-from #:quri
                #:url-encode)
  (:import-from #:weblocks/variables
                #:*action-string*)
  (:export #:with-form
           #:callback
           #:submit-form-action))

(in-package :weblocks/forms)

(defun handle-form-submit (action)
  (lambda (&rest args)
    "Handle form submit"
    ;; Iterate over the submitted values, and process those that
    ;; are bound to an action.
    (loop for field-name in args by #'cddr
          for field-value in (rest args) by #'cddr
          do
             (let ((action (get-request-action (string-downcase (string field-name)) :ignore-missing-actions t)))
               (when action
                 (funcall action field-value))))

    (funcall action)))

(defmacro callback (args &body body)
  "To register field callbacks use callback as name.
For example: (:input :name (callback (value) ...))"
  `(function-or-action->action (lambda ,args ,@body)))

(defmacro submit-form-action (args &body body)
  `(format nil "initiateFormAction(\"~A\", $(this).closest('form'), \"\")"
           (url-encode (function-or-action->action
                        (handle-form-submit (lambda ,args ,@body))))))



(defmacro with-form
    ((method-type
      action &key
               id
               class
               enctype
               (use-ajax-p t)
               extra-submit-code
               (submit-fn "initiateFormAction(\"~A\", $(this), \"~A\")"))
     &body body)
  "Transforms to a form like (:form) with standard form code (AJAX support, actions, etc.)"
  (let ((action-code (gensym)))
    `(let ((,action-code (function-or-action->action (handle-form-submit ,action))))
       (with-html
         (:form :id ,id :class ,class :action (get-path)
                :method (attributize-name ,method-type) :enctype ,enctype
                :onsubmit (when ,use-ajax-p
                            (format nil "~@[~A~]~A; return false;"
                                    ,extra-submit-code
                                    (format nil ,submit-fn
                                            (url-encode (or ,action-code ""))
                                            ;; Function session-name-string-pair was removed
                                            ;; during weblocks refactoring, so we just
                                            ;;
                                            ""
                                            ;; (weblocks::session-name-string-pair)
                                            )))
                (:span
                 ,@body
                 (:input :name *action-string* :type "hidden" :value ,action-code))))
       ;; TODO: may be return log-from into the Weblocks
       ;; (weblocks::log-form ,action-code :id ,id :class ,class)
       )))