coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Web extension module for def-forms + modifier-key clicks + CSSX SSR fix

Browse Source 
Move defhandler/defquery/defaction/defpage/defrelation from hardcoded
evaluator dispatch to web/web-forms.sx extension module, registered via
register-special-form!. Adapters updated to use definition-form? and
dynamically extended form-name lists.

Fix modifier-key clicks (ctrl-click → new tab) in three click handlers:
bindBoostLink, bindClientRouteClick, and orchestration.sx bind-event.
Add event-modifier-key? primitive (eventModifierKey_p for transpiler).

Fix CSSX SSR: ~cssx/flush no longer drains the collected bucket on the
server, so the shell template correctly emits CSSX rules in <head>.

Add missing server-side DOM stubs (create-text-node, dom-append, etc.)
and SSR passthrough for portal/error-boundary/promise-delayed.

Passive event listeners for touch/wheel/scroll to fix touchpad scrolling.

97/97 Playwright demo tests + 4/4 isomorphic SSR tests pass.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-24 10:01:41 +00:00
parent 8ccf5f7c1e
commit 8a08de26cd
11 changed files with 318 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
hosts/javascript/platform.py
View File

@@ -2047,8 +2047,10 @@ PLATFORM_DOM_JS = """
: function(e) { try { cekCall(handler, [e]); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } finally { runPostRenderHooks(); } })
: handler;
if (name === "click") logInfo("domListen: click on <" + (el.tagName||"?").toLowerCase() + "> text=" + (el.textContent||"").substring(0,20) + " isLambda=" + isLambda(handler));
el.addEventListener(name, wrapped);
return function() { el.removeEventListener(name, wrapped); };
var passiveEvents = { touchstart: 1, touchmove: 1, wheel: 1, scroll: 1 };
var opts = passiveEvents[name] ? { passive: true } : undefined;
el.addEventListener(name, wrapped, opts);
return function() { el.removeEventListener(name, wrapped, opts); };
}
function eventDetail(e) {
@@ -2670,6 +2672,7 @@ PLATFORM_ORCHESTRATION_JS = """
function preventDefault_(e) { if (e && e.preventDefault) e.preventDefault(); }
function stopPropagation_(e) { if (e && e.stopPropagation) e.stopPropagation(); }
function eventModifierKey_p(e) { return !!(e && (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey)); }
function domFocus(el) { if (el && el.focus) el.focus(); }
function tryCatch(tryFn, catchFn) {
var t = _wrapSxFn(tryFn);
@@ -2773,6 +2776,7 @@ PLATFORM_ORCHESTRATION_JS = """
function bindBoostLink(el, _href) {
el.addEventListener("click", function(e) {
if (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey) return;
e.preventDefault();
// Re-read href from element at click time (not closed-over value)
var liveHref = el.getAttribute("href") || _href;
@@ -2804,6 +2808,7 @@ PLATFORM_ORCHESTRATION_JS = """
function bindClientRouteClick(link, _href, fallbackFn) {
link.addEventListener("click", function(e) {
if (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey) return;
e.preventDefault();
// Re-read href from element at click time (not closed-over value)
var liveHref = link.getAttribute("href") || _href;
@@ -2954,7 +2959,7 @@ PLATFORM_ORCHESTRATION_JS = """
} else {
fn();
}
});
}, { passive: true });
});
}
@@ -3283,6 +3288,7 @@ def fixups_js(has_html, has_sx, has_dom, has_signals=False, has_deps=False, has_
if (typeof domClosest === "function") PRIMITIVES["dom-closest"] = domClosest;
if (typeof domMatches === "function") PRIMITIVES["dom-matches?"] = domMatches;
if (typeof preventDefault_ === "function") PRIMITIVES["prevent-default"] = preventDefault_;
if (typeof eventModifierKey_p === "function") PRIMITIVES["event-modifier-key?"] = eventModifierKey_p;
if (typeof elementValue === "function") PRIMITIVES["element-value"] = elementValue;
if (typeof domOuterHtml === "function") PRIMITIVES["dom-outer-html"] = domOuterHtml;
if (typeof domInnerHtml === "function") PRIMITIVES["dom-inner-html"] = domInnerHtml;

32
hosts/ocaml/bin/sx_server.ml
View File

@@ -125,11 +125,9 @@ let io_batch_mode = ref false
let io_queue : (int * string * value list) list ref = ref []
let io_counter = ref 0
(** Module-level scope stacks — shared between make_server_env (aser
scope-push!/pop!) and step-sf-context (via get-primitive "scope-peek"). *)
(** Request cookies — set by Python bridge before each page render.
get-cookie reads from here on the server; set-cookie is a no-op
(server can't set response cookies from SX — that's the framework's job). *)
(* Request cookies — set by Python bridge before each page render.
get-cookie reads from here on the server; set-cookie is a no-op
(server can't set response cookies from SX — that's the framework's job). *)
let _request_cookies : (string, string) Hashtbl.t = Hashtbl.create 8
let () = Sx_primitives.register "get-cookie" (fun args ->
@@ -144,6 +142,8 @@ let () = Sx_primitives.register "set-cookie" (fun _args ->
(* No-op on server — cookies are set via HTTP response headers *)
Nil)
(* Module-level scope stacks — shared between make_server_env (aser
scope-push!/pop!) and step-sf-context (via get-primitive "scope-peek"). *)
let _scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8
let () = Sx_primitives.register "scope-push!" (fun args ->
@@ -496,6 +496,10 @@ let make_server_env () =
bind "dom-text-content" (fun _args -> String "");
bind "dom-set-text-content" (fun _args -> Nil);
bind "dom-body" (fun _args -> Nil);
bind "dom-create-element" (fun _args -> Nil);
bind "dom-append" (fun _args -> Nil);
bind "create-text-node" (fun _args -> Nil);
bind "render-to-dom" (fun _args -> Nil);
(* Raw HTML — platform primitives for adapter-html.sx *)
bind "make-raw-html" (fun args ->
@@ -617,6 +621,16 @@ let make_server_env () =
Sx_ref.eval_expr m.m_body (Env body_env)
| _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
(* Expose register-special-form! and *custom-special-forms* to SX code
(used by web-forms.sx and adapter form-classification functions) *)
bind "register-special-form!" (fun args ->
match args with
| [String name; handler] ->
ignore (Sx_ref.register_special_form (String name) handler);
Nil
| _ -> raise (Eval_error "register-special-form!: expected (name handler)"));
ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms);
(* Register <> as a special form — evaluates all children, returns list *)
ignore (Sx_ref.register_special_form (String "<>") (NativeFn ("<>", fun args ->
List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args))));
@@ -725,10 +739,8 @@ let make_server_env () =
bind "set-response-status" (fun args -> io_request "set-response-status" args);
bind "set-response-header" (fun args -> io_request "set-response-header" args);
(* Application constructs — no-ops in the kernel, but needed so
handler/page files load successfully (their define forms get evaluated) *)
ignore (Sx_ref.register_special_form (String "defhandler") (NativeFn ("defhandler", fun _args -> Nil)));
ignore (Sx_ref.register_special_form (String "defpage") (NativeFn ("defpage", fun _args -> Nil)));
(* defhandler/defpage/defquery/defaction/defrelation are registered by
web-forms.sx via register-special-form!, no longer hardcoded here. *)
bind "cond-scheme?" (fun args ->
match args with
@@ -1504,6 +1516,7 @@ let cli_mode mode =
Filename.concat base "render.sx";
Filename.concat web_base "adapter-html.sx";
Filename.concat web_base "adapter-sx.sx";
Filename.concat web_base "web-forms.sx";
] in
(* Load spec files for all CLI modes that need rendering *)
(if mode = "aser" || mode = "aser-slot" || mode = "render" then
@@ -1588,6 +1601,7 @@ let test_mode () =
Filename.concat web_base "signals.sx";
Filename.concat web_base "adapter-html.sx";
Filename.concat web_base "adapter-sx.sx";
Filename.concat web_base "web-forms.sx";
] in
cli_load_files env files;
(* Register JIT *)

28
shared/static/scripts/sx-browser.js
View File

@@ -14,7 +14,7 @@
// =========================================================================
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
var SX_VERSION = "2026-03-24T04:23:51Z";
var SX_VERSION = "2026-03-24T09:53:22Z";
function isNil(x) { return x === NIL || x === null || x === undefined; }
function isSxTruthy(x) { return x !== false && !isNil(x); }
@@ -2237,7 +2237,7 @@ PRIMITIVES["VOID_ELEMENTS"] = VOID_ELEMENTS;
PRIMITIVES["BOOLEAN_ATTRS"] = BOOLEAN_ATTRS;
// definition-form?
var isDefinitionForm = function(name) { return sxOr((name == "define"), (name == "defcomp"), (name == "defisland"), (name == "defmacro"), (name == "defstyle"), (name == "defhandler"), (name == "deftype"), (name == "defeffect")); };
var isDefinitionForm = function(name) { return sxOr((name == "define"), (name == "defcomp"), (name == "defisland"), (name == "defmacro"), (name == "defstyle"), (name == "deftype"), (name == "defeffect")); };
PRIMITIVES["definition-form?"] = isDefinitionForm;
// parse-element-args
@@ -2520,7 +2520,7 @@ PRIMITIVES["render-to-html"] = renderToHtml;
PRIMITIVES["render-value-to-html"] = renderValueToHtml;
// RENDER_HTML_FORMS
var RENDER_HTML_FORMS = ["if", "when", "cond", "case", "let", "let*", "letrec", "begin", "do", "define", "defcomp", "defisland", "defmacro", "defstyle", "defhandler", "deftype", "defeffect", "map", "map-indexed", "filter", "for-each", "scope", "provide"];
var RENDER_HTML_FORMS = ["if", "when", "cond", "case", "let", "let*", "letrec", "begin", "do", "define", "defcomp", "defisland", "defmacro", "defstyle", "deftype", "defeffect", "map", "map-indexed", "filter", "for-each", "scope", "provide"];
PRIMITIVES["RENDER_HTML_FORMS"] = RENDER_HTML_FORMS;
// render-html-form?
@@ -2533,10 +2533,10 @@ PRIMITIVES["render-html-form?"] = isRenderHtmlForm;
return (isSxTruthy(!isSxTruthy((typeOf(head) == "symbol"))) ? join("", map(function(x) { return renderValueToHtml(x, env); }, expr)) : (function() {
var name = symbolName(head);
var args = rest(expr);
return (isSxTruthy((name == "<>")) ? join("", map(function(x) { return renderToHtml(x, env); }, args)) : (isSxTruthy((name == "raw!")) ? join("", map(function(x) { return (String(trampoline(evalExpr(x, env)))); }, args)) : (isSxTruthy((name == "lake")) ? renderHtmlLake(args, env) : (isSxTruthy((name == "marsh")) ? renderHtmlMarsh(args, env) : (isSxTruthy(contains(HTML_TAGS, name)) ? renderHtmlElement(name, args, env) : (isSxTruthy((isSxTruthy(startsWith(name, "~")) && isSxTruthy(envHas(env, name)) && isIsland(envGet(env, name)))) ? renderHtmlIsland(envGet(env, name), args, env) : (isSxTruthy(startsWith(name, "~")) ? (function() {
return (isSxTruthy((name == "<>")) ? join("", map(function(x) { return renderToHtml(x, env); }, args)) : (isSxTruthy((name == "raw!")) ? join("", map(function(x) { return (String(trampoline(evalExpr(x, env)))); }, args)) : (isSxTruthy((name == "lake")) ? renderHtmlLake(args, env) : (isSxTruthy((name == "marsh")) ? renderHtmlMarsh(args, env) : (isSxTruthy(sxOr((name == "portal"), (name == "error-boundary"), (name == "promise-delayed"))) ? join("", map(function(x) { return renderToHtml(x, env); }, args)) : (isSxTruthy(contains(HTML_TAGS, name)) ? renderHtmlElement(name, args, env) : (isSxTruthy((isSxTruthy(startsWith(name, "~")) && isSxTruthy(envHas(env, name)) && isIsland(envGet(env, name)))) ? renderHtmlIsland(envGet(env, name), args, env) : (isSxTruthy(startsWith(name, "~")) ? (function() {
var val = envGet(env, name);
return (isSxTruthy(isComponent(val)) ? renderHtmlComponent(val, args, env) : (isSxTruthy(isMacro(val)) ? renderToHtml(expandMacro(val, args, env), env) : error((String("Unknown component: ") + String(name)))));
})() : (isSxTruthy(isRenderHtmlForm(name)) ? dispatchHtmlForm(name, expr, env) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? renderToHtml(expandMacro(envGet(env, name), args, env), env) : renderValueToHtml(trampoline(evalExpr(expr, env)), env))))))))));
})() : (isSxTruthy(isRenderHtmlForm(name)) ? dispatchHtmlForm(name, expr, env) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? renderToHtml(expandMacro(envGet(env, name), args, env), env) : renderValueToHtml(trampoline(evalExpr(expr, env)), env)))))))))));
})());
})()); };
PRIMITIVES["render-list-to-html"] = renderListToHtml;
@@ -3110,7 +3110,7 @@ PRIMITIVES["render-dom-raw"] = renderDomRaw;
PRIMITIVES["render-dom-unknown-component"] = renderDomUnknownComponent;
// RENDER_DOM_FORMS
var RENDER_DOM_FORMS = ["if", "when", "cond", "case", "let", "let*", "begin", "do", "define", "defcomp", "defisland", "defmacro", "defstyle", "defhandler", "map", "map-indexed", "filter", "for-each", "portal", "error-boundary", "scope", "provide"];
var RENDER_DOM_FORMS = ["if", "when", "cond", "case", "let", "let*", "begin", "do", "define", "defcomp", "defisland", "defmacro", "defstyle", "map", "map-indexed", "filter", "for-each", "portal", "error-boundary", "scope", "provide"];
PRIMITIVES["RENDER_DOM_FORMS"] = RENDER_DOM_FORMS;
// render-dom-form?
@@ -4181,7 +4181,7 @@ PRIMITIVES["bind-triggers"] = bindTriggers;
return (isSxTruthy((val == lastVal)) ? (shouldFire = false) : (lastVal = val));
})();
}
return (isSxTruthy(shouldFire) ? ((isSxTruthy(sxOr((eventName == "submit"), (isSxTruthy((eventName == "click")) && domHasAttr(el, "href")))) ? preventDefault_(e) : NIL), (function() {
return (isSxTruthy(shouldFire) ? ((isSxTruthy((isSxTruthy((eventName == "click")) && eventModifierKey_p(e))) ? (shouldFire = false) : NIL), (isSxTruthy(shouldFire) ? ((isSxTruthy(sxOr((eventName == "submit"), (isSxTruthy((eventName == "click")) && domHasAttr(el, "href")))) ? preventDefault_(e) : NIL), (function() {
var liveInfo = sxOr(getVerbInfo(el), verbInfo);
var isGetLink = (isSxTruthy((eventName == "click")) && isSxTruthy((get(liveInfo, "method") == "GET")) && isSxTruthy(domHasAttr(el, "href")) && !isSxTruthy(get(mods, "delay")));
var clientRouted = false;
@@ -4189,7 +4189,7 @@ PRIMITIVES["bind-triggers"] = bindTriggers;
clientRouted = tryClientRoute(urlPathname(get(liveInfo, "url")), domGetAttr(el, "sx-target"));
}
return (isSxTruthy(clientRouted) ? (browserPushState(get(liveInfo, "url")), browserScrollTo(0, 0)) : ((isSxTruthy(isGetLink) ? logInfo((String("sx:route server fetch ") + String(get(liveInfo, "url")))) : NIL), (isSxTruthy(get(mods, "delay")) ? (clearTimeout_(timer), (timer = setTimeout_(function() { return executeRequest(el, NIL, NIL); }, get(mods, "delay")))) : executeRequest(el, NIL, NIL))));
})()) : NIL);
})()) : NIL)) : NIL);
})(); }, (isSxTruthy(get(mods, "once")) ? {["once"]: true} : NIL)) : NIL);
})(); };
PRIMITIVES["bind-event"] = bindEvent;
@@ -5880,6 +5880,7 @@ PRIMITIVES["resource"] = resource;
if (typeof domClosest === "function") PRIMITIVES["dom-closest"] = domClosest;
if (typeof domMatches === "function") PRIMITIVES["dom-matches?"] = domMatches;
if (typeof preventDefault_ === "function") PRIMITIVES["prevent-default"] = preventDefault_;
if (typeof eventModifierKey_p === "function") PRIMITIVES["event-modifier-key?"] = eventModifierKey_p;
if (typeof elementValue === "function") PRIMITIVES["element-value"] = elementValue;
if (typeof domOuterHtml === "function") PRIMITIVES["dom-outer-html"] = domOuterHtml;
if (typeof domInnerHtml === "function") PRIMITIVES["dom-inner-html"] = domInnerHtml;
@@ -6183,8 +6184,10 @@ PRIMITIVES["resource"] = resource;
: function(e) { try { cekCall(handler, [e]); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } finally { runPostRenderHooks(); } })
: handler;
if (name === "click") logInfo("domListen: click on <" + (el.tagName||"?").toLowerCase() + "> text=" + (el.textContent||"").substring(0,20) + " isLambda=" + isLambda(handler));
el.addEventListener(name, wrapped);
return function() { el.removeEventListener(name, wrapped); };
var passiveEvents = { touchstart: 1, touchmove: 1, wheel: 1, scroll: 1 };
var opts = passiveEvents[name] ? { passive: true } : undefined;
el.addEventListener(name, wrapped, opts);
return function() { el.removeEventListener(name, wrapped, opts); };
}
function eventDetail(e) {
@@ -6802,6 +6805,7 @@ PRIMITIVES["resource"] = resource;
function preventDefault_(e) { if (e && e.preventDefault) e.preventDefault(); }
function stopPropagation_(e) { if (e && e.stopPropagation) e.stopPropagation(); }
function eventModifierKey_p(e) { return !!(e && (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey)); }
function domFocus(el) { if (el && el.focus) el.focus(); }
function tryCatch(tryFn, catchFn) {
var t = _wrapSxFn(tryFn);
@@ -6905,6 +6909,7 @@ PRIMITIVES["resource"] = resource;
function bindBoostLink(el, _href) {
el.addEventListener("click", function(e) {
if (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey) return;
e.preventDefault();
// Re-read href from element at click time (not closed-over value)
var liveHref = el.getAttribute("href") || _href;
@@ -6936,6 +6941,7 @@ PRIMITIVES["resource"] = resource;
function bindClientRouteClick(link, _href, fallbackFn) {
link.addEventListener("click", function(e) {
if (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey) return;
e.preventDefault();
// Re-read href from element at click time (not closed-over value)
var liveHref = link.getAttribute("href") || _href;
@@ -7086,7 +7092,7 @@ PRIMITIVES["resource"] = resource;
} else {
fn();
}
});
}, { passive: true });
});
}

5
shared/sx/ocaml_bridge.py
View File

@@ -420,10 +420,11 @@ class OcamlBridge:
# All directories loaded into the Python env
all_dirs = list(set(_watched_dirs) | _dirs_from_cache)
# Isomorphic libraries: signals, rendering, freeze scopes
# Isomorphic libraries: signals, rendering, freeze scopes, web forms
web_dir = os.path.join(os.path.dirname(__file__), "../../web")
if os.path.isdir(web_dir):
for web_file in ["signals.sx", "adapter-html.sx", "adapter-sx.sx"]:
for web_file in ["signals.sx", "adapter-html.sx", "adapter-sx.sx",
"web-forms.sx"]:
path = os.path.normpath(os.path.join(web_dir, web_file))
if os.path.isfile(path):
all_files.append(path)

23
shared/sx/templates/cssx.sx
View File

@@ -494,16 +494,13 @@
;; =========================================================================
(defcomp ~cssx/flush () :affinity :client
(let ((rules (collected "cssx")))
(clear-collected! "cssx")
(when (not (empty? rules))
;; Append to the persistent <style id="sx-css"> in <head> if available.
;; This survives #main-panel morphs during SPA navigation.
;; Falls back to inline <style> if no head stylesheet exists.
(let ((head-style (dom-query "#sx-css")))
(if head-style
(do
(dom-set-prop head-style "textContent"
(str (dom-get-prop head-style "textContent") (join "" rules)))
nil)
(raw! (str "<style data-cssx>" (join "" rules) "</style>")))))))
(let ((rules (collected "cssx"))
(head-style (dom-query "#sx-css")))
;; On client: append rules to <style id="sx-css"> in <head>.
;; On server: head-style is nil (no DOM). Don't clear the bucket —
;; the shell's <head> template reads collected("cssx") and emits them.
(when head-style
(clear-collected! "cssx")
(when (not (empty? rules))
(dom-set-prop head-style "textContent"
(str (dom-get-prop head-style "textContent") (join "" rules)))))))

2
spec/render.sx
View File

@@ -74,7 +74,7 @@
(define definition-form? :effects []
(fn ((name :as string))
(or (= name "define") (= name "defcomp") (= name "defisland")
(= name "defmacro") (= name "defstyle") (= name "defhandler")
(= name "defmacro") (= name "defstyle")
(= name "deftype") (= name "defeffect"))))

8
web/adapter-async.sx
View File

@@ -333,7 +333,7 @@
(define ASYNC_RENDER_FORMS
(list "if" "when" "cond" "case" "let" "let*" "begin" "do"
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
"define" "defcomp" "defisland" "defmacro" "defstyle"
"deftype" "defeffect"
"map" "map-indexed" "filter" "for-each" "scope" "provide"))
@@ -924,7 +924,6 @@
(list "if" "when" "cond" "case" "and" "or"
"let" "let*" "lambda" "fn"
"define" "defcomp" "defmacro" "defstyle"
"defhandler" "defpage" "defquery" "defaction"
"begin" "do" "quote" "->" "set!" "defisland"
"deftype" "defeffect" "scope" "provide"))
@@ -1058,10 +1057,7 @@
(serialize expr))
;; Definition forms — evaluate for side effects
(or (= name "define") (= name "defcomp") (= name "defmacro")
(= name "defstyle") (= name "defhandler") (= name "defpage")
(= name "defquery") (= name "defaction")
(= name "deftype") (= name "defeffect"))
(definition-form? name)
(do (async-eval expr env ctx) nil)
;; scope — unified render-time dynamic scope

2
web/adapter-dom.sx
View File

@@ -379,7 +379,7 @@
(define RENDER_DOM_FORMS
(list "if" "when" "cond" "case" "let" "let*" "begin" "do"
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
"define" "defcomp" "defisland" "defmacro" "defstyle"
"map" "map-indexed" "filter" "for-each" "portal"
"error-boundary" "scope" "provide"))

7
web/adapter-html.sx
View File

@@ -57,7 +57,7 @@
(define RENDER_HTML_FORMS
(list "if" "when" "cond" "case" "let" "let*" "letrec" "begin" "do"
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
"define" "defcomp" "defisland" "defmacro" "defstyle"
"deftype" "defeffect"
"map" "map-indexed" "filter" "for-each" "scope" "provide"))
@@ -97,6 +97,11 @@
(= name "marsh")
(render-html-marsh args env)
;; Client-only wrappers — render children, skip wrapper
(or (= name "portal") (= name "error-boundary")
(= name "promise-delayed"))
(join "" (map (fn (x) (render-to-html x env)) args))
;; HTML tag
(contains? HTML_TAGS name)
(render-html-element name args env)

7
web/orchestration.sx
View File

@@ -416,6 +416,11 @@
(set! last-val val))))
(when should-fire
;; Let browser handle modifier-key clicks (ctrl-click → new tab)
(when (and (= event-name "click") (event-modifier-key? e))
(set! should-fire false))
(when should-fire
;; Prevent default for submit/click on links
(when (or (= event-name "submit")
(and (= event-name "click")
@@ -448,7 +453,7 @@
(set-timeout
(fn () (execute-request el nil nil))
(get mods "delay"))))
(execute-request el nil nil))))))))
(execute-request el nil nil)))))))))
(if (get mods "once") (dict "once" true) nil))))))

240
web/web-forms.sx Normal file
View File

@@ -0,0 +1,240 @@
;; ==========================================================================
;; web-forms.sx — Web-specific definition forms
;;
;; Registers defhandler, defquery, defaction, defpage, and defrelation as
;; custom special forms via register-special-form!. These are web platform
;; constructs, not core language features — loaded as an extension module
;; rather than being hardcoded in the evaluator.
;;
;; Each form parses its domain-specific argument structure and stores
;; a definition dict in the environment with a namespaced key:
;; handler:name, query:name, action:name, page:name, relation:name
;;
;; Platform hosts provide typed constructors (make-handler-def etc.) that
;; return host-appropriate values. If unavailable, plain dicts are used.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Shared helpers
;; --------------------------------------------------------------------------
(define parse-key-params
(fn (params-expr)
;; Parse (&key param1 param2 ...) → list of param name strings.
;; Skips &key marker, collects symbol names.
(let ((params (list)))
(for-each
(fn (p)
(when (= (type-of p) "symbol")
(let ((name (symbol-name p)))
(when (not (= name "&key"))
(append! params name)))))
params-expr)
params)))
(define parse-handler-args
(fn (args)
;; Parse defhandler args after the name symbol.
;; Scans for :keyword value option pairs, then a list (params), then body.
;; Returns dict with keys: opts, params, body.
(let ((opts (dict))
(params (list))
(body nil)
(i 0)
(n (len args))
(done false))
(for-each
(fn (idx)
(when (and (not done) (= idx i))
(let ((arg (nth args idx)))
(cond
(= (type-of arg) "keyword")
(do
(when (< (+ idx 1) n)
(let ((val (nth args (+ idx 1))))
(dict-set! opts (keyword-name arg)
(if (= (type-of val) "keyword")
(keyword-name val)
val))))
(set! i (+ idx 2)))
(= (type-of arg) "list")
(do
(set! params (parse-key-params arg))
(when (< (+ idx 1) n)
(set! body (nth args (+ idx 1))))
(set! done true))
:else
(do
(set! body arg)
(set! done true))))))
(range 0 n))
(dict "opts" opts "params" params "body" body))))
;; --------------------------------------------------------------------------
;; defhandler — Event handler / HTTP endpoint definition
;; --------------------------------------------------------------------------
(register-special-form! "defhandler"
(fn (args env)
(let ((name-sym (first args))
(name (symbol-name (first args)))
(parsed (parse-handler-args (rest args)))
(opts (get parsed "opts"))
(params (get parsed "params"))
(body (get parsed "body")))
(let ((hdef (dict
"__type" "handler"
"name" name
"params" params
"body" body
"closure" env
"path" (or (get opts "path") nil)
"method" (or (get opts "method") "get")
"csrf" (let ((v (get opts "csrf")))
(if (nil? v) true v))
"returns" (or (get opts "returns") "element"))))
(env-bind! env (str "handler:" name) hdef)
hdef))))
;; --------------------------------------------------------------------------
;; defquery — Named query for data fetching
;; --------------------------------------------------------------------------
(register-special-form! "defquery"
(fn (args env)
(let ((name (symbol-name (first args)))
(params-raw (nth args 1))
(params (parse-key-params params-raw))
(has-doc (and (>= (len args) 4)
(= (type-of (nth args 2)) "string")))
(doc (if has-doc (nth args 2) ""))
(body (if has-doc (nth args 3) (nth args 2))))
(let ((qdef (dict
"__type" "query"
"name" name
"params" params
"doc" doc
"body" body
"closure" env)))
(env-bind! env (str "query:" name) qdef)
qdef))))
;; --------------------------------------------------------------------------
;; defaction — Named action for mutations
;; --------------------------------------------------------------------------
(register-special-form! "defaction"
(fn (args env)
(let ((name (symbol-name (first args)))
(params-raw (nth args 1))
(params (parse-key-params params-raw))
(has-doc (and (>= (len args) 4)
(= (type-of (nth args 2)) "string")))
(doc (if has-doc (nth args 2) ""))
(body (if has-doc (nth args 3) (nth args 2))))
(let ((adef (dict
"__type" "action"
"name" name
"params" params
"doc" doc
"body" body
"closure" env)))
(env-bind! env (str "action:" name) adef)
adef))))
;; --------------------------------------------------------------------------
;; defpage — Page route definition
;; --------------------------------------------------------------------------
(register-special-form! "defpage"
(fn (args env)
(let ((name (symbol-name (first args)))
(slots (dict))
(n (len args)))
;; Parse :key value pairs after the name
(for-each
(fn (idx)
(let ((k-idx (+ 1 (* idx 2)))
(v-idx (+ 2 (* idx 2))))
(when (and (< k-idx n) (< v-idx n)
(= (type-of (nth args k-idx)) "keyword"))
(dict-set! slots (keyword-name (nth args k-idx))
(nth args v-idx)))))
(range 0 (/ (- n 1) 2)))
(let ((pdef (dict
"__type" "page"
"name" name
"path" (or (get slots "path") "")
"auth" (or (get slots "auth") "public")
"layout" (get slots "layout")
"data" (get slots "data")
"content" (get slots "content")
"filter" (get slots "filter")
"aside" (get slots "aside")
"menu" (get slots "menu")
"stream" (get slots "stream")
"fallback" (get slots "fallback")
"shell" (get slots "shell")
"closure" env)))
(env-bind! env (str "page:" name) pdef)
pdef))))
;; --------------------------------------------------------------------------
;; defrelation — Relationship definition (cross-domain)
;; --------------------------------------------------------------------------
(register-special-form! "defrelation"
(fn (args env)
(let ((name (symbol-name (first args)))
(slots (dict))
(n (len args)))
(for-each
(fn (idx)
(let ((k-idx (+ 1 (* idx 2)))
(v-idx (+ 2 (* idx 2))))
(when (and (< k-idx n) (< v-idx n)
(= (type-of (nth args k-idx)) "keyword"))
(dict-set! slots (keyword-name (nth args k-idx))
(nth args v-idx)))))
(range 0 (/ (- n 1) 2)))
(let ((rdef (dict
"__type" "relation"
"name" name
"slots" slots
"closure" env)))
(env-bind! env (str "relation:" name) rdef)
rdef))))
;; --------------------------------------------------------------------------
;; Patch form-classification functions
;;
;; The adapters (html, sx, dom, async) use classifier functions to decide
;; how to handle forms during rendering. Now that these web forms are
;; registered as custom special forms, we redefine the classifiers to
;; include them. This runs after all adapters are loaded.
;; --------------------------------------------------------------------------
(define WEB_FORM_NAMES
(list "defhandler" "defpage" "defquery" "defaction" "defrelation"))
;; Redefine definition-form? to include web forms.
;; All adapters call this to identify "eval for side effects" forms.
(let ((core-definition-form? definition-form?))
(define definition-form?
(fn (name)
(or (core-definition-form? name)
(contains? WEB_FORM_NAMES name)))))
;; Extend adapter form-name lists so dispatchers recognise web forms.
;; These lists are mutable — append! adds to them in place.
(for-each (fn (name)
(append! RENDER_HTML_FORMS name)
(append! SPECIAL_FORM_NAMES name))
WEB_FORM_NAMES)