Some more Tk fun. (0.37.18)

CMakeLists.txt

@@ -1,5 +1,5 @@
 cmake_minimum_required(VERSION 3.10)
-project(fun VERSION 0.37.17 LANGUAGES C)
+project(fun VERSION 0.37.18 LANGUAGES C)
 
 set(CMAKE_C_STANDARD 99)
 set(CMAKE_C_STANDARD_REQUIRED ON)

examples/test_include.fun

@@ -12,6 +12,7 @@
  */
 
 #include <hex.fun>
+
 print(dec_to_hex(255))
 
 /* Expected output:

examples/tk_file_manager.fun

@@ -0,0 +1,59 @@
+#!/usr/bin/env fun
+
+/*
+ * 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-23
+ */
+
+#include <ui/tk.fun>
+
+print("Initializing Fun File Manager...")
+tk = TK()
+tk.title("Fun File Manager")
+
+// Current directory
+dir = env("PWD")
+if (dir == "")
+  dir = "."
+print("Current directory: " + dir)
+
+tk.label("path", "Current Dir: " + dir)
+tk.pack("path")
+
+// Files listbox
+tk.listbox("files")
+tk.pack("files")
+
+// Populate listbox
+fun refresh(tk, dir)
+  print("Refreshing file list for: " + dir)
+  tk.clear("files")
+  files = os_list_dir(dir)
+  print("Found " + to_string(len(files)) + " entries.")
+  for f in files
+    tk.insert("files", "end", f)
+
+refresh(tk, dir)
+
+// Refresh button
+// Using tk.eval for button because tk.button currently exits the app.
+tk.eval("button .refresh -text {Refresh} -command {puts {Refresh requested}}")
+tk.pack("refresh")
+
+// Exit button
+tk.button("exit", "Exit")
+tk.pack("exit")
+
+print("Entering Tk loop...")
+tk.loop()
+print("Tk loop exited.")
+
+/* Expected output:
+A GUI... ;)
+*/

examples/tk_hello.fun

@@ -31,4 +31,3 @@ tk.loop()
 /* Expected output:
 A GUI... ;)
 */
-

examples/tk_testing.fun

@@ -0,0 +1,38 @@
+#!/usr/bin/env fun
+
+/*
+ * 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-23
+ */
+
+#include <ui/tk.fun>
+
+print("Testing os_list_dir...")
+files = os_list_dir(".")
+print("Found " + to_string(len(files)) + " files.")
+if len(files) > 0
+  print("First file: " + files[0])
+
+print("Testing tk_bind parsing...")
+// We can't easily test Tk without an X server, but we can see if it crashes.
+// If built with FUN_WITH_TCLTK, it should at least initialize.
+// We use tk_eval to avoid full loop.
+rc = tk_eval("set x 1")
+print("tk_eval rc: " + to_string(rc))
+if rc == 0
+  print("Tcl Result: " + tk_result())
+
+/* Expected output:
+Testing os_list_dir...
+Found 23 files.
+First file: build
+Testing tk_bind parsing...
+tk_eval rc: 0
+Tcl Result: 1
+*/

lib/ui/tk.fun

@@ -31,6 +31,30 @@ class TK()
   fun pack(this, id)
     return tk_pack(to_string(id))
 
+  // Create a listbox widget
+  fun listbox(this, id)
+    return tk_eval("listbox ." + to_string(id))
+
+  // Insert text into a widget (like listbox) at index
+  fun insert(this, id, index, text)
+    return tk_eval("." + to_string(id) + " insert " + to_string(index) + " {" + to_string(text) + "}")
+
+  // Clear a widget (like listbox)
+  fun clear(this, id)
+    return tk_eval("." + to_string(id) + " delete 0 end")
+
+  // Bind an event to a command
+  fun bind(this, id, event, cmd)
+    return tk_bind(to_string(id), to_string(event), to_string(cmd))
+
+  // Evaluate raw Tcl script
+  fun eval(this, script)
+    return tk_eval(to_string(script))
+
+  // Get last Tcl result
+  fun result(this)
+    return tk_result()
+
   // Enter the Tk event loop (blocks until windows are closed)
   fun loop(this)
     return tk_loop()

