Add 20 Emacs features round 4: git-timemachine, exec-path, goto-line-preview, nav-flash, pulsar, goggles, eros, tmr, logos, cursory, doom-modeline, ts-fold, casual, spacious-padding, dape, burly, elp, fontaine, shr-render, auto-theme
ober
4ce0d63e9bd8d2dbadace81e582ab0a53af29a86
--- a/src/jerboa-emacs/app.ss +++ b/src/jerboa-emacs/app.ss @@ -28,7 +28,8 @@ :jerboa-emacs/helm-commands (only-in :jerboa-emacs/editor-extra-editing tui-record-edit-position!) (only-in :jerboa-emacs/editor-extra-media2 beacon-check-jump!) - (only-in :jerboa-emacs/editor-extra-final follow-mode-sync!) + (only-in :jerboa-emacs/editor-extra-final follow-mode-sync! auto-theme-check!) + (only-in :jerboa-emacs/editor-extra-media2 nav-flash-check!) (only-in :jerboa-emacs/editor-extra-org *desktop-save-mode*) (only-in :jerboa-emacs/persist *which-key-mode* *which-key-delay* which-key-summary)) @@ -576,6 +577,12 @@ ;; Follow mode: sync adjacent windows (follow-mode-sync! app) + ;; Nav-flash: flash line on navigation jumps + (nav-flash-check! app) + + ;; Auto-theme: check time-based theme switching (~every 30s) + (auto-theme-check! app) + ;; Auto-save and external modification check (~30s at 50ms poll) (set! *auto-save-counter* (+ *auto-save-counter* 1)) (when (>= *auto-save-counter* *auto-save-interval*) --- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -2820,3 +2820,451 @@ (editor-goto-pos ed 0) (echo-message! echo "Sorted by memory"))) (loop (cons line lines)))))))) + +;;;============================================================================ +;;; Round 4 batch 2: Features 11-20 +;;;============================================================================ + +;; --- Feature 11: Doom Modeline (enhanced modeline info) --- + +(def *doom-modeline-enabled* #f) +(def *doom-modeline-segments* + '(buffer-info major-mode vcs checker)) + +(def (cmd-doom-modeline-mode app) + "Toggle doom-modeline style — enhanced modeline display." + (set! *doom-modeline-enabled* (not *doom-modeline-enabled*)) + (echo-message! (app-state-echo app) + (if *doom-modeline-enabled* + "Doom modeline: on (enhanced status display)" + "Doom modeline: off"))) + +(def (doom-modeline-format app) + "Generate doom-modeline style string for status area." + (when *doom-modeline-enabled* + (let* ((buf (current-buffer-from-app app)) + (name (if buf (buffer-name buf) "[no buffer]")) + (path (and buf (buffer-file-path buf))) + (ext (if path (path-extension path) "")) + (mode-name + (cond + ((member ext '("ss" "scm" "el")) "Scheme") + ((member ext '("py")) "Python") + ((member ext '("js" "ts")) "JS/TS") + ((member ext '("c" "h" "cpp")) "C/C++") + ((member ext '("go")) "Go") + ((member ext '("rs")) "Rust") + ((member ext '("md")) "Markdown") + ((member ext '("org")) "Org") + (else "Text"))) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (line (+ 1 (send-message ed SCI_LINEFROMPOSITION + (send-message ed SCI_GETCURRENTPOS 0 0) 0))) + (col (+ 1 (send-message ed SCI_GETCOLUMN + (send-message ed SCI_GETCURRENTPOS 0 0) 0))) + (total-lines (send-message ed SCI_GETLINECOUNT 0 0)) + (percent (if (> total-lines 0) + (quotient (* line 100) total-lines) + 0))) + (string-append " " name " | " mode-name " | L" + (number->string line) ":C" (number->string col) + " (" (number->string percent) "%)")))) + +;; --- Feature 12: TS-Fold (tree-sitter based code folding) --- + +(def (cmd-ts-fold-toggle app) + "Toggle code folding at current line using Scintilla's fold system." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (line (send-message ed SCI_LINEFROMPOSITION + (send-message ed SCI_GETCURRENTPOS 0 0) 0))) + (send-message ed SCI_TOGGLEFOLD line 0) + (echo-message! (app-state-echo app) + (string-append "Toggled fold at line " (number->string (+ line 1)))))) + +(def (cmd-ts-fold-all app) + "Fold all top-level blocks." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (line-count (send-message ed SCI_GETLINECOUNT 0 0))) + (let loop ((line 0)) + (when (< line line-count) + (let ((level (send-message ed SCI_GETFOLDLEVEL line 0))) + (when (and (> (bitwise-and level #x2000) 0) ;; SC_FOLDLEVELHEADERFLAG + (not (= (send-message ed SCI_GETFOLDEXPANDED line 0) 0))) + (send-message ed SCI_TOGGLEFOLD line 0))) + (loop (+ line 1)))) + (echo-message! (app-state-echo app) "All folds collapsed"))) + +(def (cmd-ts-fold-unfold-all app) + "Unfold all blocks." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (line-count (send-message ed SCI_GETLINECOUNT 0 0))) + (let loop ((line 0)) + (when (< line line-count) + (let ((level (send-message ed SCI_GETFOLDLEVEL line 0))) + (when (and (> (bitwise-and level #x2000) 0) + (= (send-message ed SCI_GETFOLDEXPANDED line 0) 0)) + (send-message ed SCI_TOGGLEFOLD line 0))) + (loop (+ line 1)))) + (echo-message! (app-state-echo app) "All folds expanded"))) + +;; --- Feature 13: Casual (transient menu system) --- + +(def *casual-menus* (make-hash-table)) + +(def (casual-define-menu! name entries) + "Define a transient menu. entries: list of (key label command-sym)" + (hash-put! *casual-menus* name entries)) + +;; Pre-define some useful menus +(casual-define-menu! 'buffer + '((#\n "Next buffer" next-buffer) + (#\p "Previous buffer" previous-buffer) + (#\k "Kill buffer" kill-buffer) + (#\s "Save buffer" save-buffer) + (#\l "List buffers" list-buffers))) + +(casual-define-menu! 'window + '((#\2 "Split horizontal" split-window-below) + (#\3 "Split vertical" split-window-right) + (#\0 "Delete window" delete-window) + (#\1 "Delete other" delete-other-windows) + (#\o "Other window" other-window))) + +(def (cmd-casual-buffer-menu app) + "Show casual buffer menu." + (let* ((echo (app-state-echo app)) + (entries (hash-ref *casual-menus* 'buffer '())) + (display-lines (map (lambda (e) + (string-append " " (string (cadr e)) " " (symbol->string (caddr e)))) + entries))) + (echo-message! echo + (string-append "Buffer: " (string-join + (map (lambda (e) + (string-append "[" (string (car e)) "] " (cadr e))) + entries) + " "))))) + +(def (cmd-casual-window-menu app) + "Show casual window menu." + (let* ((echo (app-state-echo app)) + (entries (hash-ref *casual-menus* 'window '()))) + (echo-message! echo + (string-append "Window: " (string-join + (map (lambda (e) + (string-append "[" (string (car e)) "] " (cadr e))) + entries) + " "))))) + +;; --- Feature 14: Spacious Padding --- + +(def *spacious-padding-enabled* #f) +(def *spacious-padding-size* 2) + +(def (cmd-spacious-padding-mode app) + "Toggle spacious padding — add visual padding around text." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app))))) + (set! *spacious-padding-enabled* (not *spacious-padding-enabled*)) + (if *spacious-padding-enabled* + (begin + ;; Add left margin padding + (send-message ed SCI_SETMARGINLEFT 0 (* *spacious-padding-size* 8)) + (send-message ed SCI_SETMARGINRIGHT 0 (* *spacious-padding-size* 8)) + (send-message ed SCI_SETEXTRAASCENT (* *spacious-padding-size* 2) 0) + (send-message ed SCI_SETEXTRADESCENT (* *spacious-padding-size* 1) 0) + (echo-message! echo "Spacious padding: on")) + (begin + (send-message ed SCI_SETMARGINLEFT 0 0) + (send-message ed SCI_SETMARGINRIGHT 0 0) + (send-message ed SCI_SETEXTRAASCENT 0 0) + (send-message ed SCI_SETEXTRADESCENT 0 0) + (echo-message! echo "Spacious padding: off"))))) + +;; --- Feature 15: DAPE (Debug Adapter Protocol stub) --- + +(def *dape-breakpoints* '()) +(def *dape-active* #f) + +(def (cmd-dape app) + "Start debug adapter session (stub — shows debug UI)." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (set! *dape-active* #t) + (let* ((buf (make-buffer "*dape-debug*")) + (content (string-append "Debug Adapter Protocol\n" + (make-string 50 #\=) "\n" + "Status: Waiting for connection\n" + "Breakpoints: " (number->string (length *dape-breakpoints*)) "\n" + "\nCommands:\n" + " dape-breakpoint-toggle — toggle breakpoint at line\n" + " dape-step — step over\n" + " dape-continue — continue execution\n" + " dape-quit — end debug session\n"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "DAPE: debug session started")))) + +(def (cmd-dape-breakpoint-toggle app) + "Toggle breakpoint at current line." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (line (send-message ed SCI_LINEFROMPOSITION + (send-message ed SCI_GETCURRENTPOS 0 0) 0)) + (buf (current-buffer-from-app app)) + (name (if buf (buffer-name buf) "")) + (key (string-append name ":" (number->string line)))) + (if (member key *dape-breakpoints*) + (begin + (set! *dape-breakpoints* (filter (lambda (b) (not (string=? b key))) *dape-breakpoints*)) + ;; Remove margin marker + (send-message ed SCI_MARKERDELETE line 2) + (echo-message! echo (string-append "Breakpoint removed: line " (number->string (+ line 1))))) + (begin + (set! *dape-breakpoints* (cons key *dape-breakpoints*)) + ;; Add red circle margin marker + (send-message ed SCI_MARKERADD line 2) + (echo-message! echo (string-append "Breakpoint set: line " (number->string (+ line 1)))))))) + +(def (cmd-dape-quit app) + "End debug session." + (set! *dape-active* #f) + (set! *dape-breakpoints* '()) + (echo-message! (app-state-echo app) "DAPE: debug session ended")) + +;; --- Feature 16: Burly (save/restore window configurations) --- + +(def *burly-configs* (make-hash-table)) + +(def (cmd-burly-bookmark-windows app) + "Save current window configuration as a named bookmark." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (name (echo-read-string echo "Config name: " row width))) + (when (and name (not (string-empty? name))) + (let* ((fr (app-state-frame app)) + (wins (frame-windows fr)) + (config (map (lambda (win) + (let* ((buf (edit-window-buffer win)) + (bname (if buf (buffer-name buf) "*scratch*")) + (ed (edit-window-editor win)) + (pos (send-message ed SCI_GETCURRENTPOS 0 0))) + (cons bname pos))) + wins))) + (hash-put! *burly-configs* name config) + (echo-message! echo (string-append "Saved config: " name + " (" (number->string (length wins)) " windows)")))))) + +(def (cmd-burly-open-bookmark app) + "Restore a saved window configuration." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (names (map (lambda (p) (symbol->string (car p))) (hash->list *burly-configs*)))) + (if (null? names) + (echo-message! echo "No saved configurations") + (let ((choice (echo-read-string-with-completion echo "Restore config: " names row width))) + (when (and choice (not (string-empty? choice))) + (let ((config (hash-get *burly-configs* (string->symbol choice)))) + (if (not config) + (echo-error! echo "Config not found") + (begin + ;; Restore first window's buffer + (when (not (null? config)) + (let* ((first (car config)) + (bname (car first)) + (pos (cdr first)) + (buf (buffer-by-name bname)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (when buf + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-goto-pos ed pos)))) + (echo-message! echo (string-append "Restored config: " choice)))))))))) + +(def (cmd-burly-list app) + "List saved window configurations." + (let* ((echo (app-state-echo app)) + (configs (hash->list *burly-configs*))) + (if (null? configs) + (echo-message! echo "No saved configurations") + (let ((lines (map (lambda (c) + (string-append " " (symbol->string (car c)) " (" + (number->string (length (cdr c))) " windows)")) + configs))) + (echo-message! echo (string-append "Configs: " (string-join lines ", "))))))) + +;; --- Feature 17: ELP (Emacs Lisp Profiler — command timing) --- + +(def *elp-timing* (make-hash-table)) +(def *elp-enabled* #f) +(def *elp-last-start* 0) + +(def (cmd-elp-instrument app) + "Start timing commands." + (set! *elp-enabled* #t) + (set! *elp-timing* (make-hash-table)) + (echo-message! (app-state-echo app) "ELP: instrumentation started")) + +(def (cmd-elp-results app) + "Show ELP timing results." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (pairs (hash->list *elp-timing*))) + (set! *elp-enabled* #f) + (if (null? pairs) + (echo-message! echo "No timing data") + (let* ((sorted (sort (lambda (a b) + (> (cadr (cdr a)) (cadr (cdr b)))) + pairs)) + (lines (map (lambda (p) + (let* ((name (symbol->string (car p))) + (data (cdr p)) + (calls (car data)) + (total-ms (cadr data)) + (pad (make-string (max 0 (- 35 (string-length name))) #\space))) + (string-append " " name pad + (number->string calls) " calls " + (number->string total-ms) "ms total"))) + (if (> (length sorted) 30) (list-head sorted 30) sorted))) + (content (string-append "ELP Results\n" + (make-string 60 #\=) "\n" + (string-join lines "\n") "\n")) + (buf (make-buffer "*elp*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0))))) + +(def (elp-record! cmd-name elapsed-ms) + "Record timing for a command." + (when *elp-enabled* + (let ((existing (hash-get *elp-timing* cmd-name))) + (if existing + (hash-put! *elp-timing* cmd-name + (list (+ (car existing) 1) (+ (cadr existing) elapsed-ms))) + (hash-put! *elp-timing* cmd-name (list 1 elapsed-ms)))))) + +;; --- Feature 18: Fontaine (font configuration presets) --- + +(def *fontaine-presets* + (make-hash-table)) + +;; Initialize default presets +(def (fontaine-init!) + (hash-put! *fontaine-presets* 'regular + '((size . 12) (weight . "normal"))) + (hash-put! *fontaine-presets* 'presentation + '((size . 18) (weight . "normal"))) + (hash-put! *fontaine-presets* 'small + '((size . 10) (weight . "normal"))) + (hash-put! *fontaine-presets* 'large + '((size . 16) (weight . "bold")))) + +(fontaine-init!) + +(def (cmd-fontaine-set-preset app) + "Select a font preset." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (names (map (lambda (p) (symbol->string (car p))) + (hash->list *fontaine-presets*))) + (choice (echo-read-string-with-completion echo "Font preset: " names row width))) + (when (and choice (not (string-empty? choice))) + (let ((preset (hash-get *fontaine-presets* (string->symbol choice)))) + (if (not preset) + (echo-error! echo "Preset not found") + (let* ((size (cdr (assq 'size preset))) + (ed (edit-window-editor (current-window (app-state-frame app))))) + ;; Apply font size via Scintilla + (let loop ((style 0)) + (when (< style 128) + (send-message ed SCI_STYLESETSIZE style size) + (loop (+ style 1)))) + (echo-message! echo + (string-append "Font preset: " choice " (size " (number->string size) ")")))))))) + +;; --- Feature 19: SHR Render (simple HTML rendering) --- + +(def (cmd-shr-render app) + "Render HTML in current buffer as plain text." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (html (editor-get-text ed))) + (if (string-empty? html) + (echo-message! echo "Buffer is empty") + ;; Simple HTML to text: strip tags, decode common entities + (let* ((stripped + (let loop ((i 0) (in-tag #f) (acc '())) + (if (>= i (string-length html)) + (list->string (reverse acc)) + (let ((ch (string-ref html i))) + (cond + ((char=? ch #\<) (loop (+ i 1) #t acc)) + ((and in-tag (char=? ch #\>)) + ;; Check for block tags to insert newlines + (loop (+ i 1) #f acc)) + (in-tag (loop (+ i 1) #t acc)) + ((and (char=? ch #\&) (< (+ i 3) (string-length html))) + (cond + ((string-prefix? "&" (substring html i (min (string-length html) (+ i 5)))) + (loop (+ i 5) #f (cons #\& acc))) + ((string-prefix? "<" (substring html i (min (string-length html) (+ i 4)))) + (loop (+ i 4) #f (cons #\< acc))) + ((string-prefix? ">" (substring html i (min (string-length html) (+ i 4)))) + (loop (+ i 4) #f (cons #\> acc))) + ((string-prefix? " " (substring html i (min (string-length html) (+ i 6)))) + (loop (+ i 6) #f (cons #\space acc))) + ((string-prefix? """ (substring html i (min (string-length html) (+ i 6)))) + (loop (+ i 6) #f (cons #\" acc))) + (else (loop (+ i 1) #f (cons ch acc))))) + (else (loop (+ i 1) #f (cons ch acc))))))))) + (editor-set-text ed stripped) + (editor-goto-pos ed 0) + (echo-message! echo "HTML rendered as text"))))) + +;; --- Feature 20: Auto Theme Switch (time-based theme switching) --- + +(def *auto-theme-enabled* #f) +(def *auto-theme-light-hour* 7) ;; Switch to light at 7 AM +(def *auto-theme-dark-hour* 19) ;; Switch to dark at 7 PM +(def *auto-theme-current* 'dark) + +(def (cmd-auto-theme-switch app) + "Toggle automatic time-based theme switching." + (set! *auto-theme-enabled* (not *auto-theme-enabled*)) + (echo-message! (app-state-echo app) + (if *auto-theme-enabled* + (string-append "Auto theme: on (light " (number->string *auto-theme-light-hour*) + ":00, dark " (number->string *auto-theme-dark-hour*) ":00)") + "Auto theme: off"))) + +(def (auto-theme-check! app) + "Check current time and switch theme if needed." + (when *auto-theme-enabled* + (let* ((now (current-time)) + (d (time-utc->date now 0)) + (hour (date-hour d)) + (should-be-light (and (>= hour *auto-theme-light-hour*) + (< hour *auto-theme-dark-hour*))) + (target (if should-be-light 'light 'dark))) + (when (not (eq? target *auto-theme-current*)) + (set! *auto-theme-current* target) + (let ((ed (edit-window-editor (current-window (app-state-frame app))))) + (if (eq? target 'light) + (begin + ;; Light theme colors + (send-message ed SCI_STYLESETBACK 32 #xFFFFFF) ;; default bg + (send-message ed SCI_STYLESETFORE 32 #x000000) ;; default fg + (send-message ed SCI_SETCARETFORE #x000000 0)) + (begin + ;; Dark theme colors + (send-message ed SCI_STYLESETBACK 32 #x1E1E2E) ;; default bg + (send-message ed SCI_STYLESETFORE 32 #xCDD6F4) ;; default fg + (send-message ed SCI_SETCARETFORE #xCDD6F4 0)))))))) --- a/src/jerboa-emacs/editor-extra-media2.ss +++ b/src/jerboa-emacs/editor-extra-media2.ss @@ -2056,3 +2056,366 @@ (echo-message! (app-state-echo app) (if *tui-aggressive-fill* "Aggressive fill-paragraph mode enabled" "Aggressive fill-paragraph mode disabled"))) +;;;============================================================================ +;;; Round 4 batch 1: Features 1-10 +;;;============================================================================ + +;; --- Feature 1: Git Time Machine --- +;; Step through git history of current file + +(def *git-timemachine-revs* '()) +(def *git-timemachine-index* 0) + +(def (cmd-git-timemachine app) + "Step through git history of current file." + (let* ((echo (app-state-echo app)) + (buf (current-buffer-from-app app)) + (path (and buf (buffer-file-path buf)))) + (if (not path) + (echo-error! echo "Buffer has no file") + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (string-append "git log --pretty=format:'%h %ai %s' -- \"" path "\"") + 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((lines '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) + (close-port p-stderr) + (if (null? lines) + (echo-message! echo "No git history for this file") + (begin + (set! *git-timemachine-revs* (reverse lines)) + (set! *git-timemachine-index* 0) + (echo-message! echo + (string-append "Git time machine: " + (number->string (length (reverse lines))) + " revisions. Use timemachine-next/prev to navigate"))))) + (loop (cons line lines))))))))) + +(def (git-timemachine-show-rev! app idx) + "Show a specific git revision of current file." + (let* ((echo (app-state-echo app)) + (buf (current-buffer-from-app app)) + (path (and buf (buffer-file-path buf))) + (rev-line (list-ref *git-timemachine-revs* idx)) + (hash (let ((sp (string-contains rev-line " "))) + (if sp (substring rev-line 0 sp) rev-line)))) + (when path + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (string-append "git show " hash ":\"" path "\" 2>&1") + 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((lines '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) + (close-port p-stderr) + (let* ((content (string-join (reverse lines) "\n")) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo + (string-append "[" (number->string (+ idx 1)) "/" + (number->string (length *git-timemachine-revs*)) + "] " rev-line)))) + (loop (cons line lines))))))))) + +(def (cmd-git-timemachine-next app) + "Show next (newer) revision." + (if (null? *git-timemachine-revs*) + (echo-message! (app-state-echo app) "No time machine active") + (begin + (set! *git-timemachine-index* + (max 0 (- *git-timemachine-index* 1))) + (git-timemachine-show-rev! app *git-timemachine-index*)))) + +(def (cmd-git-timemachine-prev app) + "Show previous (older) revision." + (if (null? *git-timemachine-revs*) + (echo-message! (app-state-echo app) "No time machine active") + (begin + (set! *git-timemachine-index* + (min (- (length *git-timemachine-revs*) 1) (+ *git-timemachine-index* 1))) + (git-timemachine-show-rev! app *git-timemachine-index*)))) + +;; --- Feature 2: Exec Path From Shell --- + +(def (cmd-exec-path-from-shell app) + "Import PATH and other env vars from login shell." + (let* ((echo (app-state-echo app))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + "bash -lc 'echo PATH=$PATH; echo GOPATH=$GOPATH; echo CARGO_HOME=$CARGO_HOME'" + 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((lines '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) + (close-port p-stderr) + (for-each + (lambda (l) + (let ((eq (string-contains l "="))) + (when eq + (let ((name (substring l 0 eq)) + (val (substring l (+ eq 1) (string-length l)))) + (putenv name val))))) + (reverse lines)) + (echo-message! echo + (string-append "Imported " (number->string (length lines)) " env vars from shell"))) + (loop (cons line lines)))))))) + +;; --- Feature 3: Goto Line Preview --- + +(def (cmd-goto-line-preview app) + "Go to line number with live preview highlighting." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (orig-pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (input (echo-read-string echo "Goto line: " row width))) + (if (and input (not (string-empty? input))) + (let ((line-num (string->number (string-trim input)))) + (if (and line-num (> line-num 0)) + (let ((pos (send-message ed SCI_POSITIONFROMLINE (- line-num 1) 0))) + (editor-goto-pos ed pos) + (pulse-line! ed) + (echo-message! echo (string-append "Line " (number->string line-num)))) + (begin + (editor-goto-pos ed orig-pos) + (echo-message! echo "Invalid line number")))) + (editor-goto-pos ed orig-pos)))) + +;; --- Feature 4: Nav Flash --- +;; Flash the cursor line after navigation jumps + +(def *nav-flash-enabled* #f) +(def *nav-flash-last-line* -1) + +(def (cmd-nav-flash-mode app) + "Toggle nav-flash — briefly highlight line after navigation." + (set! *nav-flash-enabled* (not *nav-flash-enabled*)) + (echo-message! (app-state-echo app) + (if *nav-flash-enabled* "Nav-flash mode: on" "Nav-flash mode: off"))) + +(def (nav-flash-check! app) + "Check for line change and flash if significant jump." + (when *nav-flash-enabled* + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (line (send-message ed SCI_LINEFROMPOSITION + (send-message ed SCI_GETCURRENTPOS 0 0) 0))) + (when (and (>= *nav-flash-last-line* 0) + (> (abs (- line *nav-flash-last-line*)) 5)) + (pulse-line! ed)) + (set! *nav-flash-last-line* line)))) + +;; --- Feature 5: Pulsar --- +;; Pulse current line on specific actions + +(def *pulsar-enabled* #f) + +(def (cmd-pulsar-mode app) + "Toggle pulsar — pulse current line on scroll/switch." + (set! *pulsar-enabled* (not *pulsar-enabled*)) + (echo-message! (app-state-echo app) + (if *pulsar-enabled* "Pulsar mode: on" "Pulsar mode: off"))) + +(def (cmd-pulsar-pulse app) + "Manually pulse the current line." + (let ((ed (edit-window-editor (current-window (app-state-frame app))))) + (pulse-line! ed))) + +;; --- Feature 6: Goggles (visual feedback for operations) --- + +(def *goggles-enabled* #f) + +(def (cmd-goggles-mode app) + "Toggle goggles — visual feedback for yank/kill/undo." + (set! *goggles-enabled* (not *goggles-enabled*)) + (echo-message! (app-state-echo app) + (if *goggles-enabled* "Goggles mode: on" "Goggles mode: off"))) + +(def (goggles-flash-region! ed start len) + "Flash a region briefly using indicator 14." + (when *goggles-enabled* + (send-message ed SCI_INDICSETSTYLE 14 7) ;; INDIC_ROUNDBOX + (send-message ed SCI_INDICSETFORE 14 #x80FF80) + (send-message ed SCI_INDICSETALPHA 14 100) + (send-message ed SCI_SETINDICATORCURRENT 14 0) + (send-message ed SCI_INDICATORFILLRANGE start len))) + +;; --- Feature 7: Eros (eval result overlay) --- + +(def (cmd-eros-eval-last-sexp app) + "Evaluate last S-expression and display result inline." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + ;; Find matching paren backward + (match (send-message ed SCI_BRACEMATCH pos 0))) + ;; Fallback: grab text from previous line + (let* ((line (send-message ed SCI_LINEFROMPOSITION pos 0)) + (line-start (send-message ed SCI_POSITIONFROMLINE line 0)) + (text (editor-get-text ed)) + (line-text (substring text line-start pos))) + (let ((result + (with-catch + (lambda (e) + (string-append "Error: " (with-output-to-string (lambda () (display-condition e))))) + (lambda () + (let ((val (eval (read (open-input-string line-text))))) + (with-output-to-string (lambda () (write val)))))))) + ;; Display result after cursor position using calltip + (send-message ed SCI_CALLTIPSHOW pos (string->alien/nul (string-append " => " result))) + (echo-message! echo (string-append "=> " result)))))) + +;; --- Feature 8: TMR (timer management) --- + +(def *tmr-timers* '()) ;; list of (id name end-epoch callback-msg) +(def *tmr-next-id* 0) + +(def (cmd-tmr-new app) + "Create a new timer with name and duration." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (desc (echo-read-string echo "Timer description: " row width))) + (when (and desc (not (string-empty? desc))) + (let ((mins-str (echo-read-string echo "Duration (minutes): " row width))) + (when (and mins-str (not (string-empty? mins-str))) + (let ((mins (string->number (string-trim mins-str)))) + (when (and mins (> mins 0)) + (set! *tmr-next-id* (+ *tmr-next-id* 1)) + (let ((end (+ (time-second (current-time)) (* mins 60)))) + (set! *tmr-timers* + (cons (list *tmr-next-id* desc end) *tmr-timers*)) + (echo-message! echo + (string-append "Timer #" (number->string *tmr-next-id*) + ": " desc " (" (number->string mins) " min)")))))))))) + +(def (cmd-tmr-list app) + "List all active timers." + (let* ((echo (app-state-echo app)) + (now (time-second (current-time)))) + (if (null? *tmr-timers*) + (echo-message! echo "No timers") + (let* ((fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (lines + (map (lambda (t) + (let* ((id (car t)) (desc (cadr t)) (end (caddr t)) + (remaining (max 0 (- end now))) + (min (quotient remaining 60)) + (sec (remainder remaining 60))) + (string-append "#" (number->string id) " " + desc " " + (if (<= remaining 0) "DONE!" + (string-append (number->string min) ":" + (if (< sec 10) "0" "") (number->string sec)))))) + *tmr-timers*)) + (content (string-append "Timers\n" (make-string 40 #\-) "\n" + (string-join lines "\n"))) + (buf (make-buffer "*tmr*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0))))) + +(def (cmd-tmr-cancel app) + "Cancel a timer by ID." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (id-str (echo-read-string echo "Cancel timer #: " row width))) + (when (and id-str (not (string-empty? id-str))) + (let ((id (string->number (string-trim id-str)))) + (when id + (set! *tmr-timers* + (filter (lambda (t) (not (= (car t) id))) *tmr-timers*)) + (echo-message! echo (string-append "Timer #" (number->string id) " cancelled"))))))) + +;; --- Feature 9: Logos (page-based narrowing for focused reading/presentations) --- + +(def *logos-page-delimiter* "^\f\\|^\\*\\*\\* \\|^--- ") +(def *logos-active* #f) + +(def (cmd-logos-mode app) + "Toggle logos mode for page-based focused editing." + (set! *logos-active* (not *logos-active*)) + (echo-message! (app-state-echo app) + (if *logos-active* + "Logos mode: on (use logos-forward/backward to navigate pages)" + "Logos mode: off"))) + +(def (cmd-logos-forward app) + "Navigate to next page (form-feed or heading delimiter)." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (text (editor-get-text ed)) + (len (string-length text))) + ;; Search forward for form-feed (^L) + (let loop ((i (+ pos 1))) + (if (>= i len) + (echo-message! (app-state-echo app) "End of buffer") + (if (char=? (string-ref text i) #\page) + (begin + (editor-goto-pos ed (+ i 1)) + (pulse-line! ed)) + (loop (+ i 1))))))) + +(def (cmd-logos-backward app) + "Navigate to previous page." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (text (editor-get-text ed))) + (let loop ((i (- pos 2))) + (if (<= i 0) + (begin (editor-goto-pos ed 0) + (echo-message! (app-state-echo app) "Beginning of buffer")) + (if (char=? (string-ref text i) #\page) + (begin + (editor-goto-pos ed (+ i 1)) + (pulse-line! ed)) + (loop (- i 1))))))) + +;; --- Feature 10: Cursory (cursor appearance management) --- + +(def *cursory-presets* + '((bar . 1) ;; SCI_SETCARETSTYLE bar + (block . 2) ;; block + (underline . 3))) ;; underline (approximate via Scintilla) + +(def (cmd-cursory-set app) + "Set cursor style (bar, block, underline)." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (choices '("bar" "block" "underline")) + (choice (echo-read-string-with-completion echo "Cursor style: " choices row width))) + (when (and choice (not (string-empty? choice))) + (let ((style (cond + ((string=? choice "bar") 1) + ((string=? choice "block") 2) + ((string=? choice "underline") 3) + (else 1)))) + (let ((ed (edit-window-editor (current-window (app-state-frame app))))) + (send-message ed SCI_SETCARETSTYLE style 0) + (echo-message! echo (string-append "Cursor style: " choice))))))) + +(def (cmd-cursory-set-width app) + "Set cursor width." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (w-str (echo-read-string echo "Cursor width (1-4): " row width))) + (when (and w-str (not (string-empty? w-str))) + (let ((w (string->number (string-trim w-str)))) + (when (and w (>= w 1) (<= w 4)) + (let ((ed (edit-window-editor (current-window (app-state-frame app))))) + (send-message ed SCI_SETCARETWIDTH w 0) + (echo-message! echo (string-append "Cursor width: " (number->string w))))))))) --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1455,4 +1455,42 @@ (register-command! 'erc cmd-erc) (register-command! 'erc-send cmd-erc-send) (register-command! 'erc-set-nick cmd-erc-set-nick) + ;; Round 4 batch 1: git-timemachine, exec-path, goto-line-preview, nav-flash, pulsar, goggles, eros, tmr, logos, cursory + (register-command! 'git-timemachine cmd-git-timemachine) + (register-command! 'git-timemachine-next cmd-git-timemachine-next) + (register-command! 'git-timemachine-prev cmd-git-timemachine-prev) + (register-command! 'exec-path-from-shell cmd-exec-path-from-shell) + (register-command! 'goto-line-preview cmd-goto-line-preview) + (register-command! 'nav-flash-mode cmd-nav-flash-mode) + (register-command! 'pulsar-mode cmd-pulsar-mode) + (register-command! 'pulsar-pulse cmd-pulsar-pulse) + (register-command! 'goggles-mode cmd-goggles-mode) + (register-command! 'eros-eval-last-sexp cmd-eros-eval-last-sexp) + (register-command! 'tmr-new cmd-tmr-new) + (register-command! 'tmr-list cmd-tmr-list) + (register-command! 'tmr-cancel cmd-tmr-cancel) + (register-command! 'logos-mode cmd-logos-mode) + (register-command! 'logos-forward cmd-logos-forward) + (register-command! 'logos-backward cmd-logos-backward) + (register-command! 'cursory-set cmd-cursory-set) + (register-command! 'cursory-set-width cmd-cursory-set-width) + ;; Round 4 batch 2: doom-modeline, ts-fold, casual, spacious-padding, dape, burly, elp, fontaine, shr-render, auto-theme + (register-command! 'doom-modeline-mode cmd-doom-modeline-mode) + (register-command! 'ts-fold-toggle cmd-ts-fold-toggle) + (register-command! 'ts-fold-all cmd-ts-fold-all) + (register-command! 'ts-fold-unfold-all cmd-ts-fold-unfold-all) + (register-command! 'casual-buffer-menu cmd-casual-buffer-menu) + (register-command! 'casual-window-menu cmd-casual-window-menu) + (register-command! 'spacious-padding-mode cmd-spacious-padding-mode) + (register-command! 'dape cmd-dape) + (register-command! 'dape-breakpoint-toggle cmd-dape-breakpoint-toggle) + (register-command! 'dape-quit cmd-dape-quit) + (register-command! 'burly-bookmark-windows cmd-burly-bookmark-windows) + (register-command! 'burly-open-bookmark cmd-burly-open-bookmark) + (register-command! 'burly-list cmd-burly-list) + (register-command! 'elp-instrument cmd-elp-instrument) + (register-command! 'elp-results cmd-elp-results) + (register-command! 'fontaine-set-preset cmd-fontaine-set-preset) + (register-command! 'shr-render cmd-shr-render) + (register-command! 'auto-theme-switch cmd-auto-theme-switch) )