From: William Xu <william.xwl@gmail.com>
Date: Sun, 24 Oct 2021 14:15:12 +0000 (+0200)
Subject: Make dired directory components clickable
X-Git-Tag: emacs-29.0.90~3671^2~445
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=860e8c524bc1695b67fe1001412529da47b11138;p=emacs.git

Make dired directory components clickable

* lisp/dired.el (dired-readin): Use it.

* lisp/dired.el (dired-make-directory-clickable): New user option.

* lisp/dired.el (dired--make-directory-clickable): New function
(bug#21973).
---

diff --git a/etc/NEWS b/etc/NEWS
index 294181635e7..602d13eefad 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -136,13 +136,6 @@ function which returns a string.  For the first two cases, the length
 of the resulting name is controlled by 'eww-buffer-name-length'.  By
 default, no automatic renaming is performed.
 
-** image-dired
-
----
-*** New command for the thumbnail buffer.
-The new command 'image-dired-unmark-all-marks' has been added with a
-binding in the menu.
-
 ** info-look
 
 ---
@@ -198,6 +191,20 @@ external "exiftool" command to be available.  The user options
 `image-dired-cmd-read-exif-data-program' and
 `image-dired-cmd-read-exif-data-options' are now obsolete.
 
+---
+*** New command for the thumbnail buffer.
+The new command 'image-dired-unmark-all-marks' has been added with a
+binding in the menu.
+
+** Dired
+
+---
+*** New user option 'dired-make-directory-clickable'.
+If non-nil (which is the default), hitting 'RET' or 'mouse-1' on
+the directory components at the directory displayed at the start of
+the buffer will take you to that directory.
+
+
 ** Exif
 
 *** New function 'exif-field'.
diff --git a/lisp/dired.el b/lisp/dired.el
index 46525891224..ced18114c46 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -35,6 +35,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'cl-lib))
 ;; When bootstrapping dired-loaddefs has not been generated.
 (require 'dired-loaddefs nil t)
 
@@ -281,6 +282,11 @@ with the buffer narrowed to the listing."
 ;; Note this can't simply be run inside function `dired-ls' as the hook
 ;; functions probably depend on the dired-subdir-alist to be OK.
 
+(defcustom dired-make-directory-clickable t
+  "When non-nil, make the directory at the start of the dired buffer clickable."
+  :version "29.1"
+  :type 'boolean)
+
 (defcustom dired-initial-position-hook nil
   "This hook is used to position the point.
 It is run by the function `dired-initial-position'."
@@ -1326,6 +1332,8 @@ wildcards, erases the buffer, and builds the subdir-alist anew
 	    (set-visited-file-modtime (file-attribute-modification-time
                                        attributes))))
       (set-buffer-modified-p nil)
+      (when dired-make-directory-clickable
+        (dired--make-directory-clickable))
       ;; No need to narrow since the whole buffer contains just
       ;; dired-readin's output, nothing else.  The hook can
       ;; successfully use dired functions (e.g. dired-get-filename)
@@ -1643,6 +1651,31 @@ see `dired-use-ls-dired' for more details.")
 			       'invisible 'dired-hide-details-link))))
       (forward-line 1))))
 
+(defun dired--make-directory-clickable ()
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward "^  /" nil t 1)
+      (let ((bound (line-end-position))
+            (segment-start (point))
+            (inhibit-read-only t)
+            (dir "/"))
+        (while (search-forward "/" bound t 1)
+          (setq dir (concat dir (buffer-substring segment-start (point))))
+          (add-text-properties
+           segment-start (1- (point))
+           `( mouse-face highlight
+              help-echo "mouse-1: goto this directory"
+              keymap ,(let* ((current-dir dir)
+                             (click (lambda ()
+                                      (interactive)
+                                      (if (assoc current-dir dired-subdir-alist)
+                                          (dired-goto-subdir current-dir)
+                                        (dired current-dir)))))
+                        (define-keymap
+                          [down-mouse-1] click
+                          ["RET"] click))))
+          (setq segment-start (point)))))))
+
 
 ;;; Reverting a dired buffer