Add build-critical source files, fix helm duplicate definitions
ober
9badc062323fdb25fa35cdf5e5bcd9d81da73ff4
new file mode 100644 --- /dev/null +++ b/jemacs-main.c @@ -0,0 +1,101 @@ +/* + * jemacs-main.c — Custom entry point for jemacs (jerboa-emacs TUI). + * + * Chez Scheme's default main() steals flags like -c (interprets as --compact). + * This custom main bypasses Chez's arg parsing: it saves all user args in + * positional env vars (JEMACS_ARGC, JEMACS_ARG0, ...), then calls the + * Chez runtime with no user args. + * + * Boot files (petite.boot, scheme.boot, jemacs.boot) are embedded as C byte + * arrays and registered via Sregister_boot_file_bytes — no external files needed. + * + * Threading workaround: Programs embedded in boot files (via make-boot-file) + * cannot create threads — fork-thread creates OS threads that block forever + * on an internal GC futex. To fix this, we load only libraries via the boot + * file and run the program separately via Sscheme_script, which preserves + * full threading support. + * + * The program .so is embedded in the binary as a C byte array (jemacs_program.h) + * and extracted to a memfd at runtime. + * + * FFI shims (chez_scintilla_shim, pcre2_shim) are compiled into the binary. + * Their symbols are found by Chez's foreign-procedure via dlsym(RTLD_DEFAULT) + * because we link with -rdynamic. At runtime we set CHEZ_SCINTILLA_LIB and + * CHEZ_PCRE2_LIB so the shim's load-shared-object call succeeds — we point + * it at the binary itself via a /proc/self/exe symlink in a tmpdir, or just + * let the shim load its own copy if CHEZ_SCINTILLA_LIB is already set. + */ + +#define _GNU_SOURCE +#include <stdlib.h> +#include <string.h> +#include <stdio.h> +#include <unistd.h> +#include <libgen.h> +#include <sys/mman.h> +#include <sys/stat.h> +#include "scheme.h" +#include "jemacs_program.h" /* jemacs_program_data[], jemacs_program_size */ +#include "jemacs_petite_boot.h" /* petite_boot_data[], petite_boot_size */ +#include "jemacs_scheme_boot.h" /* scheme_boot_data[], scheme_boot_size */ +#include "jemacs_jemacs_boot.h" /* jemacs_boot_data[], jemacs_boot_size */ + +int main(int argc, char *argv[]) { + /* Resolve real executable path */ + char exe_buf[4096]; + char exe_dir[4096]; + ssize_t len = readlink("/proc/self/exe", exe_buf, sizeof(exe_buf) - 1); + if (len > 0) { + exe_buf[len] = '\0'; + setenv("JEMACS_EXE", exe_buf, 1); + /* dirname() may modify its argument, use a copy */ + strncpy(exe_dir, exe_buf, sizeof(exe_dir) - 1); + exe_dir[sizeof(exe_dir) - 1] = '\0'; + char *dir = dirname(exe_dir); + /* Set shim paths to the binary's directory (if not already set) */ + if (!getenv("CHEZ_SCINTILLA_LIB")) + setenv("CHEZ_SCINTILLA_LIB", dir, 0); + if (!getenv("CHEZ_PCRE2_LIB")) + setenv("CHEZ_PCRE2_LIB", dir, 0); + } + + /* Create memfd for embedded program .so */ + int fd = memfd_create("jemacs-program", MFD_CLOEXEC); + if (fd < 0) { + perror("memfd_create"); + return 1; + } + if (write(fd, jemacs_program_data, jemacs_program_size) != (ssize_t)jemacs_program_size) { + perror("write memfd"); + close(fd); + return 1; + } + char prog_path[64]; + snprintf(prog_path, sizeof(prog_path), "/proc/self/fd/%d", fd); + + /* Initialize Chez Scheme */ + Sscheme_init(NULL); + + /* Register embedded boot files (no external files needed) */ + Sregister_boot_file_bytes("petite", (void*)petite_boot_data, petite_boot_size); + Sregister_boot_file_bytes("scheme", (void*)scheme_boot_data, scheme_boot_size); + Sregister_boot_file_bytes("jemacs", (void*)jemacs_boot_data, jemacs_boot_size); + + /* Build heap from registered boot files (libraries only — no program) */ + Sbuild_heap(NULL, NULL); + + /* Run the program via Sscheme_script (NOT Sscheme_start). + * This avoids the Chez bug where programs in boot files cannot + * create threads (fork-thread threads block on internal GC futex). + * + * Pass full argv (argc, argv) so Sscheme_script treats argv[0] as the + * program name and argv[1..] as arguments. Then (command-line-arguments) + * returns ("./jemacs" "--version" ...) and (member "--version" args) works. + * Passing (argc-1, argv+1) was wrong: argv[0]="--version" became the + * program name, leaving command-line-arguments empty. */ + int status = Sscheme_script(prog_path, argc, (const char **)argv); + + close(fd); + Sscheme_deinit(); + return status; +} new file mode 100644 --- /dev/null +++ b/jemacs-qt-main.c @@ -0,0 +1,108 @@ +/* + * jemacs-qt-main.c — Custom entry point for jemacs-qt (jerboa-emacs Qt frontend). + * + * Same threading workaround as jemacs-main.c: + * - Boot file contains only libraries (no program) + * - Program is loaded via Sscheme_script on a memfd + * + * The Qt event loop runs on its own pthread (created by qt-app-create in + * qt_shim.cpp). That pthread registers via Sactivate_thread/Sdeactivate_thread + * (implemented in qt_chez_shim.c) before invoking Chez foreign-callable + * trampolines. No special handling is needed here. + * + * The CHEZ_QT_LIB env var points qt_chez_shim to where qt_chez_shim.so + * lives (for load-shared-object). We point it at the binary's own directory + * since qt_chez_shim is compiled into the binary itself — but we still need + * the libqt_shim.so (gerbil-qt vendor shim) to be loadable. + * Set CHEZ_QT_SHIM_DIR to where libqt_shim.so lives (same dir as binary, + * or let the rpath handle it). + */ + +#define _GNU_SOURCE +#include <stdlib.h> +#include <string.h> +#include <stdio.h> +#include <unistd.h> +#include <libgen.h> +#include <sys/mman.h> +#include "scheme.h" +#include "jemacs_qt_program.h" /* jemacs_qt_program_data[], jemacs_qt_program_size */ +#include "jemacs_qt_petite_boot.h" /* petite_boot_data[], petite_boot_size */ +#include "jemacs_qt_scheme_boot.h" /* scheme_boot_data[], scheme_boot_size */ +#include "jemacs_qt_jemacs_qt_boot.h" /* jemacs_qt_boot_data[], jemacs_qt_boot_size */ + +int main(int argc, char *argv[]) { + /* Resolve real executable path */ + char exe_buf[4096]; + char exe_dir[4096]; + ssize_t len = readlink("/proc/self/exe", exe_buf, sizeof(exe_buf) - 1); + if (len > 0) { + exe_buf[len] = '\0'; + setenv("JEMACS_EXE", exe_buf, 1); + strncpy(exe_dir, exe_buf, sizeof(exe_dir) - 1); + exe_dir[sizeof(exe_dir) - 1] = '\0'; + char *dir = dirname(exe_dir); + /* Point FFI shim loaders at the binary's directory. + * The shims (qt_chez_shim, pcre2_shim) are compiled into the binary, + * and libqt_shim.so must be alongside the binary (rpath or LD_LIBRARY_PATH). */ + if (!getenv("CHEZ_QT_LIB")) + setenv("CHEZ_QT_LIB", dir, 0); + if (!getenv("CHEZ_QT_SHIM_DIR")) + setenv("CHEZ_QT_SHIM_DIR", dir, 0); + if (!getenv("CHEZ_PCRE2_LIB")) + setenv("CHEZ_PCRE2_LIB", dir, 0); + if (!getenv("CHEZ_SCINTILLA_LIB")) + setenv("CHEZ_SCINTILLA_LIB", dir, 0); + } + + /* Create memfd for embedded program .so */ + int fd = memfd_create("jemacs-qt-program", MFD_CLOEXEC); + if (fd < 0) { + perror("memfd_create"); + return 1; + } + if (write(fd, jemacs_qt_program_data, jemacs_qt_program_size) + != (ssize_t)jemacs_qt_program_size) { + perror("write memfd"); + close(fd); + return 1; + } + char prog_path[64]; + snprintf(prog_path, sizeof(prog_path), "/proc/self/fd/%d", fd); + + /* Initialize Chez Scheme */ + Sscheme_init(NULL); + + /* Register embedded boot files */ + Sregister_boot_file_bytes("petite", (void*)petite_boot_data, petite_boot_size); + Sregister_boot_file_bytes("scheme", (void*)scheme_boot_data, scheme_boot_size); + Sregister_boot_file_bytes("jemacs-qt", (void*)jemacs_qt_boot_data, jemacs_qt_boot_size); + +#ifdef JEMACS_STATIC_BUILD + /* Tell Scheme libraries they are in a static build so they skip + * load-shared-object calls (dlopen("file.so") fails in musl static). + * Must be set before Sbuild_heap so library bodies see it. */ + setenv("JEMACS_STATIC", "1", 1); +#endif + + /* Build heap from libraries only — no program */ + Sbuild_heap(NULL, NULL); + +#ifdef JEMACS_STATIC_BUILD + /* Register all FFI symbols after heap is built. + * Sforeign_symbol requires an initialized Scheme heap. + * foreign-procedure in library bodies uses dlsym(RTLD_DEFAULT) first; + * this call supplements that for any symbols missed by dlsym. */ + extern void register_static_foreign_symbols(void); + register_static_foreign_symbols(); +#endif + + /* Run via Sscheme_script so fork-thread works. + * Pass full argv so argv[0]=binary name and argv[1..]=user args. + * (command-line-arguments) returns ("./jemacs-qt" args...) — member checks work. */ + int status = Sscheme_script(prog_path, argc, (const char **)argv); + + close(fd); + Sscheme_deinit(); + return status; +} --- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -153,7 +153,7 @@ (sci-send ed SCI_SETTARGETEND end-pos) (sci-send/string ed SCI_REPLACETARGET pad)))))) (def (vterm-row-diff-render! ed vt ts) - "Render vtscreen rows into the QScintilla document.\n When many rows changed, uses full set-text! for efficiency.\n When few rows changed, uses per-line replacement." + "Render vtscreen rows into the QScintilla document.\n In normal mode with many dirty rows, uses full set-text! for efficiency.\n On alt screen (top, htop, etc.), always uses per-line replacement to avoid\n the full document reset that causes visible bouncing/flicker.\n Tracks which rows actually changed in *vterm-dirty-rows* for targeted recoloring." (let ([rows (vtscreen-rows vt)] [line-offset (hash-ref *vterm-line-offset* ts 0)] [cache (hash-ref *vterm-row-cache* ts #f)]) @@ -167,38 +167,47 @@ (cond [(>= r rows) (cond - [(= n 0) (vtscreen-clear-damage! vt) #f] - [(> n 4) + [(= n 0) + (vtscreen-clear-damage! vt) + (hash-put! *vterm-dirty-rows* ts (make-hash-table)) + #f] + [(and (> n 4) (not (vtscreen-alt-screen? vt))) (let* ([rendered (vtscreen-render vt)] - [pre-text (or (terminal-state-pre-pty-text ts) "")] - [full (if (vtscreen-alt-screen? vt) - rendered - (string-append pre-text rendered))]) + [pre-text (or (terminal-state-pre-pty-text ts) + "")]) (let update ([r2 0]) (when (< r2 rows) (vector-set! cache r2 (vtscreen-get-row-text vt r2)) (update (+ r2 1)))) (vtscreen-clear-damage! vt) - (qt-plain-text-edit-set-text! ed full) + (hash-put! *vterm-dirty-rows* ts #f) + (qt-plain-text-edit-set-text! + ed + (string-append pre-text rendered)) #t)] [else (vterm-ensure-lines! ed (+ line-offset rows)) - (let loop ([r2 0] [any-changed? #f]) - (if (>= r2 rows) - (begin (vtscreen-clear-damage! vt) any-changed?) - (if (vtscreen-row-dirty? vt r2) - (let ([new-text (vtscreen-get-row-text vt r2)] - [old-text (vector-ref cache r2)]) - (if (string=? new-text old-text) - (loop (+ r2 1) any-changed?) - (begin - (vector-set! cache r2 new-text) - (vterm-replace-line! - ed - (+ line-offset r2) - new-text) - (loop (+ r2 1) #t)))) - (loop (+ r2 1) any-changed?))))])] + (let ([dirty-set (make-hash-table)]) + (let loop ([r2 0] [any-changed? #f]) + (if (>= r2 rows) + (begin + (vtscreen-clear-damage! vt) + (hash-put! *vterm-dirty-rows* ts dirty-set) + any-changed?) + (if (vtscreen-row-dirty? vt r2) + (let ([new-text (vtscreen-get-row-text vt r2)] + [old-text (vector-ref cache r2)]) + (if (string=? new-text old-text) + (loop (+ r2 1) any-changed?) + (begin + (vector-set! cache r2 new-text) + (hash-put! dirty-set r2 #t) + (vterm-replace-line! + ed + (+ line-offset r2) + new-text) + (loop (+ r2 1) #t)))) + (loop (+ r2 1) any-changed?)))))])] [(vtscreen-row-dirty? vt r) (count-dirty (+ r 1) (+ n 1))] [else (count-dirty (+ r 1) n)])))) (def *vterm-next-style* 80) @@ -254,17 +263,20 @@ (- c run-start) run-style)) (loop (+ c 1) c style))))))))) + (def *vterm-dirty-rows* (make-hash-table-eq)) (def (vterm-apply-colors! ed vt ts) - "Apply colors to all dirty rows." + "Apply colors to rows updated in the last render pass." (let ([rows (vtscreen-rows vt)] - [line-offset (hash-ref *vterm-line-offset* ts 0)]) + [line-offset (hash-ref *vterm-line-offset* ts 0)] + [dirty-set (hash-ref *vterm-dirty-rows* ts #f)]) (let loop ([r 0]) (when (< r rows) - (let ([cache (hash-ref *vterm-row-cache* ts #f)]) - (when (and cache - (< r (vector-length cache)) - (> (string-length (vector-ref cache r)) 0)) - (vterm-apply-row-colors! ed vt r (+ line-offset r)))) + (when (or (not dirty-set) (hash-ref dirty-set r #f)) + (let ([cache (hash-ref *vterm-row-cache* ts #f)]) + (when (and cache + (< r (vector-length cache)) + (> (string-length (vector-ref cache r)) 0)) + (vterm-apply-row-colors! ed vt r (+ line-offset r))))) (loop (+ r 1)))))) (def (parse-repl-port args) "Return (port-num . filtered-args) if --repl <port> is present, else #f." @@ -553,17 +565,42 @@ (if (vtscreen-alt-screen? vt) (hash-put! *vterm-line-offset* ts 0) (void)) + (qt-widget-set-updates-enabled! ed #f) (let ([changed? (vterm-row-diff-render! ed vt ts)]) (when changed? (vterm-apply-colors! ed vt ts) - (qt-plain-text-edit-move-cursor! - ed - QT_CURSOR_END) - (qt-plain-text-edit-ensure-cursor-visible! - ed))))) + (if (vtscreen-alt-screen? vt) + (let* ([crow (vtscreen-cursor-row + vt)] + [ccol (vtscreen-cursor-col + vt)] + [offset (hash-ref + *vterm-line-offset* + ts + 0)] + [line-start (sci-send + ed + SCI_POSITIONFROMLINE + (+ offset + crow))] + [pos (+ line-start ccol)]) + (when (>= line-start 0) + (sci-send + ed + SCI_GOTOPOS + pos))) + (begin + (qt-plain-text-edit-move-cursor! + ed + QT_CURSOR_END) + (qt-plain-text-edit-ensure-cursor-visible! + ed)))) + (qt-widget-set-updates-enabled! + ed + #t)))) (vterm-mark-rendered! ts))) (begin (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) @@ -1906,7 +1943,9 @@ (lambda () (qt-drain-pending-callbacks!) (master-timer-tick!))))) - (def (qt-main . args) + (def ffi-umask + (foreign-procedure "umask" (unsigned-32) unsigned-32)) + (def (qt-main . args) (ffi-umask 63) (pin-thread-to-processor0! (current-thread)) (setenv "QT_IM_MODULE" "compose") (setenv "QT_ACCESSIBILITY" "0") --- a/lib/jerboa-emacs/qt/commands.sls +++ b/lib/jerboa-emacs/qt/commands.sls @@ -2817,25 +2817,6 @@ (echo-message! (app-state-echo app) "SSH config mode enabled (properties lexer)"))) - (def (cmd-helm-occur app) - "Helm-style occur (Qt)." - (let* ([echo (app-state-echo app)] - [ed (current-qt-editor app)] - [pattern (qt-echo-read-string app "Helm occur pattern: ")]) - (when (and pattern (> (string-length pattern) 0)) - (let* ([text (qt-plain-text-edit-text ed)] - [lines (string-split text #\newline)] - [matches (filter - (lambda (l) (string-contains l pattern)) - lines)]) - (if (null? matches) - (echo-message! echo "No matches") - (let ([buf (qt-buffer-create! "*Helm Occur*" ed)]) - (qt-buffer-attach! ed buf) - (qt-plain-text-edit-set-text! - ed - (string-append "Helm Occur: " pattern "\n\n" - (string-join matches "\n") "\n")))))))) (def (cmd-helm-dash app) "Search documentation — uses man pages and apropos (Qt)." (let* ([echo (app-state-echo app)] --- a/lib/jerboa-emacs/qt/helm-commands.sls +++ b/lib/jerboa-emacs/qt/helm-commands.sls @@ -3,72 +3,40 @@ ;;; Source: src/jerboa-emacs/qt/helm-commands.ss (library (jerboa-emacs qt helm-commands) - (export - qt-register-helm-commands! - cmd-helm-buffers-list - cmd-helm-occur) + (export qt-register-helm-commands! cmd-helm-occur) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name sort sort!) - (std sugar) (std sort) (std srfi srfi-13) - (chez-scintilla constants) (jerboa-emacs core) - (jerboa-emacs qt sci-shim) (jerboa-emacs qt buffer) - (jerboa-emacs qt window) (jerboa-emacs qt echo) - (jerboa-emacs helm) (jerboa-emacs helm-sources) - (jerboa-emacs qt helm-qt) (jerboa-emacs editor) + mutex? mutex-name) + (std sugar) (std srfi srfi-13) (chez-scintilla constants) + (jerboa-emacs core) (jerboa-emacs qt sci-shim) + (jerboa-emacs qt buffer) (jerboa-emacs qt window) + (jerboa-emacs qt echo) (jerboa-emacs editor) + (only + (jerboa-emacs qt commands-core) + current-qt-editor + current-qt-buffer + cmd-helm-buffers-list) (jerboa core) (jerboa runtime)) - (def (cmd-helm-buffers-list app) - "List and switch buffers with Qt helm narrowing." - (let* ([src (helm-source-buffers app)] - [session (make-new-session (list src) "*helm buffers*")] - [result (helm-qt-run! session app)]) - (when (and result (string? result)) - (let* ([buf-name (let ([star-pos (string-contains - result - " *")]) - (if star-pos - (substring result 0 star-pos) - (let ([space-pos (string-contains - result - " ")]) - (if space-pos - (substring result 0 space-pos) - result))))] - [buf (buffer-by-name buf-name)]) - (when buf - (let* ([ed (current-qt-editor app)] - [fr (app-state-frame app)]) - (qt-buffer-attach! ed buf) - (qt-edit-window-buffer-set! (qt-current-window fr) buf) - (echo-message! - (app-state-echo app) - (string-append "Switched to: " buf-name)))))))) (def (cmd-helm-occur app) "Search lines in current buffer with Qt helm narrowing." - (let* ([ed (current-qt-editor app)] - [echo (app-state-echo app)]) - (when ed - (let* ([text-fn (lambda () (qt-plain-text-edit-text ed))] - [src (helm-source-occur app text-fn)] - [session (make-new-session (list src) "*helm occur*")] - [result (helm-qt-run! session app)]) - (when (and result (string? result)) - (let ([colon-pos (string-index result #\:)]) - (when colon-pos - (let ([line-num (string->number - (substring result 0 colon-pos))]) - (when line-num - (let ([pos (sci-send - ed - SCI_POSITIONFROMLINE - (- line-num 1))]) - (sci-send ed SCI_GOTOPOS pos) - (echo-message! - echo - (string-append - "Line " - (number->string line-num))))))))))))) + (let* ([echo (app-state-echo app)] + [ed (current-qt-editor app)] + [pattern (qt-echo-read-string app "Helm occur pattern: ")]) + (when (and pattern (> (string-length pattern) 0)) + (let* ([text (qt-plain-text-edit-text ed)] + [lines (string-split text #\newline)] + [matches (filter + (lambda (l) (string-contains l pattern)) + lines)]) + (if (null? matches) + (echo-message! echo "No matches") + (let ([buf (qt-buffer-create! "*Helm Occur*" ed)]) + (qt-buffer-attach! ed buf) + (qt-plain-text-edit-set-text! + ed + (string-append "Helm Occur: " pattern "\n\n" + (string-join matches "\n") "\n")))))))) (def (qt-register-helm-commands!) "Register Qt-specific helm command overrides." (register-command! 'helm-buffers-list cmd-helm-buffers-list) --- a/src/jerboa-emacs/qt/commands.ss +++ b/src/jerboa-emacs/qt/commands.ss @@ -2440,22 +2440,7 @@ (sci-send ed SCI_SETLEXER SCLEX_PROPERTIES) (echo-message! (app-state-echo app) "SSH config mode enabled (properties lexer)"))) -(def (cmd-helm-occur app) - "Helm-style occur (Qt)." - (let* ((echo (app-state-echo app)) - (ed (current-qt-editor app)) - (pattern (qt-echo-read-string app "Helm occur pattern: "))) - (when (and pattern (> (string-length pattern) 0)) - (let* ((text (qt-plain-text-edit-text ed)) - (lines (string-split text #\newline)) - (matches (filter (lambda (l) (string-contains l pattern)) lines))) - (if (null? matches) - (echo-message! echo "No matches") - (let ((buf (qt-buffer-create! "*Helm Occur*" ed))) - (qt-buffer-attach! ed buf) - (qt-plain-text-edit-set-text! ed - (string-append "Helm Occur: " pattern "\n\n" - (string-join matches "\n") "\n")))))))) +;; cmd-helm-occur provided by qt/helm-commands.ss (def (cmd-helm-dash app) "Search documentation — uses man pages and apropos (Qt)." --- a/src/jerboa-emacs/qt/helm-commands.ss +++ b/src/jerboa-emacs/qt/helm-commands.ss @@ -1,16 +1,15 @@ ;;; -*- Gerbil -*- ;;; Helm commands for jemacs (Qt backend) ;;; -;;; Qt-specific overrides for helm commands that need the Qt renderer. -;;; Overrides cmd-helm-buffers-list and cmd-helm-occur from the TUI version. +;;; Qt-specific helm command registration and overrides. +;;; cmd-helm-buffers-list is defined in commands-core.ss. +;;; cmd-helm-occur is defined here as the Qt-specific version. (export qt-register-helm-commands! - cmd-helm-buffers-list cmd-helm-occur) (import :std/sugar - :std/sort :std/srfi/13 :chez-scintilla/constants :jerboa-emacs/core @@ -18,36 +17,9 @@ :jerboa-emacs/qt/buffer :jerboa-emacs/qt/window :jerboa-emacs/qt/echo - :jerboa-emacs/helm - :jerboa-emacs/helm-sources - :jerboa-emacs/qt/helm-qt - :jerboa-emacs/editor) - -;;;============================================================================ -;;; Qt Helm Buffers List -;;;============================================================================ - -(def (cmd-helm-buffers-list app) - "List and switch buffers with Qt helm narrowing." - (let* ((src (helm-source-buffers app)) - (session (make-new-session (list src) "*helm buffers*")) - (result (helm-qt-run! session app))) - (when (and result (string? result)) - (let* ((buf-name (let ((star-pos (string-contains result " *"))) - (if star-pos - (substring result 0 star-pos) - (let ((space-pos (string-contains result " "))) - (if space-pos - (substring result 0 space-pos) - result))))) - (buf (buffer-by-name buf-name))) - (when buf - (let* ((ed (current-qt-editor app)) - (fr (app-state-frame app))) - (qt-buffer-attach! ed buf) - (set! (qt-edit-window-buffer (qt-current-window fr)) buf) - (echo-message! (app-state-echo app) - (string-append "Switched to: " buf-name)))))))) + :jerboa-emacs/editor + (only-in :jerboa-emacs/qt/commands-core current-qt-editor current-qt-buffer + cmd-helm-buffers-list)) ;;;============================================================================ ;;; Qt Helm Occur @@ -55,23 +27,20 @@ (def (cmd-helm-occur app) "Search lines in current buffer with Qt helm narrowing." - (let* ((ed (current-qt-editor app)) - (echo (app-state-echo app))) - (when ed - (let* ((text-fn (lambda () (qt-plain-text-edit-text ed))) - (src (helm-source-occur app text-fn)) - (session (make-new-session (list src) "*helm occur*")) - (result (helm-qt-run! session app))) - (when (and result (string? result)) - ;; Extract line number and go to it - (let ((colon-pos (string-index result #\:))) - (when colon-pos - (let ((line-num (string->number (substring result 0 colon-pos)))) - (when line-num - (let ((pos (sci-send ed SCI_POSITIONFROMLINE (- line-num 1)))) - (sci-send ed SCI_GOTOPOS pos) - (echo-message! echo - (string-append "Line " (number->string line-num))))))))))))) + (let* ((echo (app-state-echo app)) + (ed (current-qt-editor app)) + (pattern (qt-echo-read-string app "Helm occur pattern: "))) + (when (and pattern (> (string-length pattern) 0)) + (let* ((text (qt-plain-text-edit-text ed)) + (lines (string-split text #\newline)) + (matches (filter (lambda (l) (string-contains l pattern)) lines))) + (if (null? matches) + (echo-message! echo "No matches") + (let ((buf (qt-buffer-create! "*Helm Occur*" ed))) + (qt-buffer-attach! ed buf) + (qt-plain-text-edit-set-text! ed + (string-append "Helm Occur: " pattern "\n\n" + (string-join matches "\n") "\n")))))))) ;;;============================================================================ ;;; Command registration new file mode 100644 --- /dev/null +++ b/support/chez_scintilla_stubs.c @@ -0,0 +1,154 @@ +/* chez_scintilla_stubs.c — No-op stubs for static Qt builds + * + * The Qt frontend uses QScintilla, not the TUI Scintilla+termbox backend. + * However, the Chez Scheme code has foreign-procedure definitions referencing + * these C symbols. For the static binary to link, all symbols must be present + * (even though they are never called at runtime). + */ + +#include <stdint.h> + +/* ================================================================ + Scintilla instance lifecycle + ================================================================ */ +void *chez_scintilla_new(void) { return (void*)0; } +void chez_scintilla_delete(void *handle) { (void)handle; } + +/* ================================================================ + Message passing + ================================================================ */ +long chez_scintilla_send_message(void *handle, unsigned int msg, + unsigned long wparam, long lparam) { + (void)handle; (void)msg; (void)wparam; (void)lparam; + return 0; +} + +long chez_scintilla_send_message_string(void *handle, unsigned int msg, + unsigned long wparam, const char *s) { + (void)handle; (void)msg; (void)wparam; (void)s; + return 0; +} + +const char *chez_scintilla_receive_string(void *handle, unsigned int msg, + unsigned long wparam) { + (void)handle; (void)msg; (void)wparam; + return ""; +} + +long chez_scintilla_set_property(void *handle, unsigned int msg, + const char *key, const char *val) { + (void)handle; (void)msg; (void)key; (void)val; + return 0; +} + +/* ================================================================ + Input + ================================================================ */ +void chez_scintilla_send_key(void *handle, int key, + int shift, int ctrl, int alt) { + (void)handle; (void)key; (void)shift; (void)ctrl; (void)alt; +} + +int chez_scintilla_send_mouse(void *handle, int event, int button, + int x, int y, int ctrl) { + (void)handle; (void)event; (void)button; + (void)x; (void)y; (void)ctrl; + return 0; +} + +/* ================================================================ + Display + ================================================================ */ +void chez_scintilla_refresh(void *handle) { (void)handle; } +void chez_scintilla_resize(void *handle, int width, int height) { + (void)handle; (void)width; (void)height; +} +void chez_scintilla_move(void *handle, int x, int y) { + (void)handle; (void)x; (void)y; +} + +/* ================================================================ + Clipboard & Lexer + ================================================================ */ +const char *chez_scintilla_get_clipboard(void *handle) { + (void)handle; + return ""; +} + +void chez_scintilla_set_lexer_language(void *handle, const char *lang) { + (void)handle; (void)lang; +} + +/* ================================================================ + Notification queue + ================================================================ */ +int chez_scintilla_drain_one(void *handle) { + (void)handle; + return 0; +} + +/* ================================================================ + Notification field accessors (all return zero/empty) + ================================================================ */ +int chez_scn_code(void) { return 0; } +long chez_scn_position(void) { return 0; } +int chez_scn_ch(void) { return 0; } +int chez_scn_modifiers(void) { return 0; } +int chez_scn_modification_type(void) { return 0; } +const char *chez_scn_text(void) { return ""; } +long chez_scn_length(void) { return 0; } +long chez_scn_lines_added(void) { return 0; } +int chez_scn_message(void) { return 0; } +long chez_scn_line(void) { return 0; } +int chez_scn_fold_level_now(void) { return 0; } +int chez_scn_fold_level_prev(void) { return 0; } +int chez_scn_margin(void) { return 0; } +int chez_scn_list_type(void) { return 0; } +int chez_scn_x(void) { return 0; } +int chez_scn_y(void) { return 0; } +int chez_scn_token(void) { return 0; } +int chez_scn_updated(void) { return 0; } + +/* ================================================================ + Termbox stubs (TUI terminal library — unused in Qt) + ================================================================ */ +int chez_tb_init(void) { return -1; } +void chez_tb_shutdown(void) { } +int chez_tb_width(void) { return 0; } +int chez_tb_height(void) { return 0; } +void chez_tb_clear(void) { } +void chez_tb_present(void) { } +void chez_tb_set_cursor(int x, int y) { (void)x; (void)y; } + +int chez_tb_poll_event(void) { return 0; } +int chez_tb_peek_event(int timeout_ms) { (void)timeout_ms; return 0; } + +/* ================================================================ + Termbox event field accessors + ================================================================ */ +int chez_tb_event_type(void) { return 0; } +int chez_tb_event_mod(void) { return 0; } +int chez_tb_event_key(void) { return 0; } +unsigned int chez_tb_event_ch(void) { return 0; } +int chez_tb_event_w(void) { return 0; } +int chez_tb_event_h(void) { return 0; } +int chez_tb_event_x(void) { return 0; } +int chez_tb_event_y(void) { return 0; } + +/* ================================================================ + Termbox extended operations + ================================================================ */ +void chez_tb_change_cell(int x, int y, uint32_t ch, uint32_t fg, uint32_t bg) { + (void)x; (void)y; (void)ch; (void)fg; (void)bg; +} + +void chez_tb_set_clear_attributes(uint32_t fg, uint32_t bg) { + (void)fg; (void)bg; +} + +int chez_tb_select_input_mode(int mode) { (void)mode; return 0; } +int chez_tb_select_output_mode(int mode) { (void)mode; return 0; } + +void chez_tb_print_string(int x, int y, uint32_t fg, uint32_t bg, const char *str) { + (void)x; (void)y; (void)fg; (void)bg; (void)str; +}