Enable Qt so-long detection
ober
c0ea2b02870406d1df88311c41309d21f5c6cb15
--- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -2323,7 +2323,7 @@ (let* ((fr (app-state-frame app)) (buf (qt-current-buffer fr)) (state (and buf (ts-buffer-state buf)))) - (when state + (when (and state (not (hash-get *so-long-buffers* (buffer-name buf)))) (let ((ed (qt-current-editor fr))) (when ed (let* ((text (qt-plain-text-edit-text ed)) --- a/src/jerboa-emacs/qt/commands-core.ss +++ b/src/jerboa-emacs/qt/commands-core.ss @@ -345,6 +345,39 @@ (def *file-mtimes* (make-hash-table)) ; file-path -> mtime (seconds) (def *auto-revert-tail-buffers* (make-hash-table)) ; buffer-name -> #t for tail-follow mode +;;; ======================================================================== +;;; So-long mode - disable expensive features for long-line files +;;; ======================================================================== + +(def *so-long-threshold* 10000) ; characters per line +(def *so-long-buffers* (make-hash-table)) ; buffer-name -> #t + +(def (enable-so-long! app buf) + "Mark BUF as so-long and report it. Returns #t." + (let ((name (buffer-name buf))) + (hash-put! *so-long-buffers* name #t) + (echo-message! (app-state-echo app) + (string-append name ": long lines detected (so-long-mode enabled)")) + #t)) + +(def (check-so-long! app buf text) + "Check if text has very long lines and enable so-long mode if needed. Returns #t when active." + (let ((name (buffer-name buf)) + (len (string-length text))) + (if (hash-get *so-long-buffers* name) + #t + (let loop ((i 0) (line-start 0)) + (cond + ((>= i len) + (if (> (- len line-start) *so-long-threshold*) + (enable-so-long! app buf) + #f)) + ((char=? (string-ref text i) #\newline) + (if (> (- i line-start) *so-long-threshold*) + (enable-so-long! app buf) + (loop (+ i 1) (+ i 1)))) + (else (loop (+ i 1) line-start))))))) + (def (file-mtime path) "Get file modification time as seconds, or #f if file doesn't exist." (with-catch @@ -1203,6 +1236,7 @@ Returns (path . line) or #f. Handles file:line format." (when text (qt-plain-text-edit-set-text! ed text) (qt-text-document-set-modified! (buffer-doc-pointer buf) #f) + (check-so-long! app buf text) (qt-plain-text-edit-set-cursor-position! ed 0) (file-mtime-record! path) (echo-message! echo (string-append "Reverted " path)))) --- a/src/jerboa-emacs/qt/commands-shell.ss +++ b/src/jerboa-emacs/qt/commands-shell.ss @@ -419,27 +419,9 @@ SPC = page down, DEL = page up, q = quit view-mode." ;;; ======================================================================== ;;; So-long mode — disable expensive features for long-line files +;;; Shared state and long-line detection live in commands-core.ss. ;;; ======================================================================== -(def *so-long-threshold* 10000) ; characters per line -(def *so-long-buffers* (make-hash-table)) ; buffer-name -> #t - -(def (check-so-long! app buf text) - "Check if text has very long lines and enable so-long mode if needed." - (let ((name (buffer-name buf))) - (unless (hash-get *so-long-buffers* name) - (let loop ((i 0) (line-start 0)) - (cond - ((>= i (string-length text)) #f) - ((char=? (string-ref text i) #\newline) - (if (> (- i line-start) *so-long-threshold*) - (begin - (hash-put! *so-long-buffers* name #t) - (echo-message! (app-state-echo app) - (string-append name ": long lines detected (so-long-mode enabled)"))) - (loop (+ i 1) (+ i 1)))) - (else (loop (+ i 1) line-start))))))) - (def (cmd-so-long-mode app) "Toggle so-long-mode which disables expensive features for long-line files." (let* ((buf (current-qt-buffer app)) --- a/src/jerboa-emacs/qt/commands.ss +++ b/src/jerboa-emacs/qt/commands.ss @@ -472,6 +472,7 @@ (hash-put! *buffer-eol-cache* name (detect-eol-from-text text)) (qt-plain-text-edit-set-text! ed text) (qt-text-document-set-modified! (buffer-doc-pointer buf) #f) + (check-so-long! app buf text) (let ((saved-pos (and *save-place-enabled* (save-place-restore filename)))) (if (and saved-pos (< saved-pos (string-length text))) @@ -480,8 +481,11 @@ (qt-plain-text-edit-set-text! ed (string-append "[Binary file: " filename "]")))) (file-mtime-record! filename)) - (verbose-log! "find-file: highlighting") - (qt-setup-highlighting! app buf) + (if (hash-get *so-long-buffers* name) + (verbose-log! "find-file: so-long skip highlighting") + (begin + (verbose-log! "find-file: highlighting") + (qt-setup-highlighting! app buf))) (verbose-log! "find-file: dir-locals") (apply-dir-locals! app filename) (verbose-log! "find-file: editorconfig") --- a/tests/test-qt-part2.ss +++ b/tests/test-qt-part2.ss @@ -17,6 +17,7 @@ (jerboa-emacs qt sci-shim) (jerboa-emacs qt window) (jerboa-emacs qt commands) + (only (jerboa-emacs qt commands-core) *so-long-threshold*) (only (jerboa-emacs qt commands-parity5) schedule-user-timer!) (only (jerboa-emacs async) master-timer-tick!) (jerboa-emacs qt keymap) @@ -35,7 +36,8 @@ (display (string-append " error: " (if (message-condition? e) (condition-message e) - (format "~s" e)) + (with-output-to-string + (lambda () (display-condition e)))) "\n")) (flush-output-port (current-output-port)) #f) @@ -58,12 +60,12 @@ (let ([got expr] [exp expected]) (unless (equal? got exp) (error 'check - (format "~a: expected ~s, got ~s" *test-name* exp got))))] + (format "~a: expected ~a, got ~a" *test-name* exp got))))] [(_ expr ? pred) (let ([got expr]) (unless (pred got) (error 'check - (format "~a: predicate failed for ~s" *test-name* got))))])) + (format "~a: predicate failed for ~a" *test-name* got))))])) (unless (getenv "QT_QPA_PLATFORM") (setenv "QT_QPA_PLATFORM" "offscreen")) @@ -89,7 +91,7 @@ (qt-plain-text-edit-set-text! ed "") (values ed w app))) -(display "\n=== Qt Part2 Groups 44-54 ===\n") +(display "\n=== Qt Part2 Groups 44-55 ===\n") (test-case "group44 qt key fidelity" (check (qt-key-event->string QT_KEY_RETURN 0 "") => "C-m") @@ -158,9 +160,26 @@ (master-timer-tick!) (check (sci-send ed SCI_GETCURRENTPOS) => 1))) + +(test-case "group55 so-long detects long final line" + (let ((old-threshold *so-long-threshold*)) + (dynamic-wind + (lambda () (set! *so-long-threshold* 3)) + (lambda () + (let-values (((ed w app) (make-qt-test-app "part2-55"))) + (let* ((fr (app-state-frame app)) + (buf (qt-edit-window-buffer (qt-current-window fr))) + (text "xxxxx")) + (hash-remove! *so-long-buffers* (buffer-name buf)) + (unless (check-so-long! app buf text) + (error 'group55 "check-so-long! returned false")) + (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))))) + (newline) (let ([total (+ *pass* *fail*)]) - (printf "Part2 results: ~a/~a tests passed (groups 44-54)~n" *pass* total) + (printf "Part2 results: ~a/~a tests passed (groups 44-55)~n" *pass* total) (when (> *fail* 0) (printf "FAILED: ~a test(s)~n" *fail*)) (when (= *fail* 0)