diff --git a/CMakeLists.txt b/CMakeLists.txt index 927127c..3240d35 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,5 +1,5 @@ cmake_minimum_required(VERSION 3.10) -project(fun VERSION 0.35.2 LANGUAGES C) +project(fun VERSION 0.36.0 LANGUAGES C) set(CMAKE_C_STANDARD 99) set(CMAKE_C_STANDARD_REQUIRED ON) @@ -24,6 +24,65 @@ if(NOT DEFINED DEFAULT_LIB_DIR OR DEFAULT_LIB_DIR STREQUAL "") else() set(DEFAULT_LIB_DIR "${DEFAULT_LIB_DIR}" CACHE PATH "Default library directory for Fun stdlib (override with -DDEFAULT_LIB_DIR=...)" FORCE) endif() + +# Optional Tcl/Tk GUI support (embedded interpreter) +option(FUN_WITH_TCLTK "Enable Tcl/Tk GUI support" OFF) +set(TCL_INCLUDE_DIRS "") +set(TCL_LINK_LIBS "") +if(FUN_WITH_TCLTK) + message(STATUS "Building with Tcl/Tk support") + add_definitions(-DFUN_WITH_TCLTK) + # Try pkg-config first + find_package(PkgConfig QUIET) + if(PKG_CONFIG_FOUND) + pkg_check_modules(TCL QUIET tcl) + pkg_check_modules(TK QUIET tk) + endif() + if(TCL_FOUND OR TK_FOUND) + if(TCL_FOUND) + list(APPEND TCL_INCLUDE_DIRS ${TCL_INCLUDE_DIRS} ${TCL_INCLUDE_DIRS}) + list(APPEND TCL_LINK_LIBS ${TCL_LINK_LIBS} ${TCL_LIBRARIES}) + endif() + if(TK_FOUND) + list(APPEND TCL_INCLUDE_DIRS ${TCL_INCLUDE_DIRS} ${TK_INCLUDE_DIRS}) + list(APPEND TCL_LINK_LIBS ${TCL_LINK_LIBS} ${TK_LIBRARIES}) + endif() + if(TCL_INCLUDE_DIRS) + include_directories(${TCL_INCLUDE_DIRS}) + endif() + else() + # Fallbacks by platform (best-effort) + find_path(TCL_INCLUDE_DIR tcl.h PATH_SUFFIXES tcl8.7 tcl8.6 include) + find_library(TCL_LIB NAMES tcl8.7 tcl8.6 tcl) + find_library(TK_LIB NAMES tk8.7 tk8.6 tk) + if(TCL_INCLUDE_DIR) + list(APPEND TCL_INCLUDE_DIRS ${TCL_INCLUDE_DIR}) + include_directories(${TCL_INCLUDE_DIR}) + endif() + if(TCL_LIB) + list(APPEND TCL_LINK_LIBS ${TCL_LIB}) + endif() + if(TK_LIB) + list(APPEND TCL_LINK_LIBS ${TK_LIB}) + endif() + if(APPLE) + # On macOS additional frameworks are usually not required; Homebrew libs suffice + elseif(WIN32) + # Typical Windows GUI libs + list(APPEND TCL_LINK_LIBS user32 gdi32 comctl32) + else() + # X11 may be required on some Linux setups + find_package(X11 QUIET) + if(X11_FOUND) + include_directories(${X11_INCLUDE_DIR}) + list(APPEND TCL_LINK_LIBS ${X11_LIBRARIES}) + endif() + endif() + if(NOT TCL_LINK_LIBS) + message(WARNING "Tcl/Tk libraries not found via pkg-config or fallbacks. FUN_WITH_TCLTK is enabled, but linking may fail.") + endif() + endif() +endif() # Ensure trailing slash if(NOT DEFAULT_LIB_DIR MATCHES "/$") set(DEFAULT_LIB_DIR "${DEFAULT_LIB_DIR}/") @@ -328,6 +387,14 @@ if(FUN_WITH_XML2) endif() endif() +# Tcl/Tk include and link (if enabled) +if(TCL_INCLUDE_DIRS) + target_include_directories(fun_core PRIVATE ${TCL_INCLUDE_DIRS}) +endif() +if(TCL_LINK_LIBS) + target_link_libraries(fun_core PUBLIC ${TCL_LINK_LIBS}) +endif() + # Link threads if available on UNIX if(Threads_FOUND) target_link_libraries(fun_core PUBLIC Threads::Threads) diff --git a/README.md b/README.md index 3561092..8e2a0d6 100644 --- a/README.md +++ b/README.md @@ -89,7 +89,7 @@ Fun may not change the world — but it will make programming a little more fun. - [PCRE2](https://pcre2project.github.io/pcre2/) support builtin for Perl-Compatible Regular Expressions (optional) ☑ - [PCSC](https://pcscworkgroup.com/) smart card support builtin using [PCSC lite](https://pcsclite.apdu.fr/) (optional) ☑ - [SQLite](https://sqlite.org/) support builtin (optional) ☑ -- [Tk](https://www.tcl-lang.org/) support builtin for GUI application development (optional) ☐ +- [Tk](https://www.tcl-lang.org/) support builtin for GUI application development (optional) ☑ - [XML](https://www.w3.org/XML/) support builtin using [libxml2](https://gitlab.gnome.org/GNOME/libxml2/-/wikis/home) (optional) ☑ ☑ = Done / ☐ = Planned or in progress. @@ -115,4 +115,3 @@ Complete API documentation will follow. ## Author Johannes Findeisen - - diff --git a/docs/handbook.md b/docs/handbook.md index aea4449..f78f4d8 100644 --- a/docs/handbook.md +++ b/docs/handbook.md @@ -99,6 +99,7 @@ Pass all options as -DNAME=VALUE. The most relevant toggles are: - FUN_WITH_PCSC=ON|OFF — enable PC/SC smart card (PCSC lite) support (default OFF) - FUN_WITH_REPL=ON|OFF — enable the interactive REPL (default OFF) - FUN_WITH_SQLITE=ON|OFF — enable SQLite (sqlite3) support (default OFF) +- FUN_WITH_TCLTK=ON|OFF — enable Tk (GUI via Tcl/Tk) support (default OFF) You can also set the default search path for the bundled stdlib with DEFAULT_LIB_DIR: @@ -193,6 +194,52 @@ Notes: - Handles are simple integers managed by the VM; nodes are owned by their document. - This initial integration focuses on parsing and basic navigation. Attributes, children iteration, and XPath may be added later. +#### Tk GUI example (optional feature) + +Tk GUI support is optional and disabled by default. It embeds a Tcl/Tk interpreter and exposes a small, Tk-only API to Fun code (no raw Tcl required). + +To build with Tk and run the example: + +``` +cmake -S . -B build -DFUN_WITH_TCLTK=ON +cmake --build build --target fun + +# Run the example +FUN_LIB_DIR="$(pwd)/lib" ./build/fun ./examples/tk_hello.fun +``` + +Available VM builtins when built with -DFUN_WITH_TCLTK=ON: +- tk_title(title: string) -> rc +- tk_label(id: string, text: string) -> rc +- tk_button(id: string, text: string) -> rc +- tk_pack(id: string) -> rc +- tk_loop() -> Nil (enters event loop until the window is closed) + +Standard library wrapper (lib/ui/tk.fun): +- class TK + - title(title: string): int + - label(id: string, text: string): int + - button(id: string, text: string): int + - pack(id: string): int + - loop(): Nil + +Example Fun code: +``` +include + +tk = TK() +tk.title("Fun + Tk GUI") +tk.label("hello", "Hello, world!") +tk.pack("hello") +tk.button("ok", "OK") +tk.pack("ok") +tk.loop() +``` + +Notes: +- Ensure Tcl/Tk is installed (8.6+). On Linux install tcl/tk packages; on macOS install Homebrew tcl-tk; on Windows ensure the DLLs are available. +- The Fun process terminates when the main window is closed or when the example's OK button is clicked. + ### Install Fun to the OS (optional) Not recommended during early development, but supported: diff --git a/examples/tk_hello.fun b/examples/tk_hello.fun new file mode 100644 index 0000000..6110b77 --- /dev/null +++ b/examples/tk_hello.fun @@ -0,0 +1,29 @@ +#!/usr/bin/env fun + +/* + * This file is part of the Fun programming language. + * https://fun-lang.xyz/ + * + * Copyright 2025 Johannes Findeisen + * Licensed under the terms of the Apache-2.0 license. + * https://opensource.org/license/apache-2-0 + * + * Added: 2025-12-09 + */ + +// Demonstrates the Tk stdlib wrapper class using the new Tk opcodes. + +include + +tk = TK() + +tk.title("Fun + Tk GUI") + +tk.label("hello", "Hello, world!") +tk.pack("hello") + +tk.button("ok", "OK") +tk.pack("ok") + +// Enter GUI loop (no-op if built without FUN_WITH_TCLTK) +tk.loop() diff --git a/lib/ui/tk.fun b/lib/ui/tk.fun new file mode 100644 index 0000000..e39368d --- /dev/null +++ b/lib/ui/tk.fun @@ -0,0 +1,36 @@ +#!/usr/bin/env fun + +/* + * This file is part of the Fun programming language. + * https://fun-lang.xyz/ + * + * Copyright 2025 Johannes Findeisen + * Licensed under the terms of the Apache-2.0 license. + * https://opensource.org/license/apache-2-0 + * + * Added: 2025-12-09 + */ + +// Tk stdlib helper wrapping the Tk VM builtins. +// No raw Tcl is exposed; this class provides a tiny, safe GUI surface. + +class TK() + // Set the window title + fun title(this, title) + return tk_title(to_string(title)) + + // Create or update a label widget with id and text + fun label(this, id, text) + return tk_label(to_string(id), to_string(text)) + + // Create or update a button widget with id and text + fun button(this, id, text) + return tk_button(to_string(id), to_string(text)) + + // Pack a widget by id + fun pack(this, id) + return tk_pack(to_string(id)) + + // Enter the Tk event loop (blocks until windows are closed) + fun loop(this) + return tk_loop() diff --git a/src/bytecode.c b/src/bytecode.c index 738f596..2dd3517 100644 --- a/src/bytecode.c +++ b/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 "???"; } } diff --git a/src/bytecode.h b/src/bytecode.h index 73b9206..0576cfb 100644 --- a/src/bytecode.h +++ b/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 diff --git a/src/parser.c b/src/parser.c index 7fa6fdd..00074a1 100644 --- a/src/parser.c +++ b/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; } diff --git a/src/tk_embed.c b/src/tk_embed.c new file mode 100644 index 0000000..d1e6e1f --- /dev/null +++ b/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 + * 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 +#include +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 + Sleep(1); +#else + #include + 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 diff --git a/src/vm.c b/src/vm.c index 8657b98..9beaabe 100644 --- a/src/vm.c +++ b/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 + /* 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" diff --git a/src/vm/tk/button.c b/src/vm/tk/button.c new file mode 100644 index 0000000..8b62792 --- /dev/null +++ b/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; +} diff --git a/src/vm/tk/eval.c b/src/vm/tk/eval.c new file mode 100644 index 0000000..c2fd543 --- /dev/null +++ b/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 + * 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; +} diff --git a/src/vm/tk/label.c b/src/vm/tk/label.c new file mode 100644 index 0000000..cb4dcfd --- /dev/null +++ b/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; +} diff --git a/src/vm/tk/loop.c b/src/vm/tk/loop.c new file mode 100644 index 0000000..a327b40 --- /dev/null +++ b/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 + * 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 */ +} diff --git a/src/vm/tk/pack.c b/src/vm/tk/pack.c new file mode 100644 index 0000000..71e4345 --- /dev/null +++ b/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; +} diff --git a/src/vm/tk/result.c b/src/vm/tk/result.c new file mode 100644 index 0000000..36f9a54 --- /dev/null +++ b/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 + * 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; +} diff --git a/src/vm/tk/wm_title.c b/src/vm/tk/wm_title.c new file mode 100644 index 0000000..5346b6e --- /dev/null +++ b/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 + * 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; +}