Trace dired post-command refresh
ober
4f538bf4720d3f08273731c29e386930b4261cec
--- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -762,6 +762,49 @@ (display msg (current-error-port)) (display "\n" (current-error-port)) (flush-output-port (current-error-port))) + (def (qt-ui-trace msg) + (display "TRACE qt-ui: " (current-error-port)) + (display msg (current-error-port)) + (display "\n" (current-error-port)) + (flush-output-port (current-error-port))) + (def (qt-refresh-after-key! app echo-label origin) + (let* ([fr (app-state-frame app)] + [trace? (eq? (buffer-lexer-lang (qt-current-buffer fr)) + 'dired)]) + (when trace? + (qt-ui-trace (string-append origin " refresh begin"))) + (when trace? + (qt-ui-trace (string-append origin " visual begin"))) + (qt-update-visual-decorations! (qt-current-editor fr)) + (when trace? + (qt-ui-trace (string-append origin " visual done"))) + (when trace? + (qt-ui-trace (string-append origin " mark begin"))) + (qt-update-mark-selection! app) + (when trace? + (qt-ui-trace (string-append origin " mark done"))) + (when trace? + (qt-ui-trace (string-append origin " modeline begin"))) + (qt-modeline-update! app) + (when trace? + (qt-ui-trace (string-append origin " modeline done"))) + (when trace? + (qt-ui-trace (string-append origin " tabbar begin"))) + (qt-tabbar-update! app) + (when trace? + (qt-ui-trace (string-append origin " tabbar done"))) + (when trace? + (qt-ui-trace (string-append origin " title begin"))) + (qt-update-frame-title! app) + (when trace? + (qt-ui-trace (string-append origin " title done"))) + (when trace? + (qt-ui-trace (string-append origin " echo draw begin"))) + (qt-echo-draw! (app-state-echo app) echo-label) + (when trace? + (qt-ui-trace (string-append origin " echo draw done"))) + (when trace? + (qt-ui-trace (string-append origin " refresh done"))))) (def (qt-do-init! qt-app args) (qt-startup-trace "enter") (init-jemacs-log!) (init-verbose-log!) (qt-startup-trace "logs ready") @@ -1644,22 +1687,10 @@ " is undefined"))] [(ignore) (void)]))) - (qt-update-visual-decorations! - (qt-current-editor - (app-state-frame - app))) - (qt-update-mark-selection! - app) - (qt-modeline-update! - app) - (qt-tabbar-update! - app) - (qt-update-frame-title! - app) - (qt-echo-draw! - (app-state-echo - app) - echo-label)))))))]) + (qt-refresh-after-key! + app + echo-label + "key")))))))]) (let* ([qt-buf (qt-current-buffer (app-state-frame app))] [qt-term (and qt-buf @@ -1881,22 +1912,10 @@ (execute-command! app chord-cmd) - (qt-update-visual-decorations! - (qt-current-editor - (app-state-frame - app))) - (qt-update-mark-selection! - app) - (qt-modeline-update! - app) - (qt-tabbar-update! - app) - (qt-update-frame-title! - app) - (qt-echo-draw! - (app-state-echo - app) - echo-label)) + (qt-refresh-after-key! + app + echo-label + "chord-command")) (begin (emit! saved-code @@ -2539,12 +2558,7 @@ (string ch)))))] [(command) (execute-command! app data)] [else (void)]))]) - (qt-update-visual-decorations! - (qt-current-editor (app-state-frame app))) - (qt-modeline-update! app) - (qt-tabbar-update! app) - (qt-update-frame-title! app) - (qt-echo-draw! (app-state-echo app) echo-label))))) + (qt-refresh-after-key! app echo-label "chord-timeout"))))) (qt-startup-trace "chord timer ready") (qt-startup-trace "desktop restore begin") (when (and *qt-desktop-save-mode* (null? args)) --- a/lib/jerboa-emacs/qt/commands-edit.sls +++ b/lib/jerboa-emacs/qt/commands-edit.sls @@ -1109,9 +1109,14 @@ (run-hooks! 'post-buffer-attach-hook ed buf) (qt-dired-trace "post attach hook done") (verbose-log! "dired-open: post attach hook done") - (echo-message! - (app-state-echo app) - (string-append "Directory: " dir)))))) + (qt-dired-trace "echo begin") + (let ([echo (app-state-echo app)]) + (echo-state-message-set! + echo + (string-append "Directory: " dir)) + (echo-state-error?-set! echo #f)) + (qt-dired-trace "echo done") + (verbose-log! "dired-open: echo done"))))) (def (cmd-dired-find-file app) "In a dired buffer, open the file or directory under cursor." (let* ([buf (current-qt-buffer app)] --- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -813,6 +813,36 @@ (display "\n" (current-error-port)) (flush-output-port (current-error-port))) +(def (qt-ui-trace msg) + (display "TRACE qt-ui: " (current-error-port)) + (display msg (current-error-port)) + (display "\n" (current-error-port)) + (flush-output-port (current-error-port))) + +(def (qt-refresh-after-key! app echo-label origin) + (let* ((fr (app-state-frame app)) + (trace? (eq? (buffer-lexer-lang (qt-current-buffer fr)) 'dired))) + (when trace? (qt-ui-trace (string-append origin " refresh begin"))) + (when trace? (qt-ui-trace (string-append origin " visual begin"))) + (qt-update-visual-decorations! (qt-current-editor fr)) + (when trace? (qt-ui-trace (string-append origin " visual done"))) + (when trace? (qt-ui-trace (string-append origin " mark begin"))) + (qt-update-mark-selection! app) + (when trace? (qt-ui-trace (string-append origin " mark done"))) + (when trace? (qt-ui-trace (string-append origin " modeline begin"))) + (qt-modeline-update! app) + (when trace? (qt-ui-trace (string-append origin " modeline done"))) + (when trace? (qt-ui-trace (string-append origin " tabbar begin"))) + (qt-tabbar-update! app) + (when trace? (qt-ui-trace (string-append origin " tabbar done"))) + (when trace? (qt-ui-trace (string-append origin " title begin"))) + (qt-update-frame-title! app) + (when trace? (qt-ui-trace (string-append origin " title done"))) + (when trace? (qt-ui-trace (string-append origin " echo draw begin"))) + (qt-echo-draw! (app-state-echo app) echo-label) + (when trace? (qt-ui-trace (string-append origin " echo draw done"))) + (when trace? (qt-ui-trace (string-append origin " refresh done"))))) + (def (qt-do-init! qt-app args) (qt-startup-trace "enter") ;; Initialize runtime error log (~/.jemacs-errors.log) @@ -1379,16 +1409,8 @@ (echo-error! (app-state-echo app) (string-append data " is undefined"))) ((ignore) (void))))) ;; bare modifier keys — do nothing (extra parens close quoted-insert + describe-key ifs) - ;; Update visual decorations (current-line + brace match) - (qt-update-visual-decorations! - (qt-current-editor (app-state-frame app))) - ;; Update mark/region visual selection - (qt-update-mark-selection! app) - ;; Update modeline, tab bar, title, and echo after each key - (qt-modeline-update! app) - (qt-tabbar-update! app) - (qt-update-frame-title! app) - (qt-echo-draw! (app-state-echo app) echo-label))))))))) ;; extra parens close begin + repeat-map if + prefix-autorepeat if/let + pty-intercept if + ;; Update visual decorations, mark, modeline, tab bar, title, and echo after each key. + (qt-refresh-after-key! app echo-label "key"))))))))) ;; extra parens close begin + repeat-map if + prefix-autorepeat if/let + pty-intercept if ;; QTerminalWidget key forwarding: send non-command keys directly ;; to the terminal widget, bypassing chord detection and self-insert. ;; C-x prefix and M-x pass through to jemacs keymap. @@ -1503,13 +1525,7 @@ ;; Chord matched — execute the chord command (begin (execute-command! app chord-cmd) - (qt-update-visual-decorations! - (qt-current-editor (app-state-frame app))) - (qt-update-mark-selection! app) - (qt-modeline-update! app) - (qt-tabbar-update! app) - (qt-update-frame-title! app) - (qt-echo-draw! (app-state-echo app) echo-label)) + (qt-refresh-after-key! app echo-label "chord-command")) ;; No chord — replay saved key then process current key (begin (emit! saved-code saved-mods saved-text) @@ -2008,12 +2024,7 @@ (execute-command! app data)) (else (void)))))) ;; Update UI (both paths) - (qt-update-visual-decorations! - (qt-current-editor (app-state-frame app))) - (qt-modeline-update! app) - (qt-tabbar-update! app) - (qt-update-frame-title! app) - (qt-echo-draw! (app-state-echo app) echo-label))))) + (qt-refresh-after-key! app echo-label "chord-timeout"))))) (qt-startup-trace "chord timer ready") ;; Restore session if desktop-save-mode is on and no files given on command line --- a/src/jerboa-emacs/qt/commands-edit.ss +++ b/src/jerboa-emacs/qt/commands-edit.ss @@ -1010,7 +1010,12 @@ (run-hooks! 'post-buffer-attach-hook ed buf) (qt-dired-trace "post attach hook done") (verbose-log! "dired-open: post attach hook done") - (echo-message! (app-state-echo app) (string-append "Directory: " dir)))))) + (qt-dired-trace "echo begin") + (let ((echo (app-state-echo app))) + (set! (echo-state-message echo) (string-append "Directory: " dir)) + (set! (echo-state-error? echo) #f)) + (qt-dired-trace "echo done") + (verbose-log! "dired-open: echo done"))))) (def (cmd-dired-find-file app) "In a dired buffer, open the file or directory under cursor."