Added very basic Tk (Tcl) support using. (0.36.0)

src/bytecode.c

@@ -178,6 +178,13 @@ static const char *opcode_name(OpCode op) {
         case OP_XML_ROOT: return "XML_ROOT";
         case OP_XML_NAME: return "XML_NAME";
         case OP_XML_TEXT: return "XML_TEXT";
+        case OP_TK_EVAL: return "TK_EVAL";
+        case OP_TK_RESULT: return "TK_RESULT";
+        case OP_TK_LOOP: return "TK_LOOP";
+        case OP_TK_WM_TITLE: return "TK_WM_TITLE";
+        case OP_TK_LABEL: return "TK_LABEL";
+        case OP_TK_BUTTON: return "TK_BUTTON";
+        case OP_TK_PACK: return "TK_PACK";
         default: return "???";
     }
 }

src/bytecode.h

@@ -194,6 +194,15 @@ typedef enum {
     OP_XML_NAME,          // pops node handle; pushes string (node name)
     OP_XML_TEXT,          // pops node handle; pushes string (node text)
 
+    // Tk (Tcl/Tk) optional minimal API
+    OP_TK_EVAL,           // pops script string; pushes int rc (0 = OK)
+    OP_TK_RESULT,         // pushes string: last Tcl result
+    OP_TK_LOOP,           // enters Tk event loop; pushes Nil when done
+    OP_TK_WM_TITLE,       // pops title string; sets window title; pushes rc
+    OP_TK_LABEL,          // pops text, id; creates/updates label .id; pushes rc
+    OP_TK_BUTTON,         // pops text, id; creates/updates button .id; pushes rc
+    OP_TK_PACK,           // pops id; packs .id; pushes rc
+
     // Sockets (UNIX platforms)
     OP_SOCK_TCP_LISTEN,    // pops backlog, port; returns listen fd (>0) or 0
     OP_SOCK_TCP_ACCEPT,    // pops listen fd; returns client fd (>0) or 0

src/parser.c

@@ -791,6 +791,50 @@ static int emit_primary(Bytecode *bc, const char *src, size_t len, size_t *pos)
                 free(name);
                 return 1;
             }
+            /* Tk (GUI) builtins (no raw Tcl exposed) */
+            if (strcmp(name, "tk_loop") == 0) {
+                (*pos)++; /* '(' */
+                if (!consume_char(src, len, pos, ')')) { parser_fail(*pos, "tk_loop expects ()"); free(name); return 0; }
+                bytecode_add_instruction(bc, OP_TK_LOOP, 0);
+                free(name);
+                return 1;
+            }
+            if (strcmp(name, "tk_title") == 0) {
+                (*pos)++; /* '(' */
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "tk_title expects (title:string)"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ')')) { parser_fail(*pos, "Expected ')' after tk_title arg"); free(name); return 0; }
+                bytecode_add_instruction(bc, OP_TK_WM_TITLE, 0);
+                free(name);
+                return 1;
+            }
+            if (strcmp(name, "tk_label") == 0) {
+                (*pos)++; /* '(' */
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "tk_label expects (id:string, text:string)"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ',')) { parser_fail(*pos, "tk_label expects 2 args"); free(name); return 0; }
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "tk_label expects (id:string, text:string)"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ')')) { parser_fail(*pos, "Expected ')' after tk_label args"); free(name); return 0; }
+                bytecode_add_instruction(bc, OP_TK_LABEL, 0);
+                free(name);
+                return 1;
+            }
+            if (strcmp(name, "tk_button") == 0) {
+                (*pos)++; /* '(' */
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "tk_button expects (id:string, text:string)"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ',')) { parser_fail(*pos, "tk_button expects 2 args"); free(name); return 0; }
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "tk_button expects (id:string, text:string)"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ')')) { parser_fail(*pos, "Expected ')' after tk_button args"); free(name); return 0; }
+                bytecode_add_instruction(bc, OP_TK_BUTTON, 0);
+                free(name);
+                return 1;
+            }
+            if (strcmp(name, "tk_pack") == 0) {
+                (*pos)++; /* '(' */
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "tk_pack expects (id:string)"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ')')) { parser_fail(*pos, "Expected ')' after tk_pack arg"); free(name); return 0; }
+                bytecode_add_instruction(bc, OP_TK_PACK, 0);
+                free(name);
+                return 1;
+            }
             if (strcmp(name, "json_from_file") == 0) {
                 (*pos)++; /* '(' */
                 if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "json_from_file expects (path)"); free(name); return 0; }

src/tk_embed.c

@@ -0,0 +1,77 @@
+/*
+ * This file is part of the Fun programming language.
+ * https://fun-lang.xyz/
+ *
+ * Copyright 2025 Johannes Findeisen <you@hanez.org>
+ * Licensed under the terms of the Apache-2.0 license.
+ * https://opensource.org/license/apache-2-0
+ *
+ * Added: 2025-12-09
+ */
+
+/**
+ * Embedded Tcl/Tk helpers for Fun VM.
+ * When FUN_WITH_TCLTK is OFF, stubs are provided so code compiles and runs.
+ */
+
+#include "value.h"
+#include "vm.h"
+
+#ifdef FUN_WITH_TCLTK
+#include <tcl.h>
+#include <tk.h>
+static Tcl_Interp* g_fun_tcl_interp = NULL;
+
+static void fun_tk_init_once(void) {
+    if (g_fun_tcl_interp) return;
+    Tcl_FindExecutable(NULL);
+    g_fun_tcl_interp = Tcl_CreateInterp();
+    if (!g_fun_tcl_interp) return;
+    if (Tcl_Init(g_fun_tcl_interp) != TCL_OK) {
+        fprintf(stderr, "Tcl_Init failed: %s\n", Tcl_GetStringResult(g_fun_tcl_interp));
+    }
+    if (Tk_Init(g_fun_tcl_interp) != TCL_OK) {
+        fprintf(stderr, "Tk_Init failed: %s\n", Tcl_GetStringResult(g_fun_tcl_interp));
+    }
+    /* Ensure the app terminates if the main window is closed via window manager */
+    /* Best-effort: set WM_DELETE_WINDOW handler to exit the process. */
+    Tcl_Eval(g_fun_tcl_interp, "wm protocol . WM_DELETE_WINDOW {exit 0}");
+}
+
+static int fun_tk_eval_script(const char *script) {
+    fun_tk_init_once();
+    if (!g_fun_tcl_interp) return -1;
+    int rc = Tcl_Eval(g_fun_tcl_interp, script ? script : "");
+    return rc; /* TCL_OK = 0 */
+}
+
+static const char* fun_tk_get_result(void) {
+    fun_tk_init_once();
+    if (!g_fun_tcl_interp) return "";
+    return Tcl_GetStringResult(g_fun_tcl_interp);
+}
+
+static void fun_tk_loop(void) {
+    fun_tk_init_once();
+    if (!g_fun_tcl_interp) return;
+    /* Drive Tk event loop until all main windows are closed */
+    while (Tk_GetNumMainWindows() > 0) {
+        while (Tcl_DoOneEvent(0)) {}
+        /* tiny sleep to avoid busy spin */
+#ifdef _WIN32
+        #include <windows.h>
+        Sleep(1);
+#else
+        #include <time.h>
+        struct timespec ts = {0, 1000000}; /* 1 ms */
+        nanosleep(&ts, NULL);
+#endif
+    }
+}
+#else
+/* Stubs when Tcl/Tk is disabled */
+static void fun_tk_init_once(void) { (void)0; }
+static int fun_tk_eval_script(const char *script) { (void)script; return -1; }
+static const char* fun_tk_get_result(void) { return ""; }
+static void fun_tk_loop(void) { (void)0; }
+#endif

src/vm.c

@@ -7,12 +7,23 @@
  * https://opensource.org/license/apache-2-0
  */
 
+/* Ensure POSIX prototypes (nanosleep, clock_gettime, localtime_r, etc.) are available
+ * before any system headers are included by amalgamated .c files. */
+#ifndef _WIN32
+#ifndef _POSIX_C_SOURCE
+#define _POSIX_C_SOURCE 200809L
+#endif
+#endif
+#include <time.h>
+
 /* Bring in split-out built-ins without changing the build system yet */
 #include "iter.c"
 #include "map.c"
 #include "string.c"
 #include "pcsc.c"
 #include "jsonc.c"
+/* Embedded Tcl/Tk helpers (provide stubs when FUN_WITH_TCLTK is off) */
+#include "tk_embed.c"
 #ifdef FUN_WITH_XML2
 #include "vm/xml/handles.h"
 #endif
@@ -747,6 +758,15 @@ void vm_run(VM *vm, Bytecode *entry) {
             #include "vm/curl/post.c"
             #include "vm/curl/download.c"
 
+            /* Tk (Tcl/Tk) ops */
+            #include "vm/tk/eval.c"
+            #include "vm/tk/result.c"
+            #include "vm/tk/loop.c"
+            #include "vm/tk/wm_title.c"
+            #include "vm/tk/label.c"
+            #include "vm/tk/button.c"
+            #include "vm/tk/pack.c"
+
             /* SQLite ops */
             #include "vm/sqlite/open.c"
             #include "vm/sqlite/close.c"

src/vm/tk/button.c

@@ -0,0 +1,34 @@
+/* TK_BUTTON */
+case OP_TK_BUTTON: {
+    /* stack: ..., id, text -> rc */
+    Value textv = pop_value(vm);
+    Value idv = pop_value(vm);
+    char *text = value_to_string_alloc(&textv);
+    char *id = value_to_string_alloc(&idv);
+    free_value(textv);
+    free_value(idv);
+    if (!id) { if (text) free(text); push_value(vm, make_int(-1)); break; }
+    if (!text) { text = strdup(""); }
+    size_t n = 0; for (const char *p = text; *p; ++p) { n += (*p == '\\' || *p == '"') ? 2 : 1; }
+    char *et = (char*)malloc(n + 1);
+    if (!et) { free(id); free(text); push_value(vm, make_int(-1)); break; }
+    char *q = et; for (const char *p = text; *p; ++p) { if (*p == '\\' || *p == '"') *q++ = '\\'; *q++ = *p; } *q = '\0';
+    free(text);
+    size_t slen = strlen(id) + strlen(et) + 196;
+    char *script = (char*)malloc(slen);
+    if (!script) { free(id); free(et); push_value(vm, make_int(-1)); break; }
+    /*
+     * Default behavior: clicking the button should terminate the app. We set
+     * -command {catch {destroy .}; exit 0} to both destroy the window and exit
+     * the process. Using 'catch' makes it safe if the window is already gone.
+     */
+    snprintf(script, slen,
+             "if {[winfo exists .%s]} { .%s configure -text \"%s\" -command {catch {destroy .}; exit 0} } else { button .%s -text \"%s\" -command {catch {destroy .}; exit 0} }",
+             id, id, et, id, et);
+    int rc = fun_tk_eval_script(script);
+    free(script);
+    free(id);
+    free(et);
+    push_value(vm, make_int(rc));
+    break;
+}

src/vm/tk/eval.c

@@ -0,0 +1,21 @@
+/*
+* This file is part of the Fun programming language.
+ * https://fun-lang.xyz/
+ *
+ * Copyright 2025 Johannes Findeisen <you@hanez.org>
+ * Licensed under the terms of the Apache-2.0 license.
+ * https://opensource.org/license/apache-2-0
+ *
+ * Added: 2025-12-09
+ */
+ 
+ /* TK_EVAL */
+case OP_TK_EVAL: {
+    Value text = pop_value(vm);
+    char *s = value_to_string_alloc(&text);
+    free_value(text);
+    int rc = fun_tk_eval_script(s ? s : "");
+    if (s) free(s);
+    push_value(vm, make_int(rc));
+    break;
+}

src/vm/tk/label.c

@@ -0,0 +1,31 @@
+/* TK_LABEL */
+case OP_TK_LABEL: {
+    /* stack: ..., id, text -> rc */
+    Value textv = pop_value(vm);
+    Value idv = pop_value(vm);
+    char *text = value_to_string_alloc(&textv);
+    char *id = value_to_string_alloc(&idv);
+    free_value(textv);
+    free_value(idv);
+    if (!id) { if (text) free(text); push_value(vm, make_int(-1)); break; }
+    if (!text) { text = strdup(""); }
+    /* escape id minimally (dots and word chars are fine) -> just use as-is */
+    /* escape text for Tcl double quotes */
+    size_t n = 0; for (const char *p = text; *p; ++p) { n += (*p == '\\' || *p == '"') ? 2 : 1; }
+    char *et = (char*)malloc(n + 1);
+    if (!et) { free(id); free(text); push_value(vm, make_int(-1)); break; }
+    char *q = et; for (const char *p = text; *p; ++p) { if (*p == '\\' || *p == '"') *q++ = '\\'; *q++ = *p; } *q = '\0';
+    free(text);
+    size_t slen = strlen(id) + strlen(et) + 128;
+    char *script = (char*)malloc(slen);
+    if (!script) { free(id); free(et); push_value(vm, make_int(-1)); break; }
+    snprintf(script, slen,
+             "if {[winfo exists .%s]} { .%s configure -text \"%s\" } else { label .%s -text \"%s\" }",
+             id, id, et, id, et);
+    int rc = fun_tk_eval_script(script);
+    free(script);
+    free(id);
+    free(et);
+    push_value(vm, make_int(rc));
+    break;
+}

src/vm/tk/loop.c

@@ -0,0 +1,23 @@
+/*
+ * This file is part of the Fun programming language.
+ * https://fun-lang.xyz/
+ *
+ * Copyright 2025 Johannes Findeisen <you@hanez.org>
+ * Licensed under the terms of the Apache-2.0 license.
+ * https://opensource.org/license/apache-2-0
+ *
+ * Added: 2025-12-09
+ */
+
+/* TK_LOOP */
+case OP_TK_LOOP: {
+    fun_tk_loop();
+#ifdef FUN_WITH_TCLTK
+    /* Ensure the process terminates once the GUI window(s) are closed. */
+    exit(0);
+#else
+    /* When Tk support is not compiled in, behave as a no-op returning Nil. */
+    push_value(vm, make_nil());
+#endif
+    break; /* not reached when FUN_WITH_TCLTK */
+}

src/vm/tk/pack.c

@@ -0,0 +1,16 @@
+/* TK_PACK */
+case OP_TK_PACK: {
+    Value idv = pop_value(vm);
+    char *id = value_to_string_alloc(&idv);
+    free_value(idv);
+    if (!id) { push_value(vm, make_int(-1)); break; }
+    size_t slen = strlen(id) + 16;
+    char *script = (char*)malloc(slen);
+    if (!script) { free(id); push_value(vm, make_int(-1)); break; }
+    snprintf(script, slen, "pack .%s", id);
+    int rc = fun_tk_eval_script(script);
+    free(script);
+    free(id);
+    push_value(vm, make_int(rc));
+    break;
+}

src/vm/tk/result.c

@@ -0,0 +1,17 @@
+/*
+ * This file is part of the Fun programming language.
+ * https://fun-lang.xyz/
+ *
+ * Copyright 2025 Johannes Findeisen <you@hanez.org>
+ * Licensed under the terms of the Apache-2.0 license.
+ * https://opensource.org/license/apache-2-0
+ *
+ * Added: 2025-12-09
+ */
+
+/* TK_RESULT */
+case OP_TK_RESULT: {
+    const char *r = fun_tk_get_result();
+    push_value(vm, make_string(r ? r : ""));
+    break;
+}

src/vm/tk/wm_title.c

@@ -0,0 +1,33 @@
+/*
+ * This file is part of the Fun programming language.
+ * https://fun-lang.xyz/
+ *
+ * Copyright 2025 Johannes Findeisen <you@hanez.org>
+ * Licensed under the terms of the Apache-2.0 license.
+ * https://opensource.org/license/apache-2-0
+ *
+ * Added: 2025-12-09
+ */
+
+/* TK_WM_TITLE */
+case OP_TK_WM_TITLE: {
+    Value titlev = pop_value(vm);
+    char *title = value_to_string_alloc(&titlev);
+    free_value(titlev);
+    if (!title) { push_value(vm, make_int(-1)); break; }
+    /* Escape backslashes and double quotes for Tcl double-quoted strings */
+    size_t n = 0; for (const char *p = title; *p; ++p) { n += (*p == '\\' || *p == '"') ? 2 : 1; }
+    char *esc = (char*)malloc(n + 1);
+    if (!esc) { free(title); push_value(vm, make_int(-1)); break; }
+    char *q = esc; for (const char *p = title; *p; ++p) { if (*p == '\\' || *p == '"') *q++ = '\\'; *q++ = *p; } *q = '\0';
+    free(title);
+    size_t slen = strlen(esc) + 32;
+    char *script = (char*)malloc(slen);
+    if (!script) { free(esc); push_value(vm, make_int(-1)); break; }
+    snprintf(script, slen, "wm title . \"%s\"", esc);
+    int rc = fun_tk_eval_script(script);
+    free(script);
+    free(esc);
+    push_value(vm, make_int(rc));
+    break;
+}