src/bytecode.h

@@ -35,7 +35,7 @@ typedef enum {
     OP_EQ,       // a == b -> push 1/0
     OP_NEQ,      // a != b -> push 1/0
 
-    OP_POP,            // dApache-2.0ard top of stack
+    OP_POP,            // discard top of stack
     OP_JUMP,           // unconditional jump
     OP_JUMP_IF_FALSE,  // jump if top of stack is false (0)
 
@@ -196,15 +196,6 @@ 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
@@ -218,6 +209,21 @@ typedef enum {
     // process control
     OP_EXIT,               // pops code (or uses operand) and terminates script with exit code
 
+    // OS additions
+    OP_OS_LIST_DIR,        // pops path string; pushes array of strings
+
+    // Tk additions
+    OP_TK_BIND,            // pops command, event, id; binds event to command
+
+    // 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
+
     // exceptions (minimal)
     OP_TRY_PUSH,           // operand = handler ip; push handler onto try-stack
     OP_TRY_POP,            // pop current handler

src/parser.c

@@ -757,6 +757,14 @@ static int emit_primary(Bytecode *bc, const char *src, size_t len, size_t *pos)
                 free(name);
                 return 1;
             }
+            if (strcmp(name, "os_list_dir") == 0) {
+                (*pos)++; /* '(' */
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "os_list_dir expects (path)"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ')')) { parser_fail(*pos, "Expected ')' after os_list_dir arg"); free(name); return 0; }
+                bytecode_add_instruction(bc, OP_OS_LIST_DIR, 0);
+                free(name);
+                return 1;
+            }
             /* JSON builtins */
             if (strcmp(name, "json_parse") == 0) {
                 (*pos)++; /* '(' */
@@ -853,6 +861,33 @@ static int emit_primary(Bytecode *bc, const char *src, size_t len, size_t *pos)
                 free(name);
                 return 1;
             }
+            if (strcmp(name, "tk_bind") == 0) {
+                (*pos)++; /* '(' */
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "tk_bind expects (id, event, cmd)"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ',')) { parser_fail(*pos, "tk_bind expects 3 args"); free(name); return 0; }
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "tk_bind expects 3 args"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ',')) { parser_fail(*pos, "tk_bind expects 3 args"); free(name); return 0; }
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "tk_bind expects 3 args"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ')')) { parser_fail(*pos, "Expected ')' after tk_bind args"); free(name); return 0; }
+                bytecode_add_instruction(bc, OP_TK_BIND, 0);
+                free(name);
+                return 1;
+            }
+            if (strcmp(name, "tk_eval") == 0) {
+                (*pos)++; /* '(' */
+                if (!emit_expression(bc, src, len, pos)) { parser_fail(*pos, "tk_eval expects (script)"); free(name); return 0; }
+                if (!consume_char(src, len, pos, ')')) { parser_fail(*pos, "Expected ')' after tk_eval arg"); free(name); return 0; }
+                bytecode_add_instruction(bc, OP_TK_EVAL, 0);
+                free(name);
+                return 1;
+            }
+            if (strcmp(name, "tk_result") == 0) {
+                (*pos)++; /* '(' */
+                if (!consume_char(src, len, pos, ')')) { parser_fail(*pos, "tk_result expects ()"); free(name); return 0; }
+                bytecode_add_instruction(bc, OP_TK_RESULT, 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/vm.c

@@ -741,6 +741,7 @@ void vm_run(VM *vm, Bytecode *entry) {
             #include "vm/tk/label.c"
             #include "vm/tk/button.c"
             #include "vm/tk/pack.c"
+            #include "vm/tk/bind.c"
             #endif
 
             /* SQLite ops */
@@ -783,6 +784,7 @@ void vm_run(VM *vm, Bytecode *entry) {
             #include "vm/typeof.c"
             #include "vm/uclamp.c"
             #include "vm/sclamp.c"
+            #include "vm/os/list_dir.c"
 
             default:
                 if (!opcode_is_valid(inst.op)) {

src/vm.h

@@ -49,6 +49,9 @@ static const char *opcode_names[] = {
     "XML_PARSE","XML_ROOT","XML_NAME","XML_TEXT",
     "SOCK_TCP_LISTEN","SOCK_TCP_ACCEPT","SOCK_TCP_CONNECT","SOCK_SEND","SOCK_RECV","SOCK_CLOSE","SOCK_UNIX_LISTEN","SOCK_UNIX_CONNECT",
     "EXIT",
+    "OS_LIST_DIR",
+    "TK_BIND",
+    "TK_EVAL","TK_RESULT","TK_LOOP","TK_WM_TITLE","TK_LABEL","TK_BUTTON","TK_PACK",
     "TRY_PUSH","TRY_POP","THROW"
 };
 

src/vm/os/list_dir.c

@@ -0,0 +1,49 @@
+/**
+ * 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-23
+ */
+
+case OP_OS_LIST_DIR: {
+    /* pops path string; pushes array of strings */
+    Value pathv = pop_value(vm);
+    char *path = value_to_string_alloc(&pathv);
+    free_value(pathv);
+
+    Value arr = make_array_from_values(NULL, 0);
+    if (path) {
+        /* 
+         * Using 'ls -1' as a fallback to avoid dirent.h conflicts on some systems.
+         * We escape the path minimally for the shell. 
+         */
+        size_t slen = strlen(path) + 16;
+        char *cmd = (char*)malloc(slen);
+        if (cmd) {
+            snprintf(cmd, slen, "ls -1 \"%s\"", path);
+            FILE *fp = popen(cmd, "r");
+            if (fp) {
+                char line[1024];
+                while (fgets(line, sizeof(line), fp)) {
+                    /* Strip trailing newline */
+                    size_t l = strlen(line);
+                    if (l > 0 && line[l-1] == '\n') line[l-1] = '\0';
+                    if (l > 1 && line[l-2] == '\r') line[l-2] = '\0';
+                    
+                    if (line[0] != '\0') {
+                        array_push(&arr, make_string(line));
+                    }
+                }
+                pclose(fp);
+            }
+            free(cmd);
+        }
+        free(path);
+    }
+    push_value(vm, arr);
+    break;
+}

src/vm/tk/bind.c

@@ -0,0 +1,54 @@
+/**
+ * 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-23
+ */
+
+/* TK_BIND */
+case OP_TK_BIND: {
+    /* stack: ..., id, event, command -> rc */
+    Value cmdv = pop_value(vm);
+    Value eventv = pop_value(vm);
+    Value idv = pop_value(vm);
+    char *cmd = value_to_string_alloc(&cmdv);
+    char *event = value_to_string_alloc(&eventv);
+    char *id = value_to_string_alloc(&idv);
+    free_value(cmdv);
+    free_value(eventv);
+    free_value(idv);
+
+    if (!id || !event || !cmd) {
+        if (id) free(id);
+        if (event) free(event);
+        if (cmd) free(cmd);
+        push_value(vm, make_int(-1));
+        break;
+    }
+
+    /* 
+     * Construct: bind .id <event> {command}
+     * Note: for now, command is just raw Tcl as well, 
+     * but could be extended to call Fun functions if we had a callback mechanism.
+     */
+    size_t slen = strlen(id) + strlen(event) + strlen(cmd) + 32;
+    char *script = (char*)malloc(slen);
+    if (!script) {
+        free(id); free(event); free(cmd);
+        push_value(vm, make_int(-1));
+        break;
+    }
+    
+    snprintf(script, slen, "bind .%s %s {%s}", id, event, cmd);
+    int rc = fun_tk_eval_script(script);
+    free(script);
+    free(id);
+    free(event);
+    free(cmd);
+    push_value(vm, make_int(rc));
+    break;
+}