1 (in-package :lisp-on-lines-ucw
)
3 ;;; * Lisp on Lines YACLML tags.
8 `(js:gen-js-name-string
:prefix
,string
))
12 ;;; These tags take UCW "actions" and create the appropriate HTML
13 ;;; tag to signal their execution.
15 (defmacro %with-action-unique-names
(&body body
)
17 `(with-unique-names (url action-object action-id current-frame
)
18 (assert (xor action action
* function
) nil
19 "Must supply only one of ACTION, ACTION* or FUNCTION")
21 `(let* ((,current-frame
(context.current-frame
*context
*))
22 (,action-object
,(or action
*
26 (with-call/cc
,action
))))))
27 (,action-id
(register-action-in-frame
32 (,url
(compute-url ,action-object
*current-component
*)))
33 (declare (ignorable ,action-id
,url
))
37 (deftag-macro <lol
:a
(&attribute
(id (gen-id "lol-action"))
38 action action
* function
39 &allow-other-attributes others
41 "A Simple <:A which does not require javascript."
42 (%with-action-unique-names
43 `(<:a
:href
(print-uri-to-string ,url
)
48 (deftag-macro <lol
:form
(&attribute
(id (gen-id "lol-form"))
49 action action
* function
50 &allow-other-attributes others
52 "A Simple form which does not require javascript. "
53 (%with-action-unique-names
54 `(<:form
:action
(print-uri-to-string-sans-query ,url
)
57 (dolist (query (uri.query
,url
))
58 (if (string= ,+action-parameter-name
+ (car query
))
59 (<:input
:type
"hidden" :name
,+action-parameter-name
+
62 (<:input
:type
"hidden" :name
(car query
) :value
(cdr query
))))
65 (deftag-macro <lol
:submit
(&attribute
(id (gen-id "lol-submit"))
66 action action
* function value
67 &allow-other-attributes others
69 (%with-action-unique-names
70 `(<:input
:type
"submit"
71 :value
(or ,value
,@body
)
72 :name
(format nil
"~A~A~A"
73 ,+action-parameter-name
+
74 ,+action-compound-name-delimiter
+
79 ;;; All these tags take some kind of input, and execute a UCW callback.
81 (deftag-macro <lol
:input
(&attribute accessor reader writer
82 (id (gen-id "lol-input"))
83 &allow-other-attributes others
)
84 (let ((reader (or reader accessor
))
85 (writer (or writer
`(lambda (v)
86 (setf ,accessor v
)))))
88 `(<:input
:value
,reader
89 :name
(register-callback ,writer
)