Add 4 more Emacs features: marginalia, embark, perspective, diff-hl TUI
ober
270c14b8d8a2742dc339f29832cbe566caeb3573
--- a/src/jerboa-emacs/editor-extra-helpers.ss +++ b/src/jerboa-emacs/editor-extra-helpers.ss @@ -21,7 +21,8 @@ :jerboa-emacs/echo (only-in :jerboa-emacs/persist *copilot-mode* *copilot-api-key* *copilot-model* - *copilot-api-url* *copilot-suggestion* *copilot-suggestion-pos*)) + *copilot-api-url* *copilot-suggestion* *copilot-suggestion-pos*) + (only-in :jerboa-emacs/helm *helm-annotate-fn*)) ;;;============================================================================ ;;; Helpers @@ -1006,19 +1007,71 @@ "Register an annotator function for a completion CATEGORY." (hash-put! *marginalia-annotators* category annotator)) +;; Source name → annotator category mapping +(def *marginalia-source-categories* (make-hash-table)) +(hash-put! *marginalia-source-categories* "Commands" 'command) +(hash-put! *marginalia-source-categories* "Buffers" 'buffer) +(hash-put! *marginalia-source-categories* "Recent Files" 'file) + (marginalia-annotate! 'command - (lambda (name) - (let ((cmd (find-command (string->symbol name)))) - (if cmd " [command]" "")))) + (lambda (display-str) + ;; Extract command name (strip keybinding suffix if present) + (let* ((space-pos (string-contains display-str " (")) + (name (if space-pos (substring display-str 0 space-pos) display-str)) + (doc (command-doc (string->symbol name)))) + (if (and doc (> (string-length doc) 0)) + (string-append " " (if (> (string-length doc) 50) + (string-append (substring doc 0 47) "...") + doc)) + "")))) (marginalia-annotate! 'buffer - (lambda (name) - (let ((buf (buffer-by-name name))) + (lambda (display-str) + ;; Extract buffer name (before modifiers) + (let* ((space-pos (string-contains display-str " ")) + (name (if space-pos (substring display-str 0 space-pos) display-str)) + (buf (buffer-by-name name))) (if buf - (let ((file (buffer-file-path buf))) - (if file (string-append " " file) " [no file]")) + (let* ((size (string-length (or (buffer-text buf) ""))) + (size-str (cond ((> size 1048576) (string-append (number->string (quotient size 1048576)) "M")) + ((> size 1024) (string-append (number->string (quotient size 1024)) "K")) + (else (string-append (number->string size) "B"))))) + (string-append " " size-str)) "")))) +(marginalia-annotate! 'file + (lambda (display-str) + ;; Show file extension as type hint + (let* ((dot-pos (let loop ((i (- (string-length display-str) 1))) + (cond ((< i 0) #f) + ((char=? (string-ref display-str i) #\.) i) + ((char=? (string-ref display-str i) #\/) #f) + (else (loop (- i 1)))))) + (ext (if dot-pos + (substring display-str (+ dot-pos 1) (string-length display-str)) + #f))) + (if ext (string-append " [" ext "]") "")))) + +(def (marginalia-helm-annotator source-name display-str) + "Helm annotation hook: look up category for source, apply annotator." + (let ((category (hash-get *marginalia-source-categories* source-name))) + (if category + (let ((annotator (hash-get *marginalia-annotators* category))) + (if annotator + (with-exception-catcher + (lambda (e) "") + (lambda () (annotator display-str))) + "")) + ""))) + +(def (marginalia-enable!) + "Enable marginalia annotations in helm." + (set! *helm-annotate-fn* marginalia-helm-annotator)) + +(def (marginalia-disable!) + "Disable marginalia annotations in helm." + (set! *helm-annotate-fn* #f)) + ;;;============================================================================ ;;; Embark action registry (used by cmd-embark-act in editor-extra-modes.ss) ;;;============================================================================ --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -1365,6 +1365,7 @@ (def (cmd-marginalia-mode app) "Toggle marginalia annotations — show extra info with completions." (let ((on (toggle-mode! 'marginalia))) + (if on (marginalia-enable!) (marginalia-disable!)) (echo-message! (app-state-echo app) (if on "Marginalia: on" "Marginalia: off")))) ;;; Embark target detection — shared between embark-act and embark-dwim @@ -1591,12 +1592,36 @@ "Describe key — delegates to describe-key." (execute-command! app 'describe-key)) -;; Diff-hl — delegates to git-gutter +;; Diff-hl — real TUI git-gutter integration (def (cmd-diff-hl-mode app) - "Toggle diff-hl mode — shows VCS changes in margin." - (let ((on (toggle-mode! 'diff-hl))) - (when on (git-gutter-refresh! app)) - (echo-message! (app-state-echo app) (if on "Diff-hl: on" "Diff-hl: off")))) + "Toggle diff-hl mode — shows VCS changes in margin using Scintilla markers." + (let* ((fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (buf (edit-window-buffer win)) + (file-path (and buf (buffer-file-path buf))) + (buf-name (and buf (buffer-name buf))) + (echo (app-state-echo app))) + (if (not file-path) + (echo-error! echo "Buffer has no file for diff-hl") + (if *tui-git-gutter-active* + ;; Turn off + (begin + (tui-git-gutter-clear-markers! ed) + (send-message ed SCI_SETMARGINWIDTHN *tui-gutter-margin-num* 0) + (set! *tui-git-gutter-active* #f) + (toggle-mode! 'diff-hl) + (echo-message! echo "Diff-hl OFF")) + ;; Turn on + (begin + (toggle-mode! 'diff-hl) + (git-gutter-refresh! app) + (let ((hunks (or (hash-get *git-gutter-hunks* buf-name) '()))) + (tui-git-gutter-setup-margin! ed) + (tui-git-gutter-apply-markers! ed hunks) + (set! *tui-git-gutter-active* #t) + (echo-message! echo + (string-append "Diff-hl ON: " (number->string (length hunks)) " hunk(s)")))))))) ;; Wgrep — editable grep results (def *wgrep-original-lines* '()) @@ -1757,6 +1782,36 @@ (echo-message! (app-state-echo app) (string-append "Removed " name " from " *current-perspective*)))))) +(def (cmd-persp-list app) + "List all perspectives with buffer counts." + (let* ((echo (app-state-echo app)) + (names (hash-keys *perspectives*)) + (lines (map (lambda (name) + (let* ((bufs (or (hash-get *perspectives* name) '())) + (marker (if (string=? name *current-perspective*) " *" ""))) + (string-append name marker " (" (number->string (length bufs)) " buffers)"))) + names))) + (if (null? lines) + (echo-message! echo (string-append "Current: " *current-perspective* " (no saved perspectives)")) + (open-output-buffer app "*Perspectives*" + (string-append "Perspectives:\n\n" + (string-join lines "\n") "\n\nCurrent: " *current-perspective* "\n"))))) + +(def (cmd-persp-kill app) + "Kill a named perspective." + (let* ((echo (app-state-echo app)) + (names (hash-keys *perspectives*)) + (name (app-read-string app "Kill perspective: "))) + (when (and name (not (string-empty? name))) + (cond + ((string=? name *current-perspective*) + (echo-error! echo "Cannot kill active perspective")) + ((hash-key? *perspectives* name) + (hash-remove! *perspectives* name) + (echo-message! echo (string-append "Killed perspective: " name))) + (else + (echo-error! echo (string-append "No perspective: " name))))))) + ;; Popper — popup management (def (cmd-popper-toggle-latest app) "Toggle latest popup — switch to/from last special buffer." --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1385,4 +1385,7 @@ (register-command! 'ifconfig cmd-net-ifconfig) (register-command! 'nslookup cmd-net-nslookup) (register-command! 'netstat cmd-net-netstat) + ;; Perspective management + (register-command! 'persp-list cmd-persp-list) + (register-command! 'persp-kill cmd-persp-kill) ) --- a/src/jerboa-emacs/helm.ss +++ b/src/jerboa-emacs/helm.ss @@ -47,7 +47,10 @@ *helm-candidate-limit* *helm-follow-delay* *orderless-mode* - initials-match?) + initials-match? + + ;; Annotation hook (for marginalia) + *helm-annotate-fn*) (import :std/sugar :std/sort @@ -67,6 +70,11 @@ ;; Volatile sources (e.g. grep) can read this to use the pattern as a search query. (def *helm-current-pattern* (make-parameter "")) +;; Annotation hook for marginalia: (or (-> source-name display-str string) #f) +;; When set, appends annotation suffix to candidate display strings. +;; Higher-level code (editor-extra-helpers) sets this based on marginalia-mode. +(def *helm-annotate-fn* #f) + ;;;============================================================================ ;;; Data structures ;;;============================================================================ @@ -244,7 +252,10 @@ (real-fn (helm-source-real-fn source)) (use-fuzzy? (helm-source-fuzzy? source)) (limit (or (helm-source-candidate-limit source) *helm-candidate-limit*))) - (let* ((scored + (let* ((src-name (helm-source-name source)) + (annotate (and *helm-annotate-fn* + (lambda (s) (*helm-annotate-fn* src-name s)))) + (scored (filter-map (lambda (raw) (let* ((display-str (if display-fn (display-fn raw) raw)) @@ -253,7 +264,11 @@ 0 (helm-multi-match pattern display-str use-fuzzy?)))) (and (>= score 0) - (cons score (make-helm-candidate display-str real-val source))))) + (cons score (make-helm-candidate + (if annotate + (string-append display-str (annotate display-str)) + display-str) + real-val source))))) raw-candidates)) (sorted (if (string=? pattern "") scored ;; preserve original order when no pattern