Commitaec12ae3Recorded13 Jul 2026Repositorysigil-web-client

web-client: recognize procedure-valued on-*: event attributes

Message

Wire the on-*: DOM-event convention into the renderer (slate-core.md §9 gap 1). An sxml attribute whose name is a keyword of the form on-<event>: and whose value is a procedure is registered as a DOM event listener via the bridge instead of being ignored:

  • A node-keyed closure registry (keyed by the integer DOM handle, stable across patches since the diff reuses nodes) plus a lazily-installed dispatcher that the bridge routes every fired event to.
  • web-client-apply-attrs gains two additive passes: detach listeners gone from the new attrs, then (re)register the ones present. Plain string/symbol attributes take the exact same path as before (keyword attrs were already skipped by web-client-dom-attribute?).
  • Listeners are unregistered on node removal/replace (patch-node clears an incompatible old subtree; patch-children clears dropped top-level records). This is cleanup only; the reconciliation strategy is unchanged.

on-key: maps to "keydown"; every other on-<x>: maps to "<x>". The closure receives a small general props dict (type, key, is-composing, value, caret); returning #t requests preventDefault.

Changed
 src/sigil/web/client.sgl | 164 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 163 insertions(+), 1 deletion(-)
Diff
src/sigil/web/client.sglmodified
@@ -154,6 +154,145 @@
154
value)
155
(else (list value))))
156
+157
;; ---- on-*: DOM event listeners -----------------------------------------
+158
;; An attribute whose name is a keyword of the form on-<event>: and whose
+159
;; value is a procedure is wired as a DOM event listener through the bridge,
+160
;; keyed by node identity, instead of being treated as a string attribute.
+161
;; When the event fires the bridge calls web-client-dispatch-dom-event, which
+162
;; finds the closure registered for that node + event type and applies it
+163
;; with a small event props dict. Plain string/symbol attributes are
+164
;; untouched by this path.
+165
+166
;; Registry: an alist of (node-id . type-alist), where type-alist maps an
+167
;; event-type string to the closure currently bound for it. node-id is the
+168
;; integer DOM handle the bridge assigns; it is stable across patches because
+169
;; the diff reuses nodes, so it is a durable identity key.
+170
(define web-client-listeners '())
+171
(define web-client-dispatcher-installed? #f)
+172
+173
;; Install the single dispatch handler the bridge routes every fired event
+174
;; to, once, lazily on the first listener registration.
+175
(define (web-client-ensure-dispatcher!)
+176
(when (not web-client-dispatcher-installed?)
+177
(wasm-dom-set-event-handler web-client-dispatch-dom-event)
+178
(set! web-client-dispatcher-installed? #t)))
+179
+180
;; Map an on-<event>: attribute keyword to a DOM event type string. on-key:
+181
;; is a convenience alias for "keydown"; every other on-<x>: maps to "<x>",
+182
;; so the convention stays general (on-change:, on-blur:, ... all work).
+183
(define (web-client-event-type-name attr-key)
+184
(let ((name (keyword->string attr-key)))
+185
(if (and (>= (string-length name) 3)
+186
(string=? (substring name 0 3) "on-"))
+187
(let ((evt (substring name 3 (string-length name))))
+188
(if (string=? evt "key") "keydown" evt))
+189
#f)))
+190
+191
;; An on-*: listener attribute: a keyword of the on-<event>: form whose value
+192
;; is a procedure. Returns the event-type string, or #f if not a listener.
+193
(define (web-client-event-attr-type attr)
+194
(and (pair? attr)
+195
(keyword? (car attr))
+196
(procedure? (web-client-attribute-value attr))
+197
(web-client-event-type-name (car attr))))
+198
+199
(define (web-client-node-listeners node)
+200
(let loop ((rest web-client-listeners))
+201
(cond
+202
((null? rest) #f)
+203
((eqv? (car (car rest)) node) (car rest))
+204
(else (loop (cdr rest))))))
+205
+206
(define (web-client-alist-delete key alist)
+207
(cond
+208
((null? alist) '())
+209
((equal? (car (car alist)) key) (cdr alist))
+210
(else (cons (car alist) (web-client-alist-delete key (cdr alist))))))
+211
+212
;; Register (or refresh) the closure for node + event type. The bridge-level
+213
;; addEventListener happens only the first time a given node + type is seen;
+214
;; later renders just swap the stored closure (the JS listener is stable and
+215
;; always looks up the current closure), so a re-created lambda each render
+216
;; costs nothing at the DOM layer.
+217
(define (web-client-listener-set! node type closure)
+218
(web-client-ensure-dispatcher!)
+219
(let ((entry (web-client-node-listeners node)))
+220
(if entry
+221
(let ((existing (assoc type (cdr entry))))
+222
(if existing
+223
(set-cdr! existing closure)
+224
(begin
+225
(wasm-dom-add-event-listener node type)
+226
(set-cdr! entry (cons (cons type closure) (cdr entry))))))
+227
(begin
+228
(wasm-dom-add-event-listener node type)
+229
(set! web-client-listeners
+230
(cons (cons node (list (cons type closure)))
+231
web-client-listeners))))))
+232
+233
(define (web-client-listener-remove! node type)
+234
(let ((entry (web-client-node-listeners node)))
+235
(when entry
+236
(when (assoc type (cdr entry))
+237
(wasm-dom-remove-event-listener node type)
+238
(let ((rest (web-client-alist-delete type (cdr entry))))
+239
;; Prune the node's entry entirely once its last listener is gone,
+240
;; so the registry never accumulates empty (node . ()) entries.
+241
(if (null? rest)
+242
(set! web-client-listeners
+243
(web-client-alist-delete node web-client-listeners))
+244
(set-cdr! entry rest)))))))
+245
+246
;; Detach every listener on a node and drop its registry entry. Used when a
+247
;; node is removed or replaced so listeners never outlive their node.
+248
(define (web-client-listeners-clear-node! node)
+249
(let ((entry (web-client-node-listeners node)))
+250
(when entry
+251
(for-each (lambda (pair) (wasm-dom-remove-event-listener node (car pair)))
+252
(cdr entry))
+253
(set! web-client-listeners
+254
(web-client-alist-delete node web-client-listeners)))))
+255
+256
;; The dispatch handler the bridge invokes for every fired event: route to
+257
;; the closure registered for this node + event type, applied with the props
+258
;; dict. A #t result propagates back so the bridge can preventDefault.
+259
(define (web-client-dispatch-dom-event node props)
+260
(let ((entry (web-client-node-listeners node)))
+261
(if entry
+262
(let ((existing (assoc (dict-ref props type: "") (cdr entry))))
+263
(if existing ((cdr existing) props) #f))
+264
#f)))
+265
+266
;; Recursively drop listeners for an element record and its subtree.
+267
(define (web-client-unregister-record-tree! record)
+268
(when (and record (pair? record)
+269
(eq? (web-client-record-kind record) 'element))
+270
(web-client-listeners-clear-node! (web-client-record-node record))
+271
(for-each web-client-unregister-record-tree!
+272
(web-client-record-children record))))
+273
+274
(define (web-client-element-nodes records)
+275
(let loop ((rest records) (acc '()))
+276
(cond
+277
((null? rest) acc)
+278
((and (car rest) (pair? (car rest))
+279
(eq? (web-client-record-kind (car rest)) 'element))
+280
(loop (cdr rest) (cons (web-client-record-node (car rest)) acc)))
+281
(else (loop (cdr rest) acc)))))
+282
+283
;; Old top-level records not carried into the new set are being removed:
+284
;; unregister their listener subtrees. Additive cleanup only -- it does not
+285
;; change which nodes the diff keeps.
+286
(define (web-client-unregister-dropped! old-records new-records)
+287
(let ((kept (web-client-element-nodes new-records)))
+288
(for-each
+289
(lambda (old)
+290
(when (and old (pair? old)
+291
(eq? (web-client-record-kind old) 'element)
+292
(not (memv (web-client-record-node old) kept)))
+293
(web-client-unregister-record-tree! old)))
+294
old-records)))
+295
296
(define (web-client-apply-attrs node old-attrs new-attrs)
297
(for-each
298
(lambda (attr)
@@ -178,6 +317,24 @@
317
(wasm-dom-remove-attribute node name))
318
(else
319
(wasm-dom-set-attribute node name (web-client-value->string value))))))))
+320
new-attrs)
+321
;; on-*: listeners present in the old attrs but gone (or no longer a
+322
;; procedure) in the new attrs: detach them.
+323
(for-each
+324
(lambda (attr)
+325
(let ((type (web-client-event-attr-type attr)))
+326
(when type
+327
(let ((new-attr (web-client-find-attr new-attrs (car attr))))
+328
(when (not (and new-attr (web-client-event-attr-type new-attr)))
+329
(web-client-listener-remove! node type))))))
+330
old-attrs)
+331
;; on-*: listeners in the new attrs: register the node + type once and keep
+332
;; the closure current.
+333
(for-each
+334
(lambda (attr)
+335
(let ((type (web-client-event-attr-type attr)))
+336
(when type
+337
(web-client-listener-set! node type (web-client-attribute-value attr)))))
338
new-attrs))
339
340
(define (web-client-text-value value)
@@ -261,7 +418,11 @@
418
(web-client-apply-attrs node old-attrs new-attrs)
419
(list 'element node tag new-attrs children)))
420
(else (web-client-create-node value)))
−264
(web-client-create-node value)))
+421
(begin
+422
;; Incompatible: the old node (and its subtree) is being replaced --
+423
;; drop its listeners before the new node supplants it.
+424
(web-client-unregister-record-tree! old-record)
+425
(web-client-create-node value))))
426
427
(define (web-client-patch-children parent old-records new-values)
428
(let loop ((rest (web-client-normalize-children new-values))
@@ -269,6 +430,7 @@
430
(records '()))
431
(if (null? rest)
432
(let ((ordered (reverse records)))
+433
(web-client-unregister-dropped! old-records ordered)
434
(wasm-dom-replace-children parent)
435
(for-each
436
(lambda (record)