Added very basic Tk (Tcl) support using. (0.36.0)
This commit is contained in:
parent
682bce05af
commit
6da1861e12
17 changed files with 513 additions and 3 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 - <you@hanez.org>
|
||||
|
||||
|
|
|
|||
|
|
@ -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 <ui/tk.fun>
|
||||
|
||||
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:
|
||||
|
|
|
|||
29
examples/tk_hello.fun
Normal file
29
examples/tk_hello.fun
Normal file
|
|
@ -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 <you@hanez.org>
|
||||
* 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 <ui/tk.fun>
|
||||
|
||||
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()
|
||||
36
lib/ui/tk.fun
Normal file
36
lib/ui/tk.fun
Normal file
|
|
@ -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 <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 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()
|
||||
|
|
@ -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 "???";
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
44
src/parser.c
44
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; }
|
||||
|
|
|
|||
77
src/tk_embed.c
Normal file
77
src/tk_embed.c
Normal file
|
|
@ -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
|
||||
20
src/vm.c
20
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"
|
||||
|
|
|
|||
34
src/vm/tk/button.c
Normal file
34
src/vm/tk/button.c
Normal file
|
|
@ -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;
|
||||
}
|
||||
21
src/vm/tk/eval.c
Normal file
21
src/vm/tk/eval.c
Normal file
|
|
@ -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;
|
||||
}
|
||||
31
src/vm/tk/label.c
Normal file
31
src/vm/tk/label.c
Normal file
|
|
@ -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;
|
||||
}
|
||||
23
src/vm/tk/loop.c
Normal file
23
src/vm/tk/loop.c
Normal file
|
|
@ -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 */
|
||||
}
|
||||
16
src/vm/tk/pack.c
Normal file
16
src/vm/tk/pack.c
Normal file
|
|
@ -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;
|
||||
}
|
||||
17
src/vm/tk/result.c
Normal file
17
src/vm/tk/result.c
Normal file
|
|
@ -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;
|
||||
}
|
||||
33
src/vm/tk/wm_title.c
Normal file
33
src/vm/tk/wm_title.c
Normal file
|
|
@ -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;
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue