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

Some more Tk fun. (0.37.18)

Browse source
This commit is contained in:
Johannes Findeisen 2025-12-23 23:19:20 +01:00
commit 689a716499
13 changed files with 282 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

2
CMakeLists.txt
View file

@ -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)

0
examples/test_dec_to_hex.fun Normal file → Executable file
View file

1
examples/test_include.fun Normal file → Executable file
View file

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

59
examples/tk_file_manager.fun Executable file
View file

@ -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... ;)
*/

1
examples/tk_hello.fun
View file

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

38
examples/tk_testing.fun Executable file
View file

@ -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
*/

24
lib/ui/tk.fun
View file

@ -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()

26
src/bytecode.h
View file

@ -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

35
src/parser.c
View file

@ -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; }

2
src/vm.c
View file

@ -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)) {

3
src/vm.h
View file

@ -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"
};

49
src/vm/os/list_dir.c Normal file
View file

@ -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;
}

54
src/vm/tk/bind.c Normal file
View file

@ -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;
}