hanez/fun
1
0
Fork 0
forked from fun/fun
Code Pull requests Activity

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

Browse source
This commit is contained in:
Johannes Findeisen 2025-12-09 23:13:12 +01:00
commit 6da1861e12
17 changed files with 513 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/vm/tk/button.c Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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;
}