src/client-script.lisp

   1 (uiop:define-package #:lw2.client-script
   2   (:documentation "Facilities for code that runs on both web browsers and the server.")
   3   (:use #:cl #:parenscript #:lw2.html-reader)
   4   (:import-from #:alexandria #:assoc-value)
   5   (:export #:client-script-function #:client-script #:client-defun
   6            #:write-package-client-scripts
   7            #:if-client #:when-client #:when-server
   8            #:call-with-server-data
   9            #:activate-client-trigger))
  10
  11 (in-package #:lw2.client-script)
  12
  13 (sb-ext:defglobal *client-script-hash* (make-hash-table :test 'eq :weakness :key :synchronized t))
  14
  15 (defclass client-script-function (closer-mop:funcallable-standard-object)
  16   ((script :initarg :script :accessor client-script :type string))
  17   (:metaclass closer-mop:funcallable-standard-class))
  18
  19 (defmacro client-defun (name (&rest lambda-list) &body body)
  20   (labels ((client-test-macros (client-p body)
  21              `(macrolet ((if-client (client server)
  22                            (declare (ignorable client server))
  23                            ,(if client-p 'client 'server))
  24                          (when-client (&body body) `(if-client (progn ,@body) nil))
  25                          (when-server (&body body) `(if-client nil (progn ,@body))))
  26                 ,body)))
  27     `(progn
  28        (declaim (ftype function ,name))
  29        (let* ((csf (make-instance 'client-script-function
  30                                   :script (parenscript:ps ,(client-test-macros t `(defun ,name ,lambda-list ,@body))))))
  31          (closer-mop:set-funcallable-instance-function csf ,(client-test-macros nil `(lambda ,lambda-list ,@body)))
  32          (setf (fdefinition ',name) csf)
  33          (add-client-script-to-package ',name csf *package*)))))
  34
  35 (defun add-client-script-to-package (name csf package)
  36   (setf (assoc-value (gethash package *client-script-hash*) name)
  37         csf))
  38
  39 (defun write-package-client-scripts (package stream)
  40   (dolist (csf-acons (gethash package *client-script-hash*))
  41     (write-string (client-script (cdr csf-acons)) stream)
  42     (terpri stream)))
  43
  44 (defmacro if-client (client server)
  45   (declare (ignore client))
  46   server)
  47
  48 (defmacro when-client (&body body)
  49   (declare (ignore body))
  50   nil)
  51
  52 (defmacro when-server (&body body)
  53   `(progn ,@body))
  54
  55 (defun call-with-server-data (client-function server-endpoint-uri)
  56   (with-html-stream-output (:stream stream)
  57     (format stream "<script async src=\"data:text/javascript,callWithServerData('~A','~A');\"></script>" (json:lisp-to-camel-case (string client-function)) server-endpoint-uri)))
  58
  59 (defun activate-client-trigger (trigger-name)
  60   (with-html-stream-output (:stream stream)
  61     (format stream "<script>activateTrigger('~A');</script>" trigger-name)))