From 40ce4df6b124f6f3d4be0f46c1269f8525a21b58 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 15:37:26 +0000 Subject: [PATCH] =?UTF-8?q?tcl:=20apply=20command=20=E2=80=94=20anonymous?= =?UTF-8?q?=20proc=20call=20reusing=20tcl-call-proc=20frame=20machinery?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/tcl/runtime.sx | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/lib/tcl/runtime.sx b/lib/tcl/runtime.sx index 158e6b4b..f8965052 100644 --- a/lib/tcl/runtime.sx +++ b/lib/tcl/runtime.sx @@ -2903,6 +2903,28 @@ (define tcl-cmd-tell (fn (interp args) (assoc interp :result "0"))) (define tcl-cmd-flush (fn (interp args) (assoc interp :result ""))) +(define + tcl-cmd-apply + (fn + (interp args) + (if + (< (len args) 1) + (error "apply: wrong # args: should be "apply lambdaList ?arg ...?"") + (let + ((func-list (tcl-list-split (first args))) + (call-args (rest args))) + (if + (< (len func-list) 2) + (error "apply: lambdaList must be a 2 or 3 element list") + (let + ((param-spec (first func-list)) + (body (nth func-list 1)) + (ns (if (> (len func-list) 2) (nth func-list 2) nil))) + (let + ((proc-def {:args param-spec :body body :ns ns})) + (tcl-call-proc interp "#apply" proc-def call-args)))))))) + + (define tcl-cmd-regexp (fn @@ -3172,4 +3194,4 @@ ((i (tcl-register i "flush" tcl-cmd-flush))) (let ((i (tcl-register i "file" tcl-cmd-file))) (let ((i (tcl-register i "regexp" tcl-cmd-regexp))) - (tcl-register i "regsub" tcl-cmd-regsub)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + (let ((i (tcl-register i "regsub" tcl-cmd-regsub))) (tcl-register i "apply" tcl-cmd-apply)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))