Preserve undo for Qt snippet expansion
ober
813380f0d68a493f4775579a69356b8ad4e56031
--- a/src/jerboa-emacs/qt/snippets.ss +++ b/src/jerboa-emacs/qt/snippets.ss @@ -8,6 +8,7 @@ :std/srfi/13 :jerboa-emacs/core :jerboa-emacs/snippets + :jerboa-scintilla/constants :jerboa-emacs/qt/sci-shim :jerboa-emacs/qt/buffer :jerboa-emacs/qt/window @@ -19,6 +20,12 @@ ;;; Qt snippet commands ;;; ============================================================================ +(def (qt-snippet-replace-range! ed start end text) + "Replace [START, END) with TEXT without resetting Scintilla undo history." + (sci-send ed SCI_SETTARGETSTART start) + (sci-send ed SCI_SETTARGETEND end) + (sci-send/string ed SCI_REPLACETARGET text -1)) + (def (cmd-snippet-expand app) "Try to expand snippet at point. Returns #t if expanded, #f otherwise." (let* ((ed (current-qt-editor app)) @@ -34,14 +41,8 @@ (text (car expanded)) (fields (cdr expanded)) (pos (qt-plain-text-edit-cursor-position ed)) - (trigger-start (- pos (string-length prefix))) - ;; Replace trigger with expanded text - (full-text (qt-plain-text-edit-text ed)) - (new-text (string-append - (substring full-text 0 trigger-start) - text - (substring full-text pos (string-length full-text))))) - (qt-plain-text-edit-set-text! ed new-text) + (trigger-start (- pos (string-length prefix)))) + (qt-snippet-replace-range! ed trigger-start pos text) (if (null? fields) ;; No fields — place cursor at end of expansion (qt-plain-text-edit-set-cursor-position! ed @@ -152,13 +153,8 @@ (text (car expanded)) (fields (cdr expanded)) (ed (current-qt-editor app)) - (pos (qt-plain-text-edit-cursor-position ed)) - (full-text (qt-plain-text-edit-text ed)) - (new-text (string-append - (substring full-text 0 pos) - text - (substring full-text pos (string-length full-text))))) - (qt-plain-text-edit-set-text! ed new-text) + (pos (qt-plain-text-edit-cursor-position ed))) + (qt-snippet-replace-range! ed pos pos text) (if (null? fields) (qt-plain-text-edit-set-cursor-position! ed (+ pos (string-length text))) (let ((first-field (car fields))) --- a/tests/test-qt-part2.ss +++ b/tests/test-qt-part2.ss @@ -14,6 +14,7 @@ (jerboa-emacs core) (jerboa-emacs buffer) (jerboa-emacs editor) + (jerboa-emacs snippets) (jerboa-emacs qt sci-shim) (jerboa-emacs qt window) (jerboa-emacs qt commands) @@ -91,7 +92,7 @@ (qt-plain-text-edit-set-text! ed "") (values ed w app))) -(display "\n=== Qt Part2 Groups 44-55 ===\n") +(display "\n=== Qt Part2 Groups 44-56 ===\n") (test-case "group44 qt key/mouse fidelity" (check (qt-key-event->string QT_KEY_RETURN 0 "") => "C-m") @@ -189,10 +190,20 @@ (unless (hash-get *so-long-buffers* (buffer-name buf)) (error 'group55 "so-long buffer flag was not set"))))) (lambda () (set! *so-long-threshold* old-threshold))))) +(test-case "group56 snippet expand preserves undo history" + (let-values (((ed w app) (make-qt-test-app "part2-56"))) + (qt-plain-text-edit-set-text! ed "say hr!") + (sci-send ed 2175) ;; SCI_EMPTYUNDOBUFFER + (sci-send ed SCI_GOTOPOS 6) + (execute-command! app 'snippet-expand) + (check (qt-plain-text-edit-text ed) => "say ---!") + (check (qt-plain-text-edit-can-undo? ed) => #t) + (qt-plain-text-edit-undo! ed) + (check (qt-plain-text-edit-text ed) => "say hr!"))) (newline) (let ([total (+ *pass* *fail*)]) - (printf "Part2 results: ~a/~a tests passed (groups 44-55)~n" *pass* total) + (printf "Part2 results: ~a/~a tests passed (groups 44-56)~n" *pass* total) (when (> *fail* 0) (printf "FAILED: ~a test(s)~n" *fail*)) (when (= *fail* 0)