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)