From 7a6ddf62541b65876cbc210fe7e49197ab8908a3 Mon Sep 17 00:00:00 2001 From: William Xu Date: Sat, 23 Oct 2021 17:07:21 +0200 Subject: [PATCH] Make Dired path segments jumpable by mouse click (bug#21973) * lisp/dired.el (dired-readin): Call dired-make-path-jumpable. (dired-make-path-jumpable, dired-jump-to-path-segment): New functions. --- lisp/dired.el | 40 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 39 insertions(+), 1 deletion(-) diff --git a/lisp/dired.el b/lisp/dired.el index 4652589122..ba9fa21f89 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1317,10 +1317,11 @@ dired-readin (erase-buffer) (dired-readin-insert)) (goto-char (point-min)) - ;; Must first make alist buffer local and set it to nil because + ;; Must first make alist buffer local and set it to nil because ;; dired-build-subdir-alist will call dired-clear-alist first (setq-local dired-subdir-alist nil) (dired-build-subdir-alist)) + (dired-make-path-jumpable) (let ((attributes (file-attributes dirname))) (if (eq (car attributes) t) (set-visited-file-modtime (file-attribute-modification-time @@ -1643,6 +1644,43 @@ dired-insert-set-properties 'invisible 'dired-hide-details-link)))) (forward-line 1)))) +(defun dired-make-path-jumpable () + "Make dired path line at top jumpable." + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (let ((bound (line-end-position)) + segment-start segment-end) + (when (search-forward "/" bound t 1) + (setq segment-start (point)) + (while (search-forward "/" bound t 1) + (setq segment-end (1- (point))) + (add-text-properties segment-start segment-end + `(mouse-face + highlight + help-echo "mouse-1: goto here" + keymap ,(let ((map (make-sparse-keymap))) + (define-key map [down-mouse-1] 'dired-jump-to-path-segment) + map))) + (setq segment-start (point)))))))) + +(defun dired-jump-to-path-segment (event) + "Jump to the directory from a segment of the dired path." + (interactive "e") + (let* ((ev (event-end event)) + (window (posn-window ev)) + (pos (posn-point ev))) + (with-current-buffer (window-buffer window) + (save-excursion + (goto-char pos) + (when (search-forward "/" (line-end-position) t 1) + (let ((end (point)) + beg) + (while (search-backward "/" (line-beginning-position) t 1) + (setq beg (point))) + (when beg + (dired (buffer-substring-no-properties beg end))))))))) + ;;; Reverting a dired buffer -- 2.25.1