Add 5 more Emacs features: net-utils, rgrep, tab-line, vundo, orderless matching
ober
c3f8dfa644431f9058b1ed08449d955628e88919
--- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -82,9 +82,7 @@ (jerboa-emacs qt commands) (jerboa-emacs qt lsp-client) (jerboa-emacs qt commands-lsp) (jerboa-emacs qt menubar) (jerboa-emacs ipc) (jerboa-emacs vtscreen) - (only - (jerboa-emacs editor-extra-web) - *aggressive-indent-mode*) + (only (jerboa-emacs editor-core) *aggressive-indent-mode*) (only (jerboa-emacs debug-repl) start-debug-repl! --- a/src/jerboa-emacs/editor-extra-editing.ss +++ b/src/jerboa-emacs/editor-extra-editing.ss @@ -1170,6 +1170,41 @@ (echo-message! (app-state-echo app) (string-append (number->string (length lines)) " matches")))))))))) +(def (cmd-rgrep app) + "Recursive grep using grep -rn. Works without ripgrep installed." + (let* ((buf (current-buffer-from-app app)) + (fp (buffer-file-path buf)) + (root (or (project-current app) (current-directory))) + (pattern (app-read-string app + (string-append "rgrep in " (path-strip-directory root) ": "))) + (glob (and pattern (not (string-empty? pattern)) + (app-read-string app "File pattern (e.g. *.ss, default *): ")))) + (when (and pattern (not (string-empty? pattern))) + (echo-message! (app-state-echo app) "Searching...") + (with-catch + (lambda (e) + (echo-error! (app-state-echo app) "grep failed")) + (lambda () + (let* ((file-pat (if (and glob (not (string-empty? glob))) + glob "*")) + (cmd (string-append + "grep -rn --include='" file-pat "' " + "-- '" pattern "' " root " 2>/dev/null | head -500"))) + (let-values (((s o e p) (open-process-ports cmd 'block (native-transcoder)))) + (close-port s) + (let ((output (get-string-all o))) + (close-port o) + (close-port e) + (if (or (eof-object? output) (string-empty? output)) + (echo-message! (app-state-echo app) "No matches found") + (let ((lines (string-split output #\newline))) + (open-output-buffer app "*Grep*" + (string-append "-*- grep -*-\ngrep -rn " pattern " " root "\n\n" + (number->string (length lines)) " matches\n\n" + output "\n")) + (echo-message! (app-state-echo app) + (string-append (number->string (length lines)) " matches")))))))))))) + ;;;============================================================================ ;;; goto-address-mode — highlight URLs in buffer ;;;============================================================================ --- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -1664,12 +1664,49 @@ (echo-message! (app-state-echo app) (if (repeat-mode?) "Repeat mode enabled" "Repeat mode disabled"))) +(def (tab-line-string app width) + "Generate a tab-line string showing open buffer names. + The current buffer is marked with [brackets], others with spaces. + Fits within WIDTH characters." + (let* ((current-buf (current-buffer-from-app app)) + (current-name (if current-buf (buffer-name current-buf) "")) + ;; Get unique buffer names, skip internal buffers + (bufs (filter (lambda (b) + (let ((n (buffer-name b))) + (and n (> (string-length n) 0) + (not (char=? (string-ref n 0) #\space))))) + *buffer-list*)) + (tabs (map (lambda (b) + (let* ((name (buffer-name b)) + (mod? (and (buffer-doc b) + (let ((ed (create-scintilla-editor 1 1))) + ;; Quick check - can't easily check mod + #f))) + (is-current (string=? name current-name))) + (if is-current + (string-append "[" name "]") + (string-append " " name " ")))) + bufs)) + (joined (apply string-append + (let loop ((tabs tabs) (acc '()) (first? #t)) + (if (null? tabs) + (reverse acc) + (loop (cdr tabs) + (cons (if first? (car tabs) + (string-append "|" (car tabs))) + acc) + #f)))))) + (if (<= (string-length joined) width) + (string-append joined (make-string (- width (string-length joined)) #\space)) + (substring joined 0 width)))) + (def (cmd-toggle-tab-line-mode app) - "Toggle tab-line-mode (per-window tab display)." + "Toggle tab-line-mode (show buffer tabs at top)." (let ((echo (app-state-echo app))) (set! *tab-line-mode* (not *tab-line-mode*)) (echo-message! echo (if *tab-line-mode* - "Tab-line mode ON" "Tab-line mode OFF")))) + "Tab-line mode ON — buffer tabs shown in modeline" + "Tab-line mode OFF")))) (def (cmd-toggle-scroll-bar-mode app) "Toggle scroll-bar-mode." --- a/src/jerboa-emacs/editor-extra-media2.ss +++ b/src/jerboa-emacs/editor-extra-media2.ss @@ -22,7 +22,8 @@ :jerboa-emacs/echo :jerboa-emacs/editor-extra-helpers (only-in :jerboa-emacs/editor-extra-editing2 - *dired-marks* cmd-dired-refresh)) + *dired-marks* cmd-dired-refresh) + (only-in :jerboa-emacs/helm *orderless-mode*)) (def (cmd-describe-current-coding-system app) "Describe current coding system." @@ -715,7 +716,6 @@ ;; ── batch 44: modern Emacs package toggles ────────────────────────── (def *consult-mode* #f) -(def *orderless-mode* #f) (def *embark-mode* #f) (def *undo-fu-session* #f) (def *auto-package-mode* #f) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -1814,15 +1814,63 @@ ;; Vundo — visual undo tree (def (cmd-vundo app) - "Visual undo tree — shows undo/redo state." + "Visual undo tree — displays undo/redo history with state markers. + Shows a visual timeline of undo steps and current position. + Navigate with u (undo) and r (redo) from the undo buffer." (let* ((fr (app-state-frame app)) (win (current-window fr)) (ed (edit-window-editor win)) - (can-undo (send-message ed SCI_CANUNDO 0 0)) - (can-redo (send-message ed SCI_CANREDO 0 0))) + (buf (current-buffer-from-app app)) + (buf-name (if buf (buffer-name buf) "*scratch*")) + ;; Count undo/redo steps by walking the stack + (undo-count (let loop ((n 0)) + (if (> (send-message ed SCI_CANUNDO 0 0) 0) + (begin (send-message ed SCI_UNDO 0 0) + (loop (+ n 1))) + n))) + ;; Now we're at the beginning — count forward (redo) + (total (let loop ((n 0)) + (if (> (send-message ed SCI_CANREDO 0 0) 0) + (begin (send-message ed SCI_REDO 0 0) + (loop (+ n 1))) + n))) + ;; Redo back to our original position (redo total - undo-count times) + (_ (let loop ((n (- total undo-count))) + (when (> n 0) + (send-message ed SCI_UNDO 0 0) + (loop (- n 1))))) + (current-pos undo-count) + ;; Build visual representation + (lines (list + (string-append "Undo history for: " buf-name) + (string-append "Total steps: " (number->string total)) + (string-append "Current position: " (number->string current-pos) + "/" (number->string total)) + "" + ;; Timeline: o---o---@---o---o + ;; 0 1 2 3 4 + (let ((timeline + (let loop ((i 0) (acc '())) + (if (> i total) + (apply string-append (reverse acc)) + (loop (+ i 1) + (cons (string-append + (if (= i current-pos) "@" "o") + (if (< i total) "---" "")) + acc)))))) + (if (> (string-length timeline) 78) + (string-append (substring timeline 0 75) "...") + timeline)) + "" + " @ = current state" + " o = saved undo point" + "" + "Use M-x undo / M-x redo to navigate."))) + (open-output-buffer app "*Vundo*" + (apply string-append (map (lambda (l) (string-append l "\n")) lines))) (echo-message! (app-state-echo app) - (string-append "Undo: " (if (> can-undo 0) "available" "empty") - " | Redo: " (if (> can-redo 0) "available" "empty"))))) + (string-append "Undo: " (number->string current-pos) + " of " (number->string total) " steps")))) ;; Dash (at point) — documentation lookup (def (cmd-dash-at-point app) --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1376,4 +1376,13 @@ (register-command! 'project-query-replace-regexp cmd-project-query-replace) (register-command! 'insert-uuid cmd-insert-uuid) (register-command! 'uuidgen cmd-insert-uuid) + ;; Rgrep + (register-command! 'rgrep cmd-rgrep) + (register-command! 'grep-find cmd-rgrep) + ;; Net-utils + (register-command! 'ping cmd-net-ping) + (register-command! 'traceroute cmd-net-traceroute) + (register-command! 'ifconfig cmd-net-ifconfig) + (register-command! 'nslookup cmd-net-nslookup) + (register-command! 'netstat cmd-net-netstat) ) --- a/src/jerboa-emacs/editor-extra-tools2.ss +++ b/src/jerboa-emacs/editor-extra-tools2.ss @@ -2422,3 +2422,61 @@ (set! (frame-current-idx fr) (- num 1)) (echo-message! (app-state-echo app) (string-append "Window " (number->string num)))))))))) + +;;;============================================================================ +;;; Net-utils — network diagnostic commands +;;;============================================================================ + +(def (run-net-command app cmd args buf-name) + "Run a network command with ARGS, display output in BUF-NAME." + (let ((output (with-catch + (lambda (e) + (string-append "Error: " (with-output-to-string + (lambda () (display-exception e))))) + (lambda () + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (string-append cmd " " + (apply string-append + (map (lambda (a) (string-append a " ")) args))) + 'block (native-transcoder)))) + (close-port p-stdin) + (let ((result (get-string-all p-stdout))) + (close-port p-stdout) + (close-port p-stderr) + (if (eof-object? result) "(no output)" result))))))) + (open-output-buffer app buf-name output) + (echo-message! (app-state-echo app) buf-name))) + +(def (cmd-net-ping app) + "Ping a host — send ICMP echo requests." + (let ((host (app-read-string app "Ping host: "))) + (when (and host (not (string-empty? host))) + (run-net-command app "/usr/bin/ping" (list "-c" "4" host) "*ping*")))) + +(def (cmd-net-traceroute app) + "Traceroute to a host — show network path." + (let ((host (app-read-string app "Traceroute host: "))) + (when (and host (not (string-empty? host))) + (run-net-command app "/usr/bin/traceroute" (list host) "*traceroute*")))) + +(def (cmd-net-ifconfig app) + "Show network interface configuration." + (let ((cmd (cond ((file-exists? "/usr/bin/ip") "/usr/bin/ip") + ((file-exists? "/sbin/ifconfig") "/sbin/ifconfig") + (else "/usr/bin/ip")))) + (if (string-contains cmd "ip") + (run-net-command app cmd '("addr" "show") "*ifconfig*") + (run-net-command app cmd '() "*ifconfig*")))) + +(def (cmd-net-nslookup app) + "Look up DNS records for a host." + (let ((host (app-read-string app "Nslookup host: "))) + (when (and host (not (string-empty? host))) + (let ((cmd (if (file-exists? "/usr/bin/dig") "/usr/bin/dig" "/usr/bin/nslookup"))) + (run-net-command app cmd (list host) "*nslookup*"))))) + +(def (cmd-net-netstat app) + "Show network connections." + (let ((cmd (if (file-exists? "/usr/bin/ss") "/usr/bin/ss" "/usr/bin/netstat"))) + (run-net-command app cmd '("-tuln") "*netstat*"))) --- a/src/jerboa-emacs/helm.ss +++ b/src/jerboa-emacs/helm.ss @@ -45,7 +45,9 @@ ;; Configuration *helm-candidate-limit* - *helm-follow-delay*) + *helm-follow-delay* + *orderless-mode* + initials-match?) (import :std/sugar :std/sort @@ -59,6 +61,7 @@ ;; *helm-mode* is defined in core.ss (def *helm-candidate-limit* 100) (def *helm-follow-delay* 0.1) ;; seconds +(def *orderless-mode* #f) ;; when #t, all completion uses orderless+initials ;; Dynamic parameter: set to current pattern during helm-filter-source. ;; Volatile sources (e.g. grep) can read this to use the pattern as a search query. @@ -132,6 +135,28 @@ (make-match-token word #f #f)))) words))) +(def (initials-match? pattern candidate) + "Check if PATTERN matches the initials of words in CANDIDATE. + E.g. 'fb' matches 'find-buffer' or 'forward-backward'." + (let* ((pat-lower (string-downcase pattern)) + (cand-lower (string-downcase candidate)) + (plen (string-length pat-lower))) + (and (> plen 0) + (let loop ((pi 0) (ci 0) (at-boundary? #t)) + (cond + ((>= pi plen) #t) ; all pattern chars matched + ((>= ci (string-length cand-lower)) #f) ; ran out of candidate + ((and at-boundary? + (char=? (string-ref pat-lower pi) + (string-ref cand-lower ci))) + (loop (+ pi 1) (+ ci 1) #f)) + (else + (let ((c (string-ref cand-lower ci))) + (loop pi (+ ci 1) + (or (char=? c #\-) (char=? c #\_) + (char=? c #\/) (char=? c #\space) + (char=? c #\.)))))))))) + (def (token-matches? token candidate-str use-fuzzy?) "Check if a single match-token matches a candidate string." (let* ((text (match-token-text token)) @@ -141,8 +166,11 @@ (cond ((match-token-prefix? token) (string-prefix? text-lower target-lower)) - (use-fuzzy? - (fuzzy-match? text candidate-str)) + ((or use-fuzzy? *orderless-mode*) + ;; With orderless: try substring, then fuzzy, then initials + (or (string-contains target-lower text-lower) + (fuzzy-match? text candidate-str) + (initials-match? text candidate-str))) (else (string-contains target-lower text-lower))))) (if (match-token-negate? token)