Add 20 Emacs features round 3: calc, re-builder, compile, view-mode, keyfreq, pomidor, define-word, chronos, mwim, electric-spacing, ace-link, copy-as-format, dictionary, man, profiler, cua-rect, comment-dwim-2, translate, flymake, erc
ober
c9edfe90c217c421a35772f4c2c1591ff7d4f8b3
--- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -2808,3 +2808,440 @@ (echo-message! (app-state-echo app) (string-append "Appended " (number->string (- end start)) " chars to " path))))))) +;;;============================================================================ +;;; Round 3 batch 1: Features 1-10 +;;;============================================================================ + +;; --- Feature 1: Quick Calc (inline calculator) --- + +(def (cmd-quick-calc app) + "Evaluate a simple math expression and display/insert result." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (expr (echo-read-string echo "Quick calc: " row width))) + (when (and expr (not (string-empty? expr))) + (let ((result + (with-catch + (lambda (e) (string-append "Error: " (with-output-to-string (lambda () (display-condition e))))) + (lambda () + ;; Simple expression evaluator: support +, -, *, /, ^, sqrt, abs + (let ((val (eval (read (open-input-string expr))))) + (if (number? val) + (number->string val) + (with-output-to-string (lambda () (display val))))))))) + (echo-message! echo (string-append "Result: " result)))))) + +(def (cmd-calc-insert app) + "Evaluate math expression and insert result at point." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (expr (echo-read-string echo "Calc (insert): " row width))) + (when (and expr (not (string-empty? expr))) + (let ((result + (with-catch + (lambda (e) #f) + (lambda () + (let ((val (eval (read (open-input-string expr))))) + (if (number? val) (number->string val) #f)))))) + (if result + (let ((ed (edit-window-editor (current-window (app-state-frame app))))) + (send-message ed SCI_REPLACESEL 0 (string->alien/nul result)) + (echo-message! echo (string-append "Inserted: " result))) + (echo-error! echo "Invalid expression")))))) + +;; --- Feature 2: RE-Builder (interactive regex builder) --- + +(def *re-builder-active* #f) + +(def (cmd-re-builder app) + "Interactive regex builder — test regex against current buffer." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (regex (echo-read-string echo "RE-Builder regex: " row width))) + (when (and regex (not (string-empty? regex))) + ;; Use indicator 13 for regex matches + (send-message ed SCI_INDICSETSTYLE 13 7) ;; INDIC_ROUNDBOX + (send-message ed SCI_INDICSETFORE 13 #x00FFFF) ;; cyan + (send-message ed SCI_INDICSETALPHA 13 60) + (send-message ed SCI_SETINDICATORCURRENT 13 0) + ;; Clear previous highlights + (send-message ed SCI_INDICATORCLEARRANGE 0 + (send-message ed SCI_GETLENGTH 0 0)) + ;; Search for all matches + (let* ((text-len (send-message ed SCI_GETLENGTH 0 0)) + (count 0)) + (send-message ed SCI_SETTARGETSTART 0 0) + (send-message ed SCI_SETTARGETEND text-len 0) + (send-message ed SCI_SETSEARCHFLAGS #x00200000 0) ;; SCFIND_REGEXP + (let loop () + (let ((found (send-message ed SCI_SEARCHINTARGET (string-length regex) + (string->alien/nul regex)))) + (when (>= found 0) + (let ((match-end (send-message ed SCI_GETTARGETEND 0 0))) + (when (> match-end found) + (send-message ed SCI_INDICATORFILLRANGE found (- match-end found)) + (set! count (+ count 1)) + (send-message ed SCI_SETTARGETSTART match-end 0) + (send-message ed SCI_SETTARGETEND text-len 0) + (loop)))))) + (echo-message! echo + (string-append "RE-Builder: " (number->string count) " matches for /" regex "/")))))) + +(def (cmd-re-builder-clear app) + "Clear RE-Builder highlights." + (let ((ed (edit-window-editor (current-window (app-state-frame app))))) + (send-message ed SCI_SETINDICATORCURRENT 13 0) + (send-message ed SCI_INDICATORCLEARRANGE 0 + (send-message ed SCI_GETLENGTH 0 0)) + (echo-message! (app-state-echo app) "RE-Builder cleared"))) + +;; --- Feature 3: Compilation Mode --- +;; Run make/compile command and parse error output + +(def *compilation-buffer-name* "*compilation*") +(def *compilation-errors* '()) + +(def (cmd-compile app) + "Run a compilation command (default: make) and show output." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (cmd (or (echo-read-string echo "Compile command: " row width) "make"))) + (when (and cmd (not (string-empty? cmd))) + (echo-message! echo (string-append "Compiling: " cmd "...")) + (let* ((fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (buf (make-buffer *compilation-buffer-name*))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports (string-append cmd " 2>&1") 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((lines '()) (errors '())) + (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"))) + (editor-set-text ed (string-append "Compilation: " cmd "\n" + (make-string 50 #\-) "\n" + content "\n" + (make-string 50 #\-) "\n" + "Compilation finished with " + (number->string (length errors)) + " error(s)")) + (editor-goto-pos ed 0) + (set! *compilation-errors* (reverse errors)) + (echo-message! echo + (string-append "Compilation done: " (number->string (length errors)) " error(s)")))) + ;; Parse error lines (file:line: pattern) + (let* ((is-error (and (string-contains line ":") + (or (string-contains line "error") + (string-contains line "warning")))) + (new-errors (if is-error (cons line errors) errors))) + (loop (cons line lines) new-errors)))))))))) + +(def (cmd-next-error app) + "Jump to next compilation error." + (let ((echo (app-state-echo app))) + (if (null? *compilation-errors*) + (echo-message! echo "No compilation errors") + (let* ((err-line (car *compilation-errors*)) + (colon1 (string-contains err-line ":")) + (file (if colon1 (substring err-line 0 colon1) #f))) + (set! *compilation-errors* (cdr *compilation-errors*)) + (if file + (echo-message! echo (string-append "Error in: " err-line)) + (echo-message! echo err-line)))))) + +;; --- Feature 4: View Mode (read-only viewing) --- + +(def *view-mode-active* #f) + +(def (cmd-view-mode app) + "Toggle view-mode — make buffer read-only with navigation keys." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app))))) + (set! *view-mode-active* (not *view-mode-active*)) + (send-message ed SCI_SETREADONLY (if *view-mode-active* 1 0) 0) + (echo-message! echo + (if *view-mode-active* + "View mode: on (read-only, q to quit)" + "View mode: off")))) + +(def (cmd-view-file app) + "Open a file in view-mode (read-only)." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (path (echo-read-string echo "View file: " row width))) + (when (and path (not (string-empty? path))) + (if (not (file-exists? path)) + (echo-error! echo (string-append "File not found: " path)) + (let* ((fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (content (with-catch + (lambda (e) "") + (lambda () (read-file-string path)))) + (buf (make-buffer (string-append "[view] " (path-strip-directory path))))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (send-message ed SCI_SETREADONLY 1 0) + (set! *view-mode-active* #t) + (echo-message! echo (string-append "Viewing: " path " (read-only)"))))))) + +;; --- Feature 5: Keyfreq (command frequency tracking) --- + +(def *keyfreq-table* (make-hash-table)) +(def *keyfreq-enabled* #f) + +(def (keyfreq-record! cmd-name) + "Record a command invocation." + (when *keyfreq-enabled* + (let ((count (hash-ref *keyfreq-table* cmd-name 0))) + (hash-put! *keyfreq-table* cmd-name (+ count 1))))) + +(def (cmd-keyfreq-mode app) + "Toggle command frequency tracking." + (set! *keyfreq-enabled* (not *keyfreq-enabled*)) + (echo-message! (app-state-echo app) + (if *keyfreq-enabled* "Keyfreq mode: on" "Keyfreq mode: off"))) + +(def (cmd-keyfreq-show app) + "Display command frequency report." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (pairs (hash->list *keyfreq-table*))) + (if (null? pairs) + (echo-message! echo "No command frequency data") + (let* ((sorted (sort (lambda (a b) (> (cdr a) (cdr b))) pairs)) + (lines (map + (lambda (p) + (let* ((name (symbol->string (car p))) + (count (number->string (cdr p))) + (pad (make-string (max 0 (- 40 (string-length name))) #\space))) + (string-append " " name pad count))) + (if (> (length sorted) 50) (list-head sorted 50) sorted))) + (content (string-append "Command Frequency Report\n" + (make-string 50 #\=) "\n" + (string-join lines "\n") "\n" + (make-string 50 #\=) "\n" + "Total unique commands: " (number->string (length pairs)))) + (buf (make-buffer "*keyfreq*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0))))) + +;; --- Feature 6: Pomidor (Pomodoro timer) --- + +(def *pomidor-work-minutes* 25) +(def *pomidor-break-minutes* 5) +(def *pomidor-start-time* #f) +(def *pomidor-state* 'idle) ;; idle, work, break +(def *pomidor-count* 0) + +(def (cmd-pomidor app) + "Start a pomodoro work session." + (let ((echo (app-state-echo app))) + (set! *pomidor-state* 'work) + (set! *pomidor-start-time* (time-second (current-time))) + (set! *pomidor-count* (+ *pomidor-count* 1)) + (echo-message! echo + (string-append "Pomodoro #" (number->string *pomidor-count*) + " started (" (number->string *pomidor-work-minutes*) " min work session)")))) + +(def (cmd-pomidor-break app) + "Start a pomodoro break." + (let ((echo (app-state-echo app))) + (set! *pomidor-state* 'break) + (set! *pomidor-start-time* (time-second (current-time))) + (echo-message! echo + (string-append "Break started (" (number->string *pomidor-break-minutes*) " min)")))) + +(def (cmd-pomidor-status app) + "Show current pomodoro timer status." + (let ((echo (app-state-echo app))) + (case *pomidor-state* + ((idle) (echo-message! echo "Pomidor: idle (no active timer)")) + ((work break) + (let* ((elapsed (- (time-second (current-time)) *pomidor-start-time*)) + (total (if (eq? *pomidor-state* 'work) + (* *pomidor-work-minutes* 60) + (* *pomidor-break-minutes* 60))) + (remaining (max 0 (- total elapsed))) + (min-left (quotient remaining 60)) + (sec-left (remainder remaining 60))) + (echo-message! echo + (string-append "Pomidor [" (symbol->string *pomidor-state*) "]: " + (number->string min-left) ":" + (if (< sec-left 10) "0" "") (number->string sec-left) + " remaining (session #" (number->string *pomidor-count*) ")"))))))) + +(def (cmd-pomidor-stop app) + "Stop the pomodoro timer." + (set! *pomidor-state* 'idle) + (set! *pomidor-start-time* #f) + (echo-message! (app-state-echo app) "Pomidor stopped")) + +;; --- Feature 7: Define Word (dictionary lookup via dict protocol) --- + +(def (cmd-define-word app) + "Look up word definition using /usr/bin/dict or online." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + ;; Try to get word at point first + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (word-start (send-message ed SCI_WORDSTARTPOSITION pos 1)) + (word-end (send-message ed SCI_WORDENDPOSITION pos 1)) + (word-len (- word-end word-start)) + (default-word + (if (> word-len 0) + (let* ((buf (make-bytevector (+ word-len 1) 0)) + (_ (send-message ed SCI_GETTEXTRANGE 0 + (cons->alien word-start (bytevector->alien buf))))) + (alien/nul->string (bytevector->alien buf))) + "")) + (word (echo-read-string echo + (if (string-empty? default-word) + "Define word: " + (string-append "Define word [" default-word "]: ")) + row width))) + (let ((lookup-word (if (or (not word) (string-empty? word)) default-word word))) + (when (and lookup-word (not (string-empty? lookup-word))) + (let ((cmd (if (file-exists? "/usr/bin/dict") + (string-append "/usr/bin/dict \"" lookup-word "\"") + (string-append "/usr/bin/curl -s 'dict://dict.org/d:" lookup-word "'")))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports (string-append cmd " 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 (if (null? lines) + (string-append "No definition found for: " lookup-word) + (string-join (reverse lines) "\n"))) + (buf (make-buffer "*definition*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (string-append "Definition: " lookup-word)))) + (loop (cons line lines))))))))))) + +;; --- Feature 8: Chronos (countdown timer) --- + +(def *chronos-timers* '()) ;; list of (name . end-epoch) + +(def (cmd-chronos-add app) + "Add a countdown timer." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (name (echo-read-string echo "Timer name: " row width))) + (when (and name (not (string-empty? name))) + (let ((minutes-str (echo-read-string echo "Minutes: " row width))) + (when (and minutes-str (not (string-empty? minutes-str))) + (let ((minutes (string->number (string-trim minutes-str)))) + (when (and minutes (> minutes 0)) + (let ((end-time (+ (time-second (current-time)) (* minutes 60)))) + (set! *chronos-timers* + (cons (cons name end-time) *chronos-timers*)) + (echo-message! echo + (string-append "Timer '" name "' set for " + (number->string minutes) " minutes")))))))))) + +(def (cmd-chronos-list app) + "Show all active countdown timers." + (let* ((echo (app-state-echo app)) + (now (time-second (current-time)))) + (if (null? *chronos-timers*) + (echo-message! echo "No active timers") + (let* ((lines + (map (lambda (timer) + (let* ((name (car timer)) + (end (cdr timer)) + (remaining (max 0 (- end now))) + (min (quotient remaining 60)) + (sec (remainder remaining 60))) + (string-append name ": " + (if (<= remaining 0) + "DONE!" + (string-append (number->string min) ":" + (if (< sec 10) "0" "") (number->string sec)))))) + *chronos-timers*)) + (content (string-join lines "\n"))) + (echo-message! echo (string-append "Timers: " content)))))) + +(def (cmd-chronos-clear app) + "Clear all timers." + (set! *chronos-timers* '()) + (echo-message! (app-state-echo app) "All timers cleared")) + +;; --- Feature 9: MWIM (Move Where I Mean — smart beginning/end of line) --- + +(def (cmd-mwim-beginning app) + "Smart beginning-of-line: toggle between indentation and column 0." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (line (send-message ed SCI_LINEFROMPOSITION pos 0)) + (line-start (send-message ed SCI_POSITIONFROMLINE line 0)) + (indent-pos (send-message ed SCI_GETLINEINDENTPOSITION line 0))) + ;; If at indentation, go to column 0; otherwise go to indentation + (if (= pos indent-pos) + (editor-goto-pos ed line-start) + (editor-goto-pos ed indent-pos)))) + +(def (cmd-mwim-end app) + "Smart end-of-line: toggle between last non-whitespace and end." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (line (send-message ed SCI_LINEFROMPOSITION pos 0)) + (line-end (send-message ed SCI_GETLINEENDPOSITION line 0)) + (text (editor-get-text ed)) + (line-start (send-message ed SCI_POSITIONFROMLINE line 0)) + (line-text (substring text line-start line-end)) + (trimmed (string-trim-right line-text)) + (last-nonws (+ line-start (string-length trimmed)))) + ;; If at last non-whitespace, go to true end; otherwise go to last non-ws + (if (= pos last-nonws) + (editor-goto-pos ed line-end) + (editor-goto-pos ed last-nonws)))) + +;; --- Feature 10: Electric Spacing (auto-space around operators) --- + +(def *electric-spacing-enabled* #f) +(def *electric-spacing-operators* '("=" "+" "-" "*" "/" "<" ">" "!" "&" "|")) + +(def (cmd-electric-spacing-mode app) + "Toggle electric-spacing mode — auto-insert spaces around operators." + (set! *electric-spacing-enabled* (not *electric-spacing-enabled*)) + (echo-message! (app-state-echo app) + (if *electric-spacing-enabled* + "Electric spacing mode: on" + "Electric spacing mode: off"))) + +(def (electric-spacing-maybe-apply! ed ch) + "If electric-spacing is on and ch is an operator, add spaces." + (when *electric-spacing-enabled* + (let ((op (string ch))) + (when (member op *electric-spacing-operators*) + ;; Check preceding char + (let* ((pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (prev-ch (if (> pos 0) (send-message ed SCI_GETCHARAT (- pos 1) 0) 0))) + ;; Don't double-space + (when (not (= prev-ch 32)) ;; not already a space + (send-message ed SCI_INSERTTEXT pos (string->alien/nul " ")))))))) --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1416,4 +1416,43 @@ (register-command! 'proced cmd-proced) (register-command! 'proced-sort-by-cpu cmd-proced-sort-by-cpu) (register-command! 'proced-sort-by-memory cmd-proced-sort-by-memory) + ;; Round 3: quick-calc, re-builder, compile, view-mode, keyfreq, pomidor, define-word, chronos, mwim, electric-spacing + (register-command! 'quick-calc cmd-quick-calc) + (register-command! 'calc-insert cmd-calc-insert) + (register-command! 're-builder cmd-re-builder) + (register-command! 're-builder-clear cmd-re-builder-clear) + (register-command! 'compile cmd-compile) + (register-command! 'next-error cmd-next-error) + (register-command! 'view-mode cmd-view-mode) + (register-command! 'view-file cmd-view-file) + (register-command! 'keyfreq-mode cmd-keyfreq-mode) + (register-command! 'keyfreq-show cmd-keyfreq-show) + (register-command! 'pomidor cmd-pomidor) + (register-command! 'pomidor-break cmd-pomidor-break) + (register-command! 'pomidor-status cmd-pomidor-status) + (register-command! 'pomidor-stop cmd-pomidor-stop) + (register-command! 'define-word cmd-define-word) + (register-command! 'chronos-add cmd-chronos-add) + (register-command! 'chronos-list cmd-chronos-list) + (register-command! 'chronos-clear cmd-chronos-clear) + (register-command! 'mwim-beginning cmd-mwim-beginning) + (register-command! 'mwim-end cmd-mwim-end) + (register-command! 'electric-spacing-mode cmd-electric-spacing-mode) + ;; Round 3 batch 2: ace-link, copy-as-format, dictionary, man, profiler, cua-rect, comment-dwim-2, translate, flymake, erc + (register-command! 'ace-link cmd-ace-link) + (register-command! 'copy-as-format cmd-copy-as-format) + (register-command! 'dictionary-search cmd-dictionary-search) + (register-command! 'man cmd-man) + (register-command! 'profiler-start cmd-profiler-start) + (register-command! 'profiler-stop cmd-profiler-stop) + (register-command! 'cua-rectangle-mark cmd-cua-rectangle-mark) + (register-command! 'cua-rectangle-insert cmd-cua-rectangle-insert) + (register-command! 'comment-dwim-2 cmd-comment-dwim-2) + (register-command! 'translate cmd-translate) + (register-command! 'flymake-mode cmd-flymake-mode) + (register-command! 'flymake-show-diagnostics cmd-flymake-show-diagnostics) + (register-command! 'flymake-next-error cmd-flymake-next-error) + (register-command! 'erc cmd-erc) + (register-command! 'erc-send cmd-erc-send) + (register-command! 'erc-set-nick cmd-erc-set-nick) ) --- a/src/jerboa-emacs/editor-extra-tools2.ss +++ b/src/jerboa-emacs/editor-extra-tools2.ss @@ -2539,3 +2539,438 @@ "Show network connections." (let ((cmd (if (file-exists? "/usr/bin/ss") "/usr/bin/ss" "/usr/bin/netstat"))) (run-net-command app cmd '("-tuln") "*netstat*"))) + +;;;============================================================================ +;;; Round 3 batch 2: Features 11-20 +;;;============================================================================ + +;; --- Feature 11: Ace-link (jump to links in buffer) --- + +(def (cmd-ace-link app) + "Find and jump to URLs in the current buffer." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (text (editor-get-text ed)) + (len (string-length text))) + ;; Simple URL finder: http://, https://, file:// + (let loop ((i 0) (urls '())) + (if (>= i (- len 8)) + (if (null? urls) + (echo-message! echo "No links found in buffer") + (let* ((entries (map (lambda (u) + (let ((pos (car u)) (url (cdr u))) + (string-append (number->string pos) ": " + (if (> (string-length url) 60) + (string-append (substring url 0 60) "...") + url)))) + (reverse urls))) + (row (tui-rows)) (width (tui-cols)) + (choice (echo-read-string-with-completion echo "Jump to link: " entries row width))) + (when (and choice (not (string-empty? choice))) + (let ((pos-str (let ((c (string-contains choice ":"))) + (if c (substring choice 0 c) choice)))) + (let ((pos (string->number (string-trim pos-str)))) + (when pos (editor-goto-pos ed pos))))))) + (if (or (string-prefix? "http://" (substring text i (min len (+ i 7)))) + (string-prefix? "https://" (substring text i (min len (+ i 8)))) + (string-prefix? "file://" (substring text i (min len (+ i 7))))) + ;; Found a URL start, extract it + (let url-loop ((j i)) + (if (or (>= j len) + (memv (string-ref text j) '(#\space #\newline #\tab #\) #\] #\> #\"))) + (loop (+ j 1) (cons (cons i (substring text i j)) urls)) + (url-loop (+ j 1)))) + (loop (+ i 1) urls)))))) + +;; --- Feature 12: Copy As Format --- + +(def (cmd-copy-as-format app) + "Copy selected region as formatted text (with line numbers)." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (sel-start (send-message ed SCI_GETSELECTIONSTART 0 0)) + (sel-end (send-message ed SCI_GETSELECTIONEND 0 0))) + (if (= sel-start sel-end) + (echo-error! echo "No selection") + (let* ((text (editor-get-text ed)) + (region (substring text sel-start sel-end)) + (start-line (send-message ed SCI_LINEFROMPOSITION sel-start 0)) + (lines (string-split region #\newline)) + (numbered + (let loop ((ls lines) (n (+ start-line 1)) (acc '())) + (if (null? ls) + (reverse acc) + (loop (cdr ls) (+ n 1) + (cons (string-append + (let ((s (number->string n))) + (string-append (make-string (max 0 (- 4 (string-length s))) #\space) s)) + " | " (car ls)) + acc))))) + (formatted (string-join numbered "\n"))) + ;; Put on kill ring + (set! (app-state-kill-ring app) + (cons formatted (app-state-kill-ring app))) + (echo-message! echo + (string-append "Copied " (number->string (length lines)) + " lines with line numbers to kill ring")))))) + +;; --- Feature 13: Dictionary Search --- + +(def (cmd-dictionary-search app) + "Search for a word in the system dictionary (/usr/share/dict/words)." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (pattern (echo-read-string echo "Dictionary search: " row width))) + (when (and pattern (not (string-empty? pattern))) + (let* ((dict-file "/usr/share/dict/words") + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (if (not (file-exists? dict-file)) + (echo-error! echo "Dictionary not found: /usr/share/dict/words") + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (string-append "/usr/bin/grep -i \"" pattern "\" " dict-file " | head -100") + '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 (string-append "No matches for: " pattern)) + (let* ((content (string-append "Dictionary matches for \"" pattern "\"\n" + (make-string 40 #\-) "\n" + (string-join (reverse lines) "\n"))) + (buf (make-buffer "*dictionary*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo + (string-append (number->string (length lines)) " matches found"))))) + (loop (cons line lines))))))))))) + +;; --- Feature 14: Man Page Viewer --- + +(def (cmd-man app) + "Display a Unix man page." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (topic (echo-read-string echo "Man page: " row width))) + (when (and topic (not (string-empty? topic))) + (let* ((fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (string-append "MANWIDTH=80 /usr/bin/man " topic " 2>&1 | col -bx") + '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-error! echo (string-append "No man page for: " topic)) + (let* ((content (string-join (reverse lines) "\n")) + (buf (make-buffer (string-append "*man " topic "*")))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (send-message ed SCI_SETREADONLY 1 0) + (echo-message! echo (string-append "Man: " topic))))) + (loop (cons line lines)))))))))) + +;; --- Feature 15: Simple Profiler --- + +(def *profiler-data* (make-hash-table)) +(def *profiler-enabled* #f) + +(def (cmd-profiler-start app) + "Start command profiling." + (set! *profiler-enabled* #t) + (set! *profiler-data* (make-hash-table)) + (echo-message! (app-state-echo app) "Profiler started")) + +(def (cmd-profiler-stop app) + "Stop profiling and show report." + (set! *profiler-enabled* #f) + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (pairs (hash->list *profiler-data*))) + (if (null? pairs) + (echo-message! echo "No profiling data") + (let* ((sorted (sort (lambda (a b) (> (cdr a) (cdr b))) pairs)) + (lines (map + (lambda (p) + (let* ((name (symbol->string (car p))) + (count (number->string (cdr p))) + (pad (make-string (max 0 (- 40 (string-length name))) #\space))) + (string-append " " name pad count " calls"))) + (if (> (length sorted) 50) (list-head sorted 50) sorted))) + (content (string-append "Profiler Report\n" + (make-string 50 #\=) "\n" + (string-join lines "\n") "\n")) + (buf (make-buffer "*profiler*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0))))) + +(def (profiler-record! cmd-name) + "Record command for profiling." + (when *profiler-enabled* + (let ((count (hash-ref *profiler-data* cmd-name 0))) + (hash-put! *profiler-data* cmd-name (+ count 1))))) + +;; --- Feature 16: CUA Rectangle --- + +(def *cua-rect-active* #f) + +(def (cmd-cua-rectangle-mark app) + "Toggle CUA rectangular selection mode." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app))))) + (set! *cua-rect-active* (not *cua-rect-active*)) + (if *cua-rect-active* + (begin + (send-message ed SCI_SETSELECTIONMODE 1 0) ;; SC_SEL_RECTANGLE + (echo-message! echo "CUA rectangle mode: on")) + (begin + (send-message ed SCI_SETSELECTIONMODE 0 0) ;; SC_SEL_STREAM + (echo-message! echo "CUA rectangle mode: off"))))) + +(def (cmd-cua-rectangle-insert app) + "Insert text into each line of a rectangular selection." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (row (tui-rows)) (width (tui-cols)) + (text (echo-read-string echo "Insert text in rectangle: " row width))) + (when (and text (not (string-empty? text))) + (let* ((sel-start (send-message ed SCI_GETSELECTIONSTART 0 0)) + (sel-end (send-message ed SCI_GETSELECTIONEND 0 0)) + (start-line (send-message ed SCI_LINEFROMPOSITION sel-start 0)) + (end-line (send-message ed SCI_LINEFROMPOSITION sel-end 0)) + (col (send-message ed SCI_GETCOLUMN sel-start 0))) + (send-message ed SCI_BEGINUNDOACTION 0 0) + (let loop ((line end-line)) + (when (>= line start-line) + (let ((pos (send-message ed SCI_FINDCOLUMN line col 0))) + (send-message ed SCI_INSERTTEXT pos (string->alien/nul text)) + (loop (- line 1))))) + (send-message ed SCI_ENDUNDOACTION 0 0) + (echo-message! echo "Rectangle text inserted"))))) + +;; --- Feature 17: Comment DWIM 2 --- + +(def (cmd-comment-dwim-2 app) + "Smart comment: toggle line comment, or comment region if active." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (sel-start (send-message ed SCI_GETSELECTIONSTART 0 0)) + (sel-end (send-message ed SCI_GETSELECTIONEND 0 0)) + ;; Detect comment style from file extension + (buf (current-buffer-from-app app)) + (path (and buf (buffer-file-path buf))) + (ext (if path (path-extension path) "")) + (comment-str + (cond + ((member ext '("ss" "scm" "el" "lisp" "clj")) ";; ") + ((member ext '("py" "rb" "sh" "bash" "yml" "yaml" "toml")) "# ") + ((member ext '("js" "ts" "jsx" "tsx" "java" "c" "cpp" "go" "rs" "swift" "kt")) "// ") + ((member ext '("html" "xml" "svg")) "<!-- ") + ((member ext '("css" "scss")) "/* ") + ((member ext '("sql")) "-- ") + ((member ext '("lua")) "-- ") + ((member ext '("hs")) "-- ") + (else ";; ")))) + (if (= sel-start sel-end) + ;; No selection: toggle current line comment + (let* ((line (send-message ed SCI_LINEFROMPOSITION sel-start 0)) + (line-start (send-message ed SCI_POSITIONFROMLINE line 0)) + (line-end (send-message ed SCI_GETLINEENDPOSITION line 0)) + (text (editor-get-text ed)) + (line-text (substring text line-start line-end)) + (trimmed (string-trim line-text))) + (send-message ed SCI_BEGINUNDOACTION 0 0) + (if (string-prefix? comment-str trimmed) + ;; Uncomment + (let* ((comment-pos (string-contains line-text comment-str)) + (abs-pos (+ line-start comment-pos))) + (send-message ed SCI_SETTARGETSTART abs-pos 0) + (send-message ed SCI_SETTARGETEND (+ abs-pos (string-length comment-str)) 0) + (send-message ed SCI_REPLACETARGET 0 (string->alien/nul ""))) + ;; Comment + (let ((indent-pos (send-message ed SCI_GETLINEINDENTPOSITION line 0))) + (send-message ed SCI_INSERTTEXT indent-pos (string->alien/nul comment-str)))) + (send-message ed SCI_ENDUNDOACTION 0 0)) + ;; Selection: comment/uncomment each line in region + (let* ((start-line (send-message ed SCI_LINEFROMPOSITION sel-start 0)) + (end-line (send-message ed SCI_LINEFROMPOSITION sel-end 0))) + (send-message ed SCI_BEGINUNDOACTION 0 0) + (let loop ((line start-line)) + (when (<= line end-line) + (let* ((line-start (send-message ed SCI_POSITIONFROMLINE line 0)) + (indent-pos (send-message ed SCI_GETLINEINDENTPOSITION line 0)) + (line-end (send-message ed SCI_GETLINEENDPOSITION line 0)) + (text (editor-get-text ed)) + (line-text (substring text line-start line-end)) + (trimmed (string-trim line-text))) + (if (string-prefix? comment-str trimmed) + ;; Uncomment + (let ((comment-pos (string-contains line-text comment-str))) + (when comment-pos + (let ((abs-pos (+ line-start comment-pos))) + (send-message ed SCI_SETTARGETSTART abs-pos 0) + (send-message ed SCI_SETTARGETEND (+ abs-pos (string-length comment-str)) 0) + (send-message ed SCI_REPLACETARGET 0 (string->alien/nul ""))))) + ;; Comment + (send-message ed SCI_INSERTTEXT indent-pos (string->alien/nul comment-str)))) + (loop (+ line 1)))) + (send-message ed SCI_ENDUNDOACTION 0 0))) + (echo-message! echo "Comment toggled"))) + +;; --- Feature 18: Translate (text translation via external tool) --- + +(def (cmd-translate app) + "Translate selected text or prompted text using translate-shell." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (row (tui-rows)) (width (tui-cols)) + (sel-start (send-message ed SCI_GETSELECTIONSTART 0 0)) + (sel-end (send-message ed SCI_GETSELECTIONEND 0 0)) + (text-to-translate + (if (not (= sel-start sel-end)) + (let* ((full (editor-get-text ed))) + (substring full sel-start sel-end)) + (echo-read-string echo "Translate text: " row width))) + (target-lang (echo-read-string echo "Target language (e.g. es, fr, de, ja): " row width))) + (when (and text-to-translate (not (string-empty? text-to-translate)) + target-lang (not (string-empty? target-lang))) + ;; Use translate-shell if available, otherwise show error + (let ((cmd (string-append "trans -brief :" target-lang " \"" + (let replace-quotes ((s text-to-translate) (i 0) (acc '())) + (cond ((>= i (string-length s)) (list->string (reverse acc))) + ((char=? (string-ref s i) #\") + (replace-quotes s (+ i 1) (cons #\' acc))) + ((char=? (string-ref s i) #\newline) + (replace-quotes s (+ i 1) (cons #\space acc))) + (else (replace-quotes s (+ i 1) (cons (string-ref s i) acc))))) + "\""))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports (string-append cmd " 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 ((result (if (null? lines) "Translation failed" + (string-join (reverse lines) "\n")))) + (echo-message! echo (string-append "Translation: " result)))) + (loop (cons line lines)))))))))) + +;; --- Feature 19: Flymake Mode (on-the-fly syntax checking) --- + +(def *flymake-enabled* #f) +(def *flymake-errors* '()) +(def *flymake-timer* 0) +(def *flymake-interval* 40) ;; ~2 seconds at 50ms tick + +(def (cmd-flymake-mode app) + "Toggle flymake — on-the-fly syntax checking." + (set! *flymake-enabled* (not *flymake-enabled*)) + (when (not *flymake-enabled*) + (set! *flymake-errors* '())) + (echo-message! (app-state-echo app) + (if *flymake-enabled* "Flymake mode: on" "Flymake mode: off"))) + +(def (cmd-flymake-show-diagnostics app) + "Show current flymake diagnostics." + (let ((echo (app-state-echo app))) + (if (null? *flymake-errors*) + (echo-message! echo "No flymake errors") + (let* ((fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (content (string-append "Flymake Diagnostics\n" + (make-string 50 #\-) "\n" + (string-join *flymake-errors* "\n"))) + (buf (make-buffer "*flymake*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0))))) + +(def (cmd-flymake-next-error app) + "Go to next flymake error." + (let ((echo (app-state-echo app))) + (if (null? *flymake-errors*) + (echo-message! echo "No flymake errors") + (echo-message! echo (string-append "Error: " (car *flymake-errors*)))))) + +;; --- Feature 20: ERC-style IRC Display --- + +(def *erc-nick* "jemacs-user") +(def *erc-channel* "#emacs") +(def *erc-log* '()) + +(def (cmd-erc app) + "Open an IRC-style chat display buffer." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (buf (make-buffer (string-append "*erc:" *erc-channel* "*"))) + (header (string-append "ERC - " *erc-channel* " [" *erc-nick* "]\n" + (make-string 50 #\-) "\n" + " (This is a display-only IRC buffer placeholder)\n" + " Use M-x erc-send to type messages\n" + (make-string 50 #\-) "\n"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed header) + (editor-goto-pos ed (string-length header)) + (echo-message! echo (string-append "ERC: " *erc-channel*)))) + +(def (cmd-erc-send app) + "Send a message in the ERC buffer." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (msg (echo-read-string echo (string-append *erc-channel* "> ") row width))) + (when (and msg (not (string-empty? msg))) + (let* ((timestamp (let* ((now (current-time)) + (d (time-utc->date now 0)) + (h (date-hour d)) + (m (date-minute d))) + (string-append + (if (< h 10) "0" "") (number->string h) ":" + (if (< m 10) "0" "") (number->string m)))) + (line (string-append "[" timestamp "] <" *erc-nick* "> " msg)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (end-pos (send-message ed SCI_GETLENGTH 0 0))) + (set! *erc-log* (cons line *erc-log*)) + (send-message ed SCI_APPENDTEXT (string-length (string-append "\n" line)) + (string->alien/nul (string-append "\n" line))) + (editor-goto-pos ed (send-message ed SCI_GETLENGTH 0 0)) + (echo-message! echo "Message sent"))))) + +(def (cmd-erc-set-nick app) + "Set ERC nickname." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (nick (echo-read-string echo "Nickname: " row width))) + (when (and nick (not (string-empty? nick))) + (set! *erc-nick* nick) + (echo-message! echo (string-append "Nick set to: " nick)))))