branch: elpa/dirvish
commit 063a439c63e0068a02cb15ea1e249df2c920961c
Author: Alex Lu <hellosimon1...@hotmail.com>
Commit: Alex Lu <hellosimon1...@hotmail.com>
refactor: expunge `dirvish--this` | `dv-scopes` | `this-command`
The original purpose of `dirvish--this` was to enable `dired-noselect` to
correctly identify its associated Dirvish session. However, maintaining
this
variable has become increasingly cumbersome due to concurrent extension
usage.
Furthermore, its functionality overlaps with `dirvish-curr`, resulting in
confusing and difficult-to-maintain code.
We previously used `dv-scopes` to track Dirvish's context, preventing
incorrect
session selection across frames, tabs, or perspectives. However, storing
this
context solely in the session struct proved insufficient. Dirvish's
mechanism
necessitates saving it buffer-locally instead.
---
dirvish-widgets.el | 2 +-
dirvish.el | 151 +++++++++++++++++++++++++--------------------
extensions/dirvish-fd.el | 10 ++-
extensions/dirvish-peek.el | 14 ++---
extensions/dirvish-side.el | 9 +--
5 files changed, 103 insertions(+), 83 deletions(-)
diff --git a/dirvish-widgets.el b/dirvish-widgets.el
index bf73a6c08e..6ffcc7e53d 100644
--- a/dirvish-widgets.el
+++ b/dirvish-widgets.el
@@ -211,7 +211,7 @@ A new directory is created unless NO-MKDIR."
(defun dirvish-media--cache-sentinel (proc _exitcode)
"Sentinel for image cache process PROC."
- (when-let* ((dv (or (dirvish-curr) dirvish--this))
+ (when-let* ((dv (dirvish-curr))
(path (dirvish-prop :index)))
(and (equal path (process-get proc 'path))
(dirvish-debounce nil (dirvish--preview-update dv path)))))
diff --git a/dirvish.el b/dirvish.el
index 5d54b2355e..0f4547e1a9 100644
--- a/dirvish.el
+++ b/dirvish.el
@@ -255,8 +255,8 @@ input for `dirvish-redisplay-debounce' seconds."
;;;; Internal variables
-(defvar dirvish-scopes '(:frame selected-frame :tab tab-bar--current-tab-index
- :persp get-current-persp :perspective
persp-curr))
+(defvar dirvish-scopes
+ '(:frame selected-frame :tab tab-bar--current-tab-index :persp persp-curr))
(defvar dirvish-libraries
'((dirvish-widgets path symlink sort omit index free-space file-link-number
file-user file-group file-time file-size file-modes
@@ -281,7 +281,6 @@ input for `dirvish-redisplay-debounce' seconds."
(defvar dirvish--header-line-fmt nil)
(defvar dirvish--session-hash (make-hash-table))
(defvar dirvish--parent-hash (make-hash-table :test #'equal))
-(defvar dirvish--this nil)
(defvar dirvish--available-attrs '())
(defvar dirvish--available-preview-dispatchers '())
(defvar dirvish--working-attrs '())
@@ -463,8 +462,8 @@ ALIST is window arguments passed to
`window--display-buffer'."
(let ((dv (or dv (dirvish-curr))))
(eq (dv-root-window dv) dirvish--selected-window)))
-(defun dirvish--scopes ()
- "Return computed scopes according to `dirvish-scopes'."
+(defun dirvish--get-scope ()
+ "Return computed scope according to `dirvish-scopes'."
(cl-loop for (k v) on dirvish-scopes by 'cddr
append (list k (and (functionp v) (funcall v)))))
@@ -512,9 +511,9 @@ Set process's SENTINEL and PUTS accordingly."
(curr-layout () :documentation "is the working layout recipe of DV.")
(ff-layout
dirvish-default-layout :documentation "is a full-frame layout recipe.")
+ (reuse () :documentation "indicates if DV has been reused.")
(ls-switches
dired-listing-switches :documentation "is the directory listing switches.")
- (scopes () :documentation "are the environment of DV such as
its init frame.")
(preview-buffers () :documentation "holds all file preview buffers of
DV.")
(preview-window () :documentation "is the window to display preview
buffer.")
(name (cl-gensym) :documentation "is an unique symbol to identify DV.")
@@ -527,19 +526,30 @@ Set process's SENTINEL and PUTS accordingly."
ARGS is a list of keyword arguments for `dirvish' struct."
(let (slots new)
(while (keywordp (car args)) (dotimes (_ 2) (push (pop args) slots)))
- (setq new (apply #'make-dirvish (reverse slots)) dirvish--this new)
+ (setq new (apply #'make-dirvish (reverse slots)))
(puthash (dv-name new) new dirvish--session-hash)
(dirvish--check-deps)
(dirvish--create-root-window new) new))
-(defun dirvish--find-reusable (&optional type)
- "Return the first matched reusable session with TYPE."
- (when dirvish-reuse-session
- (cl-loop with scopes = (dirvish--scopes)
- for dv in (hash-table-values dirvish--session-hash)
- when (and (eq type (dv-type dv))
- (equal (dv-scopes dv) scopes))
- collect dv)))
+(defun dirvish--get-session (&optional key val)
+ "Return the first matched session has KEY of VAL."
+ (cl-loop with scope = (dirvish--get-scope)
+ with fn = (and key (intern (format "dv-%s" key)))
+ for dv in (hash-table-values dirvish--session-hash)
+ for idx = (cdr (dv-index dv)) for live? = (buffer-live-p idx)
+ for tab = (and live? (with-current-buffer idx (dirvish-prop :tab)))
+ for frame = (and live? (with-current-buffer idx (dirvish-prop
:frame)))
+ for persp = (and live? (with-current-buffer idx (dirvish-prop
:persp)))
+ when (or (not live?) ; newly created session
+ (and (equal tab (plist-get scope :tab))
+ (equal frame (plist-get scope :frame))
+ (equal persp (plist-get scope :persp))
+ (let ((res (and fn (funcall fn dv))))
+ (cond ((not fn) t)
+ ((eq key 'roots)
+ (memq val (mapcar #'cdr res)))
+ (res (eq val res))))))
+ return dv))
(defun dirvish--clear-session (dv)
"Reset DV's slot and kill its buffers."
@@ -559,8 +569,7 @@ ARGS is a list of keyword arguments for `dirvish' struct."
do (dirvish--kill-buffer b))
(setq dirvish--parent-hash (make-hash-table :test #'equal))
(cond (dirvish-reuse-session (setf (dv-winconf dv) nil))
- (t (mapc (pcase-lambda (`(,_ . ,b)) (kill-buffer b)) (dv-roots dv))))
- (setq dirvish--this nil)))
+ (t (mapc (pcase-lambda (`(,_ . ,b)) (kill-buffer b)) (dv-roots
dv))))))
(defun dirvish--create-root-window (dv)
"Create root window of DV."
@@ -733,7 +742,7 @@ buffer, it defaults to filename under the cursor when it is
nil."
(defun dirvish-thumb-buf-a (fn)
"Advice for FN `image-dired-create-thumbnail-buffer'."
- (when-let* ((dv dirvish--this) ((dv-preview-window dv)))
+ (when-let* ((dv (dirvish-curr)) ((dv-preview-window dv)))
(dirvish--build-layout dv)
(with-selected-window (dv-preview-window dv)
(switch-to-buffer image-dired-thumbnail-buffer)))
@@ -748,14 +757,14 @@ buffer, it defaults to filename under the cursor when it
is nil."
"Return buffer for DIR-OR-LIST with FLAGS, FN is `dired-noselect'."
(let* ((dir (if (consp dir-or-list) (car dir-or-list) dir-or-list))
(key (file-name-as-directory (expand-file-name dir)))
- (this dirvish--this)
- (dv (if (and this (eq this-command 'dired-other-frame)) (dirvish--new)
- (or this (car (dirvish--find-reusable)) (dirvish--new))))
+ (reuse? (or (dirvish-curr) (dirvish--get-session)))
+ (dv (or reuse? (dirvish--new)))
(bname buffer-file-name)
(remote (file-remote-p dir))
(flags (or flags (dv-ls-switches dv)))
(buffer (alist-get key (dv-roots dv) nil nil #'equal))
- (new-buffer-p (not buffer)))
+ (new-buffer-p (null buffer)))
+ (when reuse? (setf (dv-reuse dv) t))
(when new-buffer-p
(if (not remote)
(let ((dired-buffers nil)) ; disable reuse from dired
@@ -776,6 +785,8 @@ buffer, it defaults to filename under the cursor when it is
nil."
(dirvish-prop :gui (display-graphic-p))
(dirvish-prop :remote remote)
(dirvish-prop :root key)
+ (cl-loop for (k v) on dirvish-scopes by 'cddr
+ do (dirvish-prop k (and (functionp v) (funcall v))))
(when bname (dired-goto-file bname))
(setf (dv-index dv) (cons key buffer))
(run-hook-with-args 'dirvish-find-entry-hook key buffer)
@@ -834,39 +845,52 @@ When FORCE, ensure the preview get refreshed."
(remhash (dv-name dv) dirvish--session-hash)
(cl-loop for b in (buffer-list) for bn = (buffer-name b) when
(string-match-p (format " ?\\*Dirvish-.*-%s\\*" (dv-name dv))
bn)
- do (dirvish--kill-buffer b))
- (setq dirvish--this nil))))
+ do (dirvish--kill-buffer b)))))
(defun dirvish-selection-change-h (&rest _)
- "Record `dirvish--selected-window' and `dirvish--this'."
- (unless (active-minibuffer-window) (setq dirvish--this (dirvish-curr)))
+ "Record `dirvish--selected-window'."
(setq dirvish--selected-window (frame-selected-window)))
(defun dirvish-winconf-change-h ()
- "Record root window and update its UI for current dirvish session."
- (when-let* ((dv (dirvish-curr)))
- (setf (dv-root-window dv) (get-buffer-window (cdr (dv-index dv))))
- (dirvish-update-body-h 'force-preview-update)))
+ "Update UI for dirvish session."
+ (dirvish-update-body-h 'force-preview-update))
(defun dirvish-winbuf-change-h (window)
"Rebuild layout once buffer in WINDOW changed."
- (with-selected-window window
- (when-let* ((dv (dirvish-curr)))
- (let ((saved-layout (dv-curr-layout dv))
- (saved-winconf (dv-winconf dv)))
- ;; rebuild a fullframe session as a single pane session temporarily,
for
- ;; cases when a buried dirvish buffers is selected by minibuffer
- ;; commands such as `consult-buffer'.
- (cond ((and (active-minibuffer-window) saved-layout)
- (setf (dv-curr-layout dv) nil)
- (dirvish--build-layout dv)
- (setf (dv-curr-layout dv) saved-layout)
- (setf (dv-winconf dv) saved-winconf))
- (t (dirvish--build-layout dv)))))))
-
-(defun dirvish-tab-new-post-h (_tab)
- "Do not reuse sessions from other tabs."
- (setq dirvish--this nil))
+ (when-let* ((dv (with-selected-window window (dirvish-curr)))
+ (dir (car (dv-index dv))) (buf (cdr (dv-index dv)))
+ (winconf t) (layout t)
+ (old-tab (with-selected-window window (dirvish-prop :tab)))
+ (old-frame (with-selected-window window (dirvish-prop :frame)))
+ (sc (dirvish--get-scope)) (frame t) (tab t))
+ (setq winconf (dv-winconf dv) layout (dv-curr-layout dv)
+ frame (plist-get sc :frame) tab (plist-get sc :tab))
+ (when (and (dv-reuse dv) (not (equal old-frame frame)))
+ (with-selected-window (frame-selected-window old-frame)
+ (when (dirvish-curr) (let (dirvish-reuse-session) (dirvish-quit)))
+ (setq dv (dirvish--new))))
+ (when (and (dv-reuse dv) (not (equal old-tab tab)))
+ ;; TODO: maybe clear dirvish sessions in all tabs except the current TAB?
+ (setq dv (dirvish--new)))
+ (cond
+ ;; by `*-other-tab|frame'
+ ((or (null (equal old-frame frame)) (null (equal old-tab tab)))
+ (with-selected-window (dirvish--create-root-window dv)
+ (setq dirvish--selected-window (selected-window))
+ (dirvish-save-dedication
+ (switch-to-buffer (get-buffer-create "*scratch*")))
+ (setf (dv-winconf dv) (current-window-configuration))
+ (dirvish-save-dedication (switch-to-buffer (dired-noselect dir)))
+ (cl-loop for (k v) on sc by 'cddr do (dirvish-prop k v))
+ (dirvish--build-layout dv)))
+ ;; rebuild a fullframe session as a single pane temporarily, for cases
when
+ ;; a buried buffer is selected in minibuffer, e.g. using `consult-buffer'.
+ ((and (active-minibuffer-window) layout)
+ (setf (dv-curr-layout dv) nil)
+ (with-selected-window window (dirvish--build-layout dv))
+ (setf (dv-curr-layout dv) layout)
+ (setf (dv-winconf dv) winconf))
+ (t (with-selected-window window (dirvish--build-layout dv))))))
;;;; Preview
@@ -947,7 +971,7 @@ When FORCE, ensure the preview get refreshed."
(defun dirvish-shell-preview-proc-s (proc _exitcode)
"A sentinel for dirvish preview process.
When PROC finishes, fill preview buffer with process result."
- (when-let* ((dv (or (dirvish-curr) dirvish--this)))
+ (when-let* ((dv (dirvish-curr)))
(with-current-buffer (dirvish--util-buffer 'preview dv nil t)
(erase-buffer) (remove-overlays)
(insert (with-current-buffer (process-buffer proc) (buffer-string)))
@@ -1031,9 +1055,10 @@ If HEADER, set the `dirvish--header-line-fmt' instead."
((integerp ml-height) (/ (float ml-height) default))
(t 1)))
(win-width (floor (/ (window-width) scale)))
- (str-l "DIRVISH: Context buffer is not a Dirvish buffer")
- (str-r (propertize "WARNING" 'face 'dired-warning))
- (len-r 7))
+ (str-l (if dv " DIRVISH: context buffer is a killed buffer"
+ " DIRVISH: failed to get current session"))
+ (str-r (propertize "WARNING " 'face 'dired-warning))
+ (len-r 8))
(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))
@@ -1071,9 +1096,9 @@ use `car'. If HEADER, use `dirvish-header-line-height'
instead."
(cond ((booleanp ctx) ctx)
((dirvish-prop :fd-switches)
(memq 'dirvish-fd ctx))
- ((and dirvish--this (dv-curr-layout dirvish--this))
+ ((and (dirvish-curr) (dv-curr-layout (dirvish-curr)))
(memq 'dirvish ctx))
- ((and dirvish--this (eq (dv-type dirvish--this) 'side))
+ ((and (dirvish-curr) (eq (dv-type (dirvish-curr)) 'side))
(memq 'dirvish-side ctx))
(t (memq 'dired ctx))))
@@ -1192,8 +1217,8 @@ LEVEL is the depth of current window."
(depth (or (car (dv-curr-layout dv)) 0))
(i 0))
(when-let* ((fixed (dv-size-fixed dv))) (setq window-size-fixed fixed))
- (when (or (dv-curr-layout dv) (dv-dedicated dv))
- (set-window-dedicated-p nil t))
+ (if (dv-curr-layout dv) (set-window-dedicated-p nil nil)
+ (and (dv-dedicated dv) (set-window-dedicated-p nil t)))
(set-window-fringes nil dirvish-window-fringe dirvish-window-fringe)
(while (and (< i depth) (not (string= current parent)))
(cl-incf i)
@@ -1285,7 +1310,6 @@ INHIBIT-SETUP is non-nil."
(defun dirvish--build-layout (dv)
"Build layout for Dirvish session DV."
- (setf (dv-scopes dv) (dirvish--scopes))
(setf (dv-index dv) (cons (dirvish-prop :root) (current-buffer)))
(setf (dv-winconf dv) (or (dv-winconf dv) (current-window-configuration)))
(let* ((layout (dv-curr-layout dv))
@@ -1312,17 +1336,15 @@ INHIBIT-SETUP is non-nil."
(unless (dirvish-prop :cached)
(dirvish--dir-data-async default-directory (current-buffer))
(dirvish-prop :cached t))
- (setq dirvish--this dv)
(dirvish--maybe-toggle-cursor)
(dirvish--maybe-toggle-details)))
(defun dirvish--reuse-or-create (path layout)
"Find PATH in a dirvish session and set its layout with LAYOUT."
(let ((dir (or path default-directory))
- (dv (or dirvish--this (car (dirvish--find-reusable)))))
+ (dv (or (dirvish-curr) (dirvish--get-session))))
(cond (dv (with-selected-window (dirvish--create-root-window dv)
(setf (dv-curr-layout dv) layout)
- (setq dirvish--this dv)
(dirvish-find-entry-a
(if (or path (not (eq dirvish-reuse-session 'resume))) dir
(car (dv-index dv))))
@@ -1363,15 +1385,12 @@ are killed and the Dired buffer(s) in the selected
window are buried."
(image-dired-create-thumbnail-buffer dirvish-thumb-buf-a
:around)
(wdired-change-to-wdired-mode dirvish-wdired-enter-a :after)
(wdired-change-to-dired-mode dirvish-init-dired-buffer :after)))
- (sel-ch #'dirvish-selection-change-h)
- (tab-post #'dirvish-tab-new-post-h))
+ (sel-ch #'dirvish-selection-change-h))
(if dirvish-override-dired-mode
(progn (pcase-dolist (`(,sym ,fn ,how) ads) (advice-add sym how fn))
- (add-hook 'window-selection-change-functions sel-ch)
- (add-hook 'tab-bar-tab-post-open-functions tab-post))
+ (add-hook 'window-selection-change-functions sel-ch))
(pcase-dolist (`(,sym ,fn) ads) (advice-remove sym fn))
- (remove-hook 'window-selection-change-functions sel-ch)
- (remove-hook 'tab-bar-tab-post-open-functions tab-post))))
+ (remove-hook 'window-selection-change-functions sel-ch))))
;;;###autoload
(defun dirvish (&optional path)
@@ -1389,7 +1408,7 @@ otherwise it defaults to `default-directory'.
If `one-window-p' returns nil, open PATH using regular Dired."
(interactive (list (and current-prefix-arg (read-directory-name "Dirvish:
"))))
(dirvish--reuse-or-create
- path (if dirvish--this (dv-curr-layout dirvish--this)
+ path (if (dirvish-curr) (dv-curr-layout (dirvish-curr))
(and (one-window-p) dirvish-default-layout))))
(transient-define-prefix dirvish-dispatch ()
diff --git a/extensions/dirvish-fd.el b/extensions/dirvish-fd.el
index 35d6780d38..423cf846ec 100644
--- a/extensions/dirvish-fd.el
+++ b/extensions/dirvish-fd.el
@@ -316,7 +316,7 @@ value 16, let the user choose the root directory of their
search."
(defun dirvish-fd-find (entry)
"Run fd accroring to ENTRY."
- (let* ((dv (or dirvish--this (dirvish-curr)))
+ (let* ((dv (dirvish-curr))
(roots (and dv (dv-roots dv)))
(buf (and roots (alist-get entry roots nil nil #'equal))))
(or buf
@@ -352,7 +352,9 @@ value 16, let the user choose the root directory of their
search."
(cond ((not input) (setq input (dirvish-fd--read-input)))
(t (dirvish-update-body-h)))
(when (eq input 'cancelled)
- (cl-return-from dirvish-fd-proc-sentinel (kill-buffer buf)))
+ (kill-buffer buf)
+ (setf (dv-index dv) (car (dv-roots dv)))
+ (cl-return-from dirvish-fd-proc-sentinel))
(let ((bufname (dirvish-fd--bufname input dir dv)))
(dirvish-prop :root bufname)
(setf (dv-index dv) (cons bufname buf))
@@ -417,7 +419,7 @@ The command run is essentially:
(fd-program (dirvish-fd--ensure-fd remote))
(ls-program (or (and remote (dirvish-fd--find-gnu-ls remote))
dirvish-fd-ls-program))
- (dv (or (dirvish-curr) (progn (dirvish dir) dirvish--this)))
+ (dv (or (dirvish-curr) (progn (dirvish dir) (dirvish--get-session))))
(fd-switches (or (dirvish-prop :fd-switches) dirvish-fd-switches ""))
(ls-switches (or dired-actual-switches (dv-ls-switches dv)))
(buffer (dirvish--util-buffer 'fd dv nil t)))
@@ -439,6 +441,8 @@ The command run is essentially:
(dirvish-prop :cus-header 'dirvish-fd-header)
(dirvish-prop :remote remote)
(dirvish-prop :global-header t)
+ (cl-loop for (k v) on dirvish-scopes by 'cddr
+ do (dirvish-prop k (and (functionp v) (funcall v))))
(let ((proc (apply #'start-file-process
"fd" buffer
`(,fd-program "--color=never"
diff --git a/extensions/dirvish-peek.el b/extensions/dirvish-peek.el
index dc1c7f935a..9441e0495c 100644
--- a/extensions/dirvish-peek.el
+++ b/extensions/dirvish-peek.el
@@ -68,12 +68,12 @@ one of categories in `dirvish-peek-categories'."
(dirvish-peek--prepare-cand-fetcher)
(add-hook 'post-command-hook #'dirvish-peek-update-h 90 t)
(add-hook 'minibuffer-exit-hook #'dirvish-peek-exit-h nil t)
- (unless (and dirvish--this (dv-preview-window dirvish--this))
- (setq new-dv (dirvish--new :type 'peek))
- ;; `dirvish-image-dp' needs this.
- (setf (dv-index new-dv) (cons default-directory (current-buffer)))
- (setf (dv-preview-window new-dv)
- (or (minibuffer-selected-window) (next-window)))))))
+ (setq new-dv (dirvish--new :type 'peek))
+ ;; `dirvish-image-dp' needs this.
+ (setf (dv-index new-dv) (cons default-directory (current-buffer)))
+ (setf (dv-preview-window new-dv)
+ (or (minibuffer-selected-window) (next-window)))
+ (dirvish-prop :dv (dv-name new-dv)))))
(defun dirvish-peek-update-h ()
"Hook for `post-command-hook' to update peek window."
@@ -93,7 +93,7 @@ one of categories in `dirvish-peek-categories'."
(dirvish-prop :index cand)
(unless (file-remote-p cand)
(dirvish-debounce nil
- (dirvish--preview-update dirvish--this cand)))))
+ (dirvish--preview-update (dirvish-curr) cand)))))
(defun dirvish-peek-exit-h ()
"Hook for `minibuffer-exit-hook' to destroy peek session."
diff --git a/extensions/dirvish-side.el b/extensions/dirvish-side.el
index 858e9a7480..e0d2f8f60c 100644
--- a/extensions/dirvish-side.el
+++ b/extensions/dirvish-side.el
@@ -102,7 +102,7 @@ filename until the project root when opening a side
session."
(run-with-timer
0.01 nil
(lambda ()
- (when-let* (((not dirvish--this))
+ (when-let* (((not (dirvish-curr)))
((not (active-minibuffer-window)))
(win (dirvish-side--session-visible-p))
(dv (with-selected-window win (dirvish-curr)))
@@ -112,18 +112,16 @@ filename until the project root when opening a side
session."
((not (string-suffix-p "COMMIT_EDITMSG" curr)))
((not (equal prev curr))))
(with-selected-window win
- (setq dirvish--this dv)
(let (buffer-list-update-hook) (dirvish-find-entry-a dir))
(if dirvish-side-auto-expand (dirvish-subtree-expand-to curr)
(dired-goto-file curr))
(dirvish-prop :cus-header 'dirvish-side-header)
- (dirvish-update-body-h)
- (setq dirvish--this nil))))))
+ (dirvish-update-body-h))))))
(defun dirvish-side--new (path)
"Open a side session in PATH."
(let* ((bname buffer-file-name)
- (dv (or (car (dirvish--find-reusable 'side))
+ (dv (or (dirvish--get-session 'type 'side)
(dirvish--new
:type 'side
:size-fixed 'width
@@ -133,7 +131,6 @@ filename until the project root when opening a side
session."
(r-win (dv-root-window dv)))
(unless (window-live-p r-win) (setq r-win (dirvish--create-root-window
dv)))
(with-selected-window r-win
- (setq dirvish--this dv)
(dirvish-find-entry-a path)
(cond ((not bname) nil)
(dirvish-side-auto-expand
