bug#21973: 24.5; feature proposal: make dired header clickable

[William Xu <william.xwl@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 188 bytes --]

Stefan Kangas <stefan@marxist.se> writes:

> I didn't read your patch in detail, but the feature sounds like a good
> idea.  Could you perhaps write it up as a patch?

Done. 

-- 
William

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Make-Dired-path-segments-jumpable-by-mouse-click-bug.patch --]
[-- Type: text/x-diff, Size: 2909 bytes --]

From 7a6ddf62541b65876cbc210fe7e49197ab8908a3 Mon Sep 17 00:00:00 2001
From: William Xu <william.xwl@gmail.com>
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)))))))))
+
 \f
 ;;; Reverting a dired buffer
 
-- 
2.25.1