Use minimal modeline for dired buffers
ober
6c4d35ef5d9d9ccb935e0424343758d9402a924a
--- a/lib/jerboa-emacs/qt/modeline.sls +++ b/lib/jerboa-emacs/qt/modeline.sls @@ -45,6 +45,7 @@ [(markdown) "Markdown"] [(org) "Org"] [(json) "JSON"] + [(dired) "Dired"] [else "Text"]))) (define *buffer-eol-cache*--cell (vector (make-hash-table))) (def (detect-eol-from-text text) @@ -66,52 +67,63 @@ (define *modeline-overwrite-provider*--cell (vector (box #f))) (define *modeline-narrow-provider*--cell (vector (box #f))) + (def (qt-modeline-update-dired! app ed buf) + (let* ([line (+ 1 (qt-plain-text-edit-cursor-line ed))] + [info (string-append "-U:%%- " (buffer-name buf) " L" + (number->string line) " (Dired)")]) + (qt-main-window-set-status-bar-text! + (qt-frame-main-win (app-state-frame app)) + info))) (def (qt-modeline-update! app) (let* ([fr (app-state-frame app)] [win (qt-current-window fr)] [ed (qt-edit-window-editor win)] - [buf (qt-edit-window-buffer win)] - [line (+ 1 (qt-plain-text-edit-cursor-line ed))] - [col (+ 1 (qt-plain-text-edit-cursor-column ed))] - [total-lines (qt-plain-text-edit-line-count ed)] - [mod? (qt-text-document-modified? (buffer-doc-pointer buf))] - [ro? (qt-plain-text-edit-read-only? ed)] - [pct (cond - [(<= total-lines 1) "All"] - [(= line 1) "Top"] - [(= line total-lines) "Bot"] - [else - (string-append - (number->string - (inexact->exact - (round - (* 100 - (/ (- line 1) - (max 1 (- total-lines 1))))))) - "%")])] - [state-str (cond - [(and ro? mod?) "%*"] - [ro? "%%"] - [mod? "**"] - [else "--"])] - [mode (mode-name-for-buffer buf)] - [eol (buffer-eol-indicator buf)] - [branch (git-branch-for-file (buffer-file-path buf))] - [lsp-provider (unbox *lsp-modeline-provider*)] - [lsp-str (if lsp-provider (lsp-provider) #f)] - [ovr-provider (unbox *modeline-overwrite-provider*)] - [ovr? (and ovr-provider (ovr-provider))] - [nar-provider (unbox *modeline-narrow-provider*)] - [nar? (and nar-provider (nar-provider buf))] - [info (string-append "-U:" state-str "- " - (if nar? "Narrow " "") (buffer-name buf) " " "L" - (number->string line) " C" (number->string col) " " - pct " (" mode (if ovr? " Ovwrt" "") " " eol ")" - (if branch (string-append " " branch) "") - (if lsp-str (string-append " " lsp-str) ""))]) - (qt-main-window-set-status-bar-text! - (qt-frame-main-win fr) - info))) + [buf (qt-edit-window-buffer win)]) + (if (eq? (buffer-lexer-lang buf) 'dired) + (qt-modeline-update-dired! app ed buf) + (let* ([line (+ 1 (qt-plain-text-edit-cursor-line ed))] + [col (+ 1 (qt-plain-text-edit-cursor-column ed))] + [total-lines (qt-plain-text-edit-line-count ed)] + [mod? (qt-text-document-modified? + (buffer-doc-pointer buf))] + [ro? (qt-plain-text-edit-read-only? ed)] + [pct (cond + [(<= total-lines 1) "All"] + [(= line 1) "Top"] + [(= line total-lines) "Bot"] + [else + (string-append + (number->string + (inexact->exact + (round + (* 100 + (/ (- line 1) + (max 1 (- total-lines 1))))))) + "%")])] + [state-str (cond + [(and ro? mod?) "%*"] + [ro? "%%"] + [mod? "**"] + [else "--"])] + [mode (mode-name-for-buffer buf)] + [eol (buffer-eol-indicator buf)] + [branch (git-branch-for-file (buffer-file-path buf))] + [lsp-provider (unbox *lsp-modeline-provider*)] + [lsp-str (if lsp-provider (lsp-provider) #f)] + [ovr-provider (unbox *modeline-overwrite-provider*)] + [ovr? (and ovr-provider (ovr-provider))] + [nar-provider (unbox *modeline-narrow-provider*)] + [nar? (and nar-provider (nar-provider buf))] + [info (string-append "-U:" state-str "- " + (if nar? "Narrow " "") (buffer-name buf) " " + "L" (number->string line) " C" + (number->string col) " " pct " (" mode + (if ovr? " Ovwrt" "") " " eol ")" + (if branch (string-append " " branch) "") + (if lsp-str (string-append " " lsp-str) ""))]) + (qt-main-window-set-status-bar-text! + (qt-frame-main-win fr) + info))))) (define-syntax *buffer-eol-cache* (identifier-syntax [id (vector-ref *buffer-eol-cache*--cell 0)] --- a/src/jerboa-emacs/qt/modeline.ss +++ b/src/jerboa-emacs/qt/modeline.ss @@ -48,6 +48,7 @@ ((markdown) "Markdown") ((org) "Org") ((json) "JSON") + ((dired) "Dired") (else "Text")))) (def *buffer-eol-cache* (make-hash-table)) @@ -73,53 +74,64 @@ (def *modeline-overwrite-provider* (box #f)) (def *modeline-narrow-provider* (box #f)) +(def (qt-modeline-update-dired! app ed buf) + (let* ((line (+ 1 (qt-plain-text-edit-cursor-line ed))) + (info (string-append + "-U:%%- " + (buffer-name buf) + " L" (number->string line) + " (Dired)"))) + (qt-main-window-set-status-bar-text! (qt-frame-main-win (app-state-frame app)) info))) + (def (qt-modeline-update! app) (let* ((fr (app-state-frame app)) (win (qt-current-window fr)) (ed (qt-edit-window-editor win)) - (buf (qt-edit-window-buffer win)) - (line (+ 1 (qt-plain-text-edit-cursor-line ed))) - (col (+ 1 (qt-plain-text-edit-cursor-column ed))) - (total-lines (qt-plain-text-edit-line-count ed)) - (mod? (qt-text-document-modified? (buffer-doc-pointer buf))) - (ro? (qt-plain-text-edit-read-only? ed)) - (pct (cond - ((<= total-lines 1) "All") - ((= line 1) "Top") - ((= line total-lines) "Bot") - (else (string-append - (number->string - (inexact->exact (round (* 100 (/ (- line 1) - (max 1 (- total-lines 1))))))) - "%")))) - (state-str (cond - ((and ro? mod?) "%*") - (ro? "%%") - (mod? "**") - (else "--"))) - (mode (mode-name-for-buffer buf)) - (eol (buffer-eol-indicator buf)) - (branch (git-branch-for-file (buffer-file-path buf))) - (lsp-provider (unbox *lsp-modeline-provider*)) - (lsp-str (if lsp-provider (lsp-provider) #f)) - (ovr-provider (unbox *modeline-overwrite-provider*)) - (ovr? (and ovr-provider (ovr-provider))) - (nar-provider (unbox *modeline-narrow-provider*)) - (nar? (and nar-provider (nar-provider buf))) - (info (string-append - "-U:" state-str "- " - (if nar? "Narrow " "") - (buffer-name buf) " " - "L" (number->string line) - " C" (number->string col) - " " pct - " (" mode - (if ovr? " Ovwrt" "") - " " eol ")" - (if branch - (string-append " " branch) - "") - (if lsp-str - (string-append " " lsp-str) - "")))) - (qt-main-window-set-status-bar-text! (qt-frame-main-win fr) info))) + (buf (qt-edit-window-buffer win))) + (if (eq? (buffer-lexer-lang buf) 'dired) + (qt-modeline-update-dired! app ed buf) + (let* ((line (+ 1 (qt-plain-text-edit-cursor-line ed))) + (col (+ 1 (qt-plain-text-edit-cursor-column ed))) + (total-lines (qt-plain-text-edit-line-count ed)) + (mod? (qt-text-document-modified? (buffer-doc-pointer buf))) + (ro? (qt-plain-text-edit-read-only? ed)) + (pct (cond + ((<= total-lines 1) "All") + ((= line 1) "Top") + ((= line total-lines) "Bot") + (else (string-append + (number->string + (inexact->exact (round (* 100 (/ (- line 1) + (max 1 (- total-lines 1))))))) + "%")))) + (state-str (cond + ((and ro? mod?) "%*") + (ro? "%%") + (mod? "**") + (else "--"))) + (mode (mode-name-for-buffer buf)) + (eol (buffer-eol-indicator buf)) + (branch (git-branch-for-file (buffer-file-path buf))) + (lsp-provider (unbox *lsp-modeline-provider*)) + (lsp-str (if lsp-provider (lsp-provider) #f)) + (ovr-provider (unbox *modeline-overwrite-provider*)) + (ovr? (and ovr-provider (ovr-provider))) + (nar-provider (unbox *modeline-narrow-provider*)) + (nar? (and nar-provider (nar-provider buf))) + (info (string-append + "-U:" state-str "- " + (if nar? "Narrow " "") + (buffer-name buf) " " + "L" (number->string line) + " C" (number->string col) + " " pct + " (" mode + (if ovr? " Ovwrt" "") + " " eol ")" + (if branch + (string-append " " branch) + "") + (if lsp-str + (string-append " " lsp-str) + "")))) + (qt-main-window-set-status-bar-text! (qt-frame-main-win fr) info)))))