branch: elpa/dirvish
commit 8002bb97619fea549d9a74d6a00e1448a1b6b25a
Author: Alex Lu <hellosimon1...@hotmail.com>
Commit: Alex Lu <hellosimon1...@hotmail.com>
fix(core): rewrite mode line composer (#233)
- ensure the mode-line context buffer is alive, closes #233.
- rename dirvish--mode-line-fmt -> dirvish--mode-line-composer
- dirvish-*-ml no longer takes dv as its argument
It's unnecessary for most of the segment and may confuse users who need
define
their own segments.
- compose mode/header line segments at runtime
We may allow changing segments on the fly in the future.
- calculate font scale at runtime
Maybe support text-scale-adjust in the future.
---
dirvish-widgets.el | 1 +
dirvish.el | 84 ++++++++++++++++++++++++----------------------
extensions/dirvish-fd.el | 6 ++--
extensions/dirvish-side.el | 4 +--
4 files changed, 49 insertions(+), 46 deletions(-)
diff --git a/dirvish-widgets.el b/dirvish-widgets.el
index 8672155809..13de8643c5 100644
--- a/dirvish-widgets.el
+++ b/dirvish-widgets.el
@@ -307,6 +307,7 @@ GROUP-TITLES is a list of group titles."
(dirvish-define-mode-line path
"Path of file under the cursor."
(let* ((directory-abbrev-alist nil) ; TODO: support custom
`directory-abbrev-alist'
+ (dv (dirvish-curr))
(index (dired-current-directory))
(face (if (dirvish--window-selected-p dv) 'dired-header 'shadow))
(rmt (dirvish-prop :remote))
diff --git a/dirvish.el b/dirvish.el
index 926074aaa6..b060ff714a 100644
--- a/dirvish.el
+++ b/dirvish.el
@@ -363,7 +363,7 @@ A dirvish preview dispatcher is a function consumed by
"Define a mode line segment NAME with BODY and DOCSTRING."
(declare (indent defun) (doc-string 2))
(let ((ml-name (intern (format "dirvish-%s-ml" name))))
- `(defun ,ml-name (dv) ,docstring (ignore dv) ,@body)))
+ `(defun ,ml-name () ,docstring ,@body)))
;;;; Helpers
@@ -565,8 +565,8 @@ ARGS is a list of keyword arguments for `dirvish' struct."
(when (or m-attr feat-in-lib) (require lib))
(and m-attr (setq attrs (append attrs m-attr))))
finally
- (setf dirvish--mode-line-fmt (dirvish--mode-line-fmt-setter ml-l ml-r))
- (setf dirvish--header-line-fmt (dirvish--mode-line-fmt-setter hl-l hl-r t))
+ (setf dirvish--mode-line-fmt (dirvish--mode-line-composer ml-l ml-r))
+ (setf dirvish--header-line-fmt (dirvish--mode-line-composer hl-l hl-r t))
(setf dirvish--working-preview-dispathchers (dirvish--preview-dps-validate))
(setf dirvish--working-attrs (dirvish--attrs-expand attrs))))
@@ -959,52 +959,54 @@ This attribute is enabled when `dirvish-hide-cursor' is
non-nil."
(let ((ov (make-overlay f-end l-end)))
(overlay-put ov 'invisible t) `(ov . ,ov))))
-(defun dirvish--mode-line-fmt-setter (left right &optional header)
- "Set the `dirvish--mode-line-fmt'.
+(defun dirvish--mode-line-composer (left right &optional header)
+ "Set `dirvish--mode-line-fmt'.
LEFT and RIGHT are segments aligned to left/right respectively.
If HEADER, set the `dirvish--header-line-fmt' instead."
- (cl-labels ((expand (segments)
- (cl-loop for s in segments collect
- (if (stringp s) s
- `(:eval (,(intern (format "dirvish-%s-ml" s))
(dirvish-curr))))))
- (get-font-scale ()
- (let* ((face (if header 'header-line 'mode-line-inactive))
- (default (face-attribute 'default :height))
- (ml-height (face-attribute face :height)))
- (cond ((floatp ml-height) ml-height)
- ((integerp ml-height) (/ (float ml-height) default))
- (t 1)))))
- `((:eval
- (let* ((dv (dirvish-curr))
- (buf (and (car (dv-layout dv)) (cdr (dv-index dv))))
- (scale ,(get-font-scale))
- (win-width (floor (/ (window-width) scale)))
- (str-l (format-mode-line
- ',(or (expand left) mode-line-format) nil nil buf))
- (str-r (format-mode-line ',(expand right) nil nil buf))
- (len-r (string-width str-r)))
- (concat
- (dirvish--bar-image (car (dv-layout dv)) ,header)
- (if (< (+ (string-width str-l) len-r) win-width)
- str-l
- (let ((trim (1- (- win-width len-r))))
- (if (>= trim 0)
- (substring str-l 0 (min trim (1- (length str-l))))
- "")))
- (propertize
- " " 'display
- `((space :align-to (- (+ right right-fringe right-margin)
- ,(ceiling (* scale (string-width str-r)))))))
- str-r))))))
+ `((:eval
+ (let* ((dv (dirvish-curr))
+ (buf (and (car (dv-layout dv)) (cdr (dv-index dv))))
+ (expand
+ (lambda (segs)
+ (cl-loop for s in segs collect
+ (if (stringp s) s
+ `(:eval (,(intern (format "dirvish-%s-ml" s))))))))
+ (face ',(if header 'header-line 'mode-line-inactive))
+ (default (face-attribute 'default :height))
+ (ml-height (face-attribute face :height))
+ (scale (cond ((floatp ml-height) ml-height)
+ ((integerp ml-height) (/ (float ml-height) default))
+ (t 1)))
+ (win-width (floor (/ (window-width) scale)))
+ (str-l "DIRVISH: Context buffer is not a live buffer")
+ (str-r (propertize "WARNING" 'face 'dired-warning))
+ (len-r 7))
+ (when (buffer-live-p buf)
+ (setq str-l (format-mode-line (funcall expand ',left) nil nil buf))
+ (setq str-r (format-mode-line (funcall expand ',right) nil nil buf))
+ (setq len-r (string-width str-r)))
+ (concat
+ (dirvish--bar-image fullframe-p ,header)
+ (if (< (+ (string-width str-l) len-r) win-width)
+ str-l
+ (let ((trim (1- (- win-width len-r))))
+ (if (>= trim 0)
+ (substring str-l 0 (min trim (1- (length str-l))))
+ "")))
+ (propertize
+ " " 'display
+ `((space :align-to (- (+ right right-fringe right-margin)
+ ,(ceiling (* scale (string-width str-r)))))))
+ str-r)))))
;; Thanks to `doom-modeline'.
-(defun dirvish--bar-image (fullscreenp header)
+(defun dirvish--bar-image (fullframe-p header)
"Create a bar image with height of `dirvish-mode-line-height'.
-If FULLSCREENP, use the `cdr' of the value as height, otherwise
+If FULLFRAME-P, use the `cdr' of the value as height, otherwise
use `car'. If HEADER, use `dirvish-header-line-height' instead."
(when (and (display-graphic-p) (image-type-available-p 'pbm))
(let* ((hv (if header dirvish-header-line-height dirvish-mode-line-height))
- (ht (cond ((numberp hv) hv) (fullscreenp (cdr hv)) (t (car hv)))))
+ (ht (cond ((numberp hv) hv) (fullframe-p (cdr hv)) (t (car hv)))))
(propertize
" " 'display
(ignore-errors
diff --git a/extensions/dirvish-fd.el b/extensions/dirvish-fd.el
index 2c5b617efd..933a5a3374 100644
--- a/extensions/dirvish-fd.el
+++ b/extensions/dirvish-fd.el
@@ -75,7 +75,7 @@ should return a list of regular expressions."
(defconst dirvish-fd-bufname "🔍%s📁%s📁%s")
(defconst dirvish-fd-header
- (dirvish--mode-line-fmt-setter '(fd-switches) '(fd-timestamp fd-pwd " ") t))
+ (dirvish--mode-line-composer '(fd-switches) '(fd-timestamp fd-pwd " ") t))
(defvar dirvish-fd-input-history nil "History list of fd input in the
minibuffer.")
(defvar dirvish-fd-debounce-timer nil)
(defvar-local dirvish-fd--output "")
@@ -218,7 +218,7 @@ Raise an error if fd executable is not available."
"Return a formatted string showing the DIRVISH-FD-ACTUAL-SWITCHES."
(pcase-let ((`(,globp ,casep ,ign-range ,types ,exts ,excludes)
(dirvish-prop :fd-arglist))
- (face (if (dirvish--window-selected-p dv)
+ (face (if (dirvish--window-selected-p (dirvish-curr))
'dired-header 'shadow)))
(format " %s | %s"
(propertize "FD" 'face face)
@@ -246,7 +246,7 @@ Raise an error if fd executable is not available."
(dirvish-define-mode-line fd-timestamp
"Timestamp of search finished."
- (when (car (dv-layout dv)) (dirvish-prop :fd-time)))
+ (when (car (dv-layout (dirvish-curr))) (dirvish-prop :fd-time)))
(dirvish-define-mode-line fd-pwd
"Current working directory."
diff --git a/extensions/dirvish-side.el b/extensions/dirvish-side.el
index 024c6f5aa7..96699d9660 100644
--- a/extensions/dirvish-side.el
+++ b/extensions/dirvish-side.el
@@ -56,7 +56,7 @@ If non-nil, expand all the parent directories of current
buffer's
filename until the project root when opening a side session."
:group 'dirvish :type 'boolean)
-(defconst dirvish-side-header (dirvish--mode-line-fmt-setter '(project) nil t))
+(defconst dirvish-side-header (dirvish--mode-line-composer '(project) nil t))
(defun dirvish-side-file-open-fn ()
"Called before opening a file in side sessions."
@@ -145,7 +145,7 @@ filename until the project root when opening a side
session."
(dirvish-define-mode-line project
"Return a string showing current project."
(let ((project (dirvish--get-project-root))
- (face (if (dirvish--window-selected-p dv) 'dired-header 'shadow)))
+ (face (if (dirvish--window-selected-p (dirvish-curr)) 'dired-header
'shadow)))
(if project
(setq project (file-name-base (directory-file-name project)))
(setq project "-"))
