Make Qt helm occur results jumpable
ober
46aa625c13daf8c8999040cd9c34bd33d66aba2b
--- a/src/jerboa-emacs/qt/commands-edit2.ss +++ b/src/jerboa-emacs/qt/commands-edit2.ss @@ -774,6 +774,11 @@ ;; Occur state: remember source buffer for jumping (def *occur-source-buffer* #f) ; buffer name that occur was run on +(def (occur-source-buffer-set! source) + "Remember SOURCE as the buffer used by occur-style result buffers." + (set! *occur-source-buffer* + (if (string? source) source (buffer-name source)))) + (def (cmd-occur app) (let* ((echo (app-state-echo app)) (source-buf (current-qt-buffer app)) @@ -796,7 +801,7 @@ "\" in " (buffer-name source-buf) "\n\n" (string-join matches "\n") "\n\nPress Enter on a line to jump to it.")))) - (set! *occur-source-buffer* (buffer-name source-buf)) + (occur-source-buffer-set! source-buf) (let* ((fr (app-state-frame app)) (buf (or (buffer-by-name "*Occur*") (qt-buffer-create! "*Occur*" ed #f)))) --- a/src/jerboa-emacs/qt/helm-commands.ss +++ b/src/jerboa-emacs/qt/helm-commands.ss @@ -7,6 +7,7 @@ (export qt-register-helm-commands! + helm-occur-match-lines cmd-helm-occur) (import :std/sugar @@ -19,28 +20,53 @@ :jerboa-emacs/qt/echo :jerboa-emacs/editor (only-in :jerboa-emacs/qt/commands-core current-qt-editor current-qt-buffer - cmd-helm-buffers-list)) + cmd-helm-buffers-list) + (only-in :jerboa-emacs/qt/commands-edit2 occur-source-buffer-set!)) ;;;============================================================================ ;;; Qt Helm Occur ;;;============================================================================ +(def (helm-occur-match-lines text pattern) + "Return occur-compatible numbered lines in TEXT that contain PATTERN." + (let ((lines (string-split text #\newline))) + (let loop ((rest lines) (line-num 1) (acc [])) + (cond + ((null? rest) (reverse acc)) + ((string-contains (car rest) pattern) + (loop (cdr rest) (+ line-num 1) + (cons (string-append (number->string line-num) ": " (car rest)) acc))) + (else + (loop (cdr rest) (+ line-num 1) acc)))))) + (def (cmd-helm-occur app) "Search lines in current buffer with Qt helm narrowing." (let* ((echo (app-state-echo app)) (ed (current-qt-editor app)) + (source-buf (current-qt-buffer app)) (pattern (qt-echo-read-string app "Helm occur pattern: "))) (when (and pattern (> (string-length pattern) 0)) (let* ((text (qt-plain-text-edit-text ed)) - (lines (string-split text #\newline)) - (matches (filter (lambda (l) (string-contains l pattern)) lines))) + (matches (helm-occur-match-lines text pattern))) (if (null? matches) (echo-message! echo "No matches") - (let ((buf (qt-buffer-create! "*Helm Occur*" ed))) + (let* ((fr (app-state-frame app)) + (buf (or (buffer-by-name "*Occur*") + (qt-buffer-create! "*Occur*" ed #f)))) + (occur-source-buffer-set! source-buf) (qt-buffer-attach! ed buf) + (set! (qt-edit-window-buffer (qt-current-window fr)) buf) + (sci-send ed SCI_SETREADONLY 0 0) (qt-plain-text-edit-set-text! ed - (string-append "Helm Occur: " pattern "\n\n" - (string-join matches "\n") "\n")))))))) + (string-append "Helm Occur: " (number->string (length matches)) + " matches for \"" pattern "\" in " + (buffer-name source-buf) + "\n\n" + (string-join matches "\n") + "\n\nPress Enter on a line to jump to it.")) + (qt-text-document-set-modified! (buffer-doc-pointer buf) #f) + (qt-plain-text-edit-set-cursor-position! ed 0) + (sci-send ed SCI_SETREADONLY 1 0))))))) ;;;============================================================================ ;;; Command registration --- a/tests/test-qt.ss +++ b/tests/test-qt.ss @@ -33,6 +33,8 @@ (jerboa-emacs qt commands) (jerboa-emacs qt lsp-client) (only (jerboa-emacs qt commands-core) *winner-history* *winner-future*) + (only (jerboa-emacs qt commands-edit2) occur-source-buffer-set!) + (only (jerboa-emacs qt helm-commands) helm-occur-match-lines) (jerboa-emacs qt magit) (jerboa-emacs qt modeline) (jerboa-emacs qt image) @@ -1985,6 +1987,30 @@ (test-case "toggle-helm-mode registered" (check (find-command 'toggle-helm-mode) ? values)) + (test-case "helm-occur formats jumpable line matches" + (check (helm-occur-match-lines "alpha\nneedle one\nbeta\nneedle two" "needle") + => '("2: needle one" "4: needle two"))) + + (test-case "helm-occur result jumps to source line" + (let-values (((ed w app) (make-qt-test-app "helm-occur-source.ss"))) + (qt-plain-text-edit-set-text! ed "alpha\nneedle one\nbeta\nneedle two\n") + (let* ((fr (app-state-frame app)) + (source (qt-edit-window-buffer (qt-current-window fr))) + (occur-buf (qt-buffer-create! "*Occur*" ed #f))) + (buffer-list-add! source) + (occur-source-buffer-set! source) + (qt-buffer-attach! ed occur-buf) + (qt-edit-window-buffer-set! (qt-current-window fr) occur-buf) + (qt-plain-text-edit-set-text! ed + "Helm Occur: 2 matches for \"needle\"\n\n2: needle one\n4: needle two\n") + (qt-plain-text-edit-set-cursor-position! ed + (or (string-contains (qt-plain-text-edit-text ed) "4: needle") 0)) + (execute-command! app 'occur-goto) + (check (qt-edit-window-buffer (qt-current-window fr)) => source) + (check (sci-send ed SCI_LINEFROMPOSITION + (qt-plain-text-edit-cursor-position ed)) + => 3)))) + ;; Test: Multi-match engine (test-case "helm multi-match engine" (check (helm-multi-match? "foo bar" "foobar baz") ? values)