Add Qt minibuffer history navigation
ober
67ad4ee85471f1d49d6394ff8119f2e8d0ee18f7
--- a/src/jerboa-emacs/qt/echo.ss +++ b/src/jerboa-emacs/qt/echo.ss @@ -11,6 +11,10 @@ qt-echo-read-file-with-narrowing qt-echo-read-with-narrowing qt-minibuffer-init! + qt-minibuffer-history-reset! + qt-minibuffer-history-record! + qt-minibuffer-history-select + qt-minibuffer-history-for *minibuffer-active?* *mb-input*) @@ -20,6 +24,7 @@ (only-in :std/srfi/13 string-contains string-suffix?) :jerboa-emacs/qt/sci-shim :jerboa-emacs/core + (only-in :jerboa-emacs/echo minibuffer-history-add!) :jerboa-emacs/async :jerboa-emacs/qt/window) @@ -72,6 +77,82 @@ (def *mb-file-narrowing?* #f) ; When #t, narrowing browses filesystem (def *mb-file-dir* "") ; Current directory for file narrowing (def *mb-user-selected?* #f) ; Whether user explicitly navigated the list +;; Prompt-scoped minibuffer history. M-p/M-n navigate the active prompt's +;; entries while accepted inputs are also recorded in the shared history. +(def *mb-history-table* (make-hash-table)) +(def *mb-history-key* "") +(def *mb-history-index* -1) +(def *mb-history-current-input* "") +(def *mb-history-limit* 100) + +(def (qt-minibuffer-history-for prompt) + (hash-ref *mb-history-table* prompt '())) + +(def (qt-minibuffer-history-reset! prompt) + (set! *mb-history-key* prompt) + (set! *mb-history-index* -1) + (set! *mb-history-current-input* "")) + +(def (qt-minibuffer-history-record! prompt input) + (when (and (string? input) (> (string-length input) 0)) + (minibuffer-history-add! input) + (let* ((old (qt-minibuffer-history-for prompt)) + (deduped (filter (lambda (item) (not (string=? item input))) old)) + (next (cons input deduped))) + (hash-put! *mb-history-table* prompt + (let loop ((items next) (n 0) (acc '())) + (if (or (null? items) (>= n *mb-history-limit*)) + (reverse acc) + (loop (cdr items) (+ n 1) (cons (car items) acc)))))))) + +(def (qt-minibuffer-history-select prompt current-input direction) + "Return the history entry selected by DIRECTION, or #f if unchanged. + DIRECTION -1 moves to older entries (M-p); 1 moves toward current input (M-n)." + (when (not (string=? *mb-history-key* prompt)) + (qt-minibuffer-history-reset! prompt)) + (let* ((history (qt-minibuffer-history-for prompt)) + (len (length history))) + (if (= len 0) + #f + (begin + (when (< *mb-history-index* 0) + (set! *mb-history-current-input* current-input)) + (cond + ((< direction 0) + (let ((next-index (min (- len 1) (+ *mb-history-index* 1)))) + (set! *mb-history-index* next-index) + (list-ref history next-index))) + ((> direction 0) + (cond + ((> *mb-history-index* 0) + (set! *mb-history-index* (- *mb-history-index* 1)) + (list-ref history *mb-history-index*)) + ((= *mb-history-index* 0) + (set! *mb-history-index* -1) + *mb-history-current-input*) + (else #f))) + (else #f)))))) + +(def (mb-history-apply! direction) + (let ((entry (qt-minibuffer-history-select + *mb-history-key* + (qt-line-edit-text *mb-input*) + direction))) + (when entry + (qt-line-edit-set-text! *mb-input* entry)))) + +(def (qt-minibuffer-result->text result) + (if (pair? result) + (if (null? result) #f + (let ((t (car result))) + (if (string=? t "") #f t))) + #f)) + +(def (qt-minibuffer-accept-result! prompt result) + (let ((text (qt-minibuffer-result->text result))) + (when text + (qt-minibuffer-history-record! prompt text)) + text)) (def (mb-style) "Generate minibuffer Qt stylesheet with current font settings." @@ -439,16 +520,23 @@ (if *mb-narrowing?* (narrowing-move-selection! 1) (mb-handle-tab! input))) - ;; C-n / Down = next candidate + ;; C-n / Down = next candidate in narrowing, or newer history otherwise. ((or (= key QT_KEY_DOWN) (and (= key QT_KEY_N) (= mods QT_MOD_CTRL))) - (when *mb-narrowing?* - (narrowing-move-selection! 1))) - ;; C-p / Up = previous candidate + (if *mb-narrowing?* + (narrowing-move-selection! 1) + (mb-history-apply! 1))) + ;; C-p / Up = previous candidate in narrowing, or older history otherwise. ((or (= key QT_KEY_UP) (and (= key QT_KEY_P) (= mods QT_MOD_CTRL))) - (when *mb-narrowing?* - (narrowing-move-selection! -1))) + (if *mb-narrowing?* + (narrowing-move-selection! -1) + (mb-history-apply! -1))) + ;; M-n / M-p always navigate minibuffer history. + ((and (= key QT_KEY_N) (not (zero? (bitwise-and mods QT_MOD_ALT)))) + (mb-history-apply! 1)) + ((and (= key QT_KEY_P) (not (zero? (bitwise-and mods QT_MOD_ALT)))) + (mb-history-apply! -1)) (else (void)))))) ;; Connect text-changed for real-time narrowing filter ;; qt-on-text-changed! dispatches via ffi_qt_callback_string which passes @@ -492,6 +580,7 @@ ;; Set up the minibuffer (qt-label-set-text! *mb-prompt* prompt) (qt-line-edit-set-text! *mb-input* "") + (qt-minibuffer-history-reset! prompt) ;; Remove any old completer (qt-line-edit-set-completer! *mb-input* #f) ;; Hide echo label, show minibuffer @@ -508,11 +597,7 @@ (thread-sleep! 0.01) (if *mb-result* ;; Done — extract result - (let ((text (if (pair? *mb-result*) - (if (null? *mb-result*) #f ; Escape → cancelled - (let ((t (car *mb-result*))) - (if (string=? t "") #f t))) - #f))) + (let ((text (qt-minibuffer-accept-result! prompt *mb-result*))) (set! *minibuffer-active?* #f) ;; Restore: hide minibuffer, show echo label, refocus editor (qt-widget-hide! *mb-container*) @@ -532,6 +617,7 @@ ;; Set up the minibuffer (qt-label-set-text! *mb-prompt* prompt) (qt-line-edit-set-text! *mb-input* "") + (qt-minibuffer-history-reset! prompt) ;; Store completions for Tab cycling (set! *mb-completions* completions) (set! *mb-tab-idx* 0) @@ -559,11 +645,7 @@ (thread-sleep! 0.01) (if *mb-result* ;; Done — extract result - (let ((text (if (pair? *mb-result*) - (if (null? *mb-result*) #f ; Escape → cancelled - (let ((t (car *mb-result*))) - (if (string=? t "") #f t))) - #f))) + (let ((text (qt-minibuffer-accept-result! prompt *mb-result*))) (set! *minibuffer-active?* #f) ;; Clean up completer and tab state (set! *mb-completions* []) @@ -589,6 +671,7 @@ ;; Set up the minibuffer (qt-label-set-text! *mb-prompt* prompt) (qt-line-edit-set-text! *mb-input* "") + (qt-minibuffer-history-reset! prompt) ;; Enable file-mode Tab completion (no static completions/QCompleter) (set! *mb-file-mode* #t) (set! *mb-completions* []) @@ -609,11 +692,7 @@ (thread-sleep! 0.01) (if *mb-result* ;; Done — extract result - (let ((text (if (pair? *mb-result*) - (if (null? *mb-result*) #f - (let ((t (car *mb-result*))) - (if (string=? t "") #f t))) - #f))) + (let ((text (qt-minibuffer-accept-result! prompt *mb-result*))) (set! *minibuffer-active?* #f) ;; Clean up file-mode state (set! *mb-file-mode* #f) @@ -641,6 +720,7 @@ (set! *mb-narrowing-prompt* prompt) (qt-label-set-text! *mb-prompt* prompt) (qt-line-edit-set-text! *mb-input* "") + (qt-minibuffer-history-reset! prompt) (qt-line-edit-set-completer! *mb-input* #f) ;; Set up narrowing state (set! *mb-narrowing?* #t) @@ -668,11 +748,7 @@ (thread-sleep! 0.01) (if *mb-result* ;; Done — extract result - (let ((text (if (pair? *mb-result*) - (if (null? *mb-result*) #f - (let ((t (car *mb-result*))) - (if (string=? t "") #f t))) - #f))) + (let ((text (qt-minibuffer-accept-result! prompt *mb-result*))) (set! *minibuffer-active?* #f) ;; Clean up narrowing state (set! *mb-narrowing?* #f) @@ -712,6 +788,7 @@ (set! *mb-all-candidates* []) ;; Pre-fill with default directory — triggers text-changed → file listing (qt-line-edit-set-text! *mb-input* default-dir) + (qt-minibuffer-history-reset! prompt) ;; Hide echo label, show narrowing list + minibuffer (qt-widget-hide! *mb-echo-label*) (qt-widget-show! *mb-list*) @@ -726,11 +803,7 @@ (master-timer-tick!) (thread-sleep! 0.01) (if *mb-result* - (let ((text (if (pair? *mb-result*) - (if (null? *mb-result*) #f - (let ((t (car *mb-result*))) - (if (string=? t "") #f t))) - #f))) + (let ((text (qt-minibuffer-accept-result! prompt *mb-result*))) (set! *minibuffer-active?* #f) ;; Clean up (set! *mb-narrowing?* #f) --- a/tests/test-qt-part2.ss +++ b/tests/test-qt-part2.ss @@ -18,6 +18,11 @@ (jerboa-emacs qt sci-shim) (jerboa-emacs qt window) (only (jerboa-emacs qt app) qt-call-with-key-handler-errors) + (only (jerboa-emacs qt echo) + qt-minibuffer-history-reset! + qt-minibuffer-history-record! + qt-minibuffer-history-select + qt-minibuffer-history-for) (jerboa-emacs qt commands) (only (jerboa-emacs qt commands-core) *so-long-threshold*) (only (jerboa-emacs qt commands-parity5) schedule-user-timer!) @@ -99,7 +104,7 @@ (loop (+ i 1) (cons (string-append "line " (number->string i) "\n") acc))))) -(display "\n=== Qt Part2 Groups 44-57 ===\n") +(display "\n=== Qt Part2 Groups 44-58 ===\n") (test-case "group44 qt key/mouse fidelity" (check (qt-key-event->string QT_KEY_RETURN 0 "") => "C-m") @@ -231,9 +236,22 @@ (check (echo-state-error? (app-state-echo app)) => #t) (check (echo-state-message (app-state-echo app)) => "Key handler error"))) +(test-case "group58 minibuffer history is prompt scoped" + (qt-minibuffer-history-record! "part2-58-a" "alpha") + (qt-minibuffer-history-record! "part2-58-a" "beta") + (qt-minibuffer-history-record! "part2-58-b" "omega") + (check (qt-minibuffer-history-for "part2-58-a") => '("beta" "alpha")) + (qt-minibuffer-history-reset! "part2-58-a") + (check (qt-minibuffer-history-select "part2-58-a" "draft" -1) => "beta") + (check (qt-minibuffer-history-select "part2-58-a" "draft" -1) => "alpha") + (check (qt-minibuffer-history-select "part2-58-a" "draft" 1) => "beta") + (check (qt-minibuffer-history-select "part2-58-a" "draft" 1) => "draft") + (qt-minibuffer-history-reset! "part2-58-b") + (check (qt-minibuffer-history-select "part2-58-b" "" -1) => "omega")) + (newline) (let ([total (+ *pass* *fail*)]) - (printf "Part2 results: ~a/~a tests passed (groups 44-57)~n" *pass* total) + (printf "Part2 results: ~a/~a tests passed (groups 44-58)~n" *pass* total) (when (> *fail* 0) (printf "FAILED: ~a test(s)~n" *fail*)) (when (= *fail* 0)