bug#72272: [PATCH] dired-hide-details-mode hides directory's absolute path

[Alvaro Ramirez <alvaro@xenodium.com>]

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

+cc 72272@debbugs.gnu.org

Thank you for the comments Andrea and Eli.

Andrea Corallo <acorallo@gnu.org> writes:

> Eli Zaretskii <eliz@gnu.org> writes:
>
>>
>> Thanks.
>>
>> Stefan and Andrea, any comments?
>>
>> I have a few minor ones:
>>
>>> From: xenodium <me+gh@xenodium.com>
>>> Date: Tue, 23 Jul 2024 21:55:37 +0100
>>> Subject: [PATCH] Hides current location's path via
>>> dired-hide-details-mode
>>                                             ^^^^
>> Please don't use "path" for anything except PATH-style
>> directory
>> lists.  The GNU Coding Standards frown on such usage.
>>

Ah got it. TIL the naming convention used for functions like of 
file-name-as-directory.

>>> +(defcustom dired-hide-details-hide-absolute-location t
>>> +  "Non-nil means `dired-hide-details-mode' hides current
>>> location's absolute path."
>>
>> Same here.

Done

>>
>>> +            (if-let ((dir-base (file-name-nondirectory
>>> new-dir-name))
>>> +                     (dir-path (file-name-directory
>>> new-dir-name))
>>> +                     (hide-dir-path (and
>>> dired-hide-details-hide-absolute-location
>>
>> And here.

Done

>>
>> Also, this change needs a NEWS entry.

Added

>
> No further comments other than:
>
>> @@ -3268,6 +3275,11 @@
>> dired-hide-details-update-invisibility-spec
>>  	       'add-to-invisibility-spec
>>  	     'remove-from-invisibility-spec)
>>  	   'dired-hide-details-information)
>> +  (funcall (if (and dired-hide-details-mode
>> +		    dired-hide-details-hide-absolute-location)
>> +	       'add-to-invisibility-spec
>> +	     'remove-from-invisibility-spec)
>> +	   'dired-hide-details-absolute-location)
>
> don't we favor #' in place of ' when quoting functions?

Added

I also modified the patch a little to cater for 
`dired-maybe-insert-subdir` (see 
https://lists.gnu.org/archive/html/emacs-devel/2024-08/msg00033.html) 
and to include a couple of tests.

May be worth noting, the following dired.el comment seemed
outdated 
https://github.com/emacs-mirror/emacs/blob/c7d9cd722e5a7042a52c92f8497f903bfe9870b8/lisp/dired.el#L1805

 ;; Note that dired-build-subdir-alist will replace the name
 ;; by its expansion, so it does not matter whether what we insert
 ;; here is fully expanded, but it should be absolute.

The mentioned replacement doesn't take place when using 
`dired-maybe-insert-subdir`, so I tweaked the comment. Setting 
invisible property is now needed in two places (to handle current 
location and now subdirs).

Please take a look at the latest patch. Happy to go with a 
different direction if preferred.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Hides-directory-absolute-location-via-dired-hide-det.patch --]
[-- Type: text/x-patch; size=7.83KiB, Size: 8013 bytes --]

From 6702ccac4b818f77cb3d7afe4d002127ac2a77c6 Mon Sep 17 00:00:00 2001
From: xenodium <me+gh@xenodium.com>
Date: Tue, 23 Jul 2024 21:55:37 +0100
Subject: [PATCH] Hides directory absolute location via dired-hide-details-mode

---
 etc/NEWS                 |  6 +++++
 lisp/dired.el            | 47 ++++++++++++++++++++++++++++++++--------
 test/lisp/dired-tests.el | 44 +++++++++++++++++++++++++++++++++++++
 3 files changed, 88 insertions(+), 9 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index b89a80aa14d..51a4a658467 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -210,6 +210,12 @@ The host name for Kubernetes connections can be of kind
 used.  This overrides the setiing in 'tramp-kubernetes-namespace', if
 any.
 
+** Dired
+
++++
+*** New option 'dired-hide-details-hide-absolute-location', enabled by default.
+If non-nil, 'dired-hide-details-mode' also hides directories' absolute locations.
+
 \f
 * New Modes and Packages in Emacs 31.1
 
diff --git a/lisp/dired.el b/lisp/dired.el
index 0d526dfc376..18cde9f6e6a 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -387,6 +387,12 @@ dired-hide-details-hide-information-lines
   :version "24.4"
   :group 'dired)
 
+(defcustom dired-hide-details-hide-absolute-location t
+  "Non-nil means `dired-hide-details-mode' hides directory absolute location."
+  :type 'boolean
+  :version "31.1"
+  :group 'dired)
+
 (defcustom dired-always-read-filesystem nil
   "Non-nil means revert buffers visiting files before searching them.
 By default,  commands like `dired-mark-files-containing-regexp' will
@@ -1802,12 +1808,20 @@ dired-insert-directory
 	  (when (and (or hdr wildcard)
 		     (not (and (looking-at "^  \\(.*\\):$")
 			       (file-name-absolute-p (match-string 1)))))
-	    ;; Note that dired-build-subdir-alist will replace the name
-	    ;; by its expansion, so it does not matter whether what we insert
-	    ;; here is fully expanded, but it should be absolute.
-	    (insert "  " (or (car-safe dir-wildcard)
-                             (directory-file-name (file-name-directory dir)))
-                    ":\n")
+            (let* ((dir-indent "  ")
+                   (dir-name (or (car-safe dir-wildcard)
+                                 (directory-file-name (file-name-directory dir))))
+                   (dir-name-point (+ (point) (length dir-indent)))
+                   (hideable-location (and dired-hide-details-hide-absolute-location
+                                           (not (string-empty-p (file-name-nondirectory dir-name))))))
+	      ;; Inserted directory name must be absolute, but keep in mind it
+              ;; may be replaced in some instances (e.g. dired-build-subdir-alist).
+              (insert dir-indent dir-name ":\n")
+              (when hideable-location
+                (put-text-property dir-name-point
+                                   (+ dir-name-point
+                                      (length (file-name-directory dir-name)))
+                                   'invisible 'dired-hide-details-absolute-location)))
 	    (setq content-point (point)))
 	  (when wildcard
 	    ;; Insert "wildcard" line where "total" line would be for a full dir.
@@ -3243,8 +3257,9 @@ dired-hide-details-mode
 When this minor mode is enabled, details such as file ownership and
 permissions are hidden from view.
 
-See options: `dired-hide-details-hide-symlink-targets' and
-`dired-hide-details-hide-information-lines'."
+See options: `dired-hide-details-hide-symlink-targets',
+`dired-hide-details-hide-information-lines' and
+`dired-hide-details-hide-absolute-location'."
   :group 'dired
   (unless (derived-mode-p '(dired-mode wdired-mode))
     (error "Not a Dired buffer"))
@@ -3268,6 +3283,11 @@ dired-hide-details-update-invisibility-spec
 	       'add-to-invisibility-spec
 	     'remove-from-invisibility-spec)
 	   'dired-hide-details-information)
+  (funcall (if (and dired-hide-details-mode
+		    dired-hide-details-hide-absolute-location)
+	       #'add-to-invisibility-spec
+	     #'remove-from-invisibility-spec)
+	   'dired-hide-details-absolute-location)
   (funcall (if (and dired-hide-details-mode
 		    dired-hide-details-hide-symlink-targets
 		    (not (derived-mode-p 'wdired-mode)))
@@ -3674,7 +3694,16 @@ dired-build-subdir-alist
 				(substring new-dir-name (match-end 0)))
 		      (expand-file-name new-dir-name))))
 	    (delete-region (point) (match-end 1))
-	    (insert new-dir-name))
+            (let ((new-dir-name-pos (point))
+                  (hideable-location (and dired-hide-details-hide-absolute-location
+                                          (not (string-empty-p
+                                                (file-name-nondirectory new-dir-name))))))
+              (insert new-dir-name)
+              (when hideable-location
+                (put-text-property new-dir-name-pos
+                                   (+ new-dir-name-pos
+                                      (length (file-name-directory new-dir-name)))
+			           'invisible 'dired-hide-details-absolute-location))))
 	  (setq count (1+ count))
 	  ;; Undo any escaping of newlines and \ by dired-insert-directory.
 	  ;; Convert "n" preceded by odd number of \ to newline, and \\ to \.
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 3b1f80d3d3d..be0a8a36d84 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -524,6 +524,50 @@ dired-test-directory-files-and-attributes
       (when (file-directory-p testdir)
         (delete-directory testdir t)))))
 
+(ert-deftest dired-test-hide-absolute-location-enabled ()
+  "Test for https://debbugs.gnu.org/72272 ."
+  (let* ((dired-hide-details-hide-absolute-location t)
+         (dir-name (expand-file-name "lisp" source-directory))
+         (buffer (prog1 (dired (list dir-name "dired.el" "play"))
+                   (dired-insert-subdir (file-name-concat default-directory "play")))))
+    (unwind-protect
+        (progn
+          (goto-char (point-min))
+          (re-search-forward dired-subdir-regexp)
+          (goto-char (match-beginning 1))
+          (should (equal "lisp" (file-name-nondirectory
+                                 (directory-file-name (dired-get-subdir)))))
+          (should (equal 'dired-hide-details-absolute-location
+                         (get-text-property (match-beginning 1) 'invisible)))
+          (re-search-forward dired-subdir-regexp)
+          (goto-char (match-beginning 1))
+          (should (equal "play" (file-name-nondirectory
+                                 (directory-file-name (dired-get-subdir)))))
+          (should (equal 'dired-hide-details-absolute-location
+                         (get-text-property (match-beginning 1) 'invisible))))
+      (kill-buffer buffer))))
+
+(ert-deftest dired-test-hide-absolute-location-disabled ()
+  "Test for https://debbugs.gnu.org/72272 ."
+  (let* ((dired-hide-details-hide-absolute-location nil)
+         (dir-name (expand-file-name "lisp" source-directory))
+         (buffer (prog1 (dired (list dir-name "dired.el" "play"))
+                   (dired-insert-subdir (file-name-concat default-directory "play")))))
+    (unwind-protect
+        (progn
+          (goto-char (point-min))
+          (re-search-forward dired-subdir-regexp)
+          (goto-char (match-beginning 1))
+          (should (equal "lisp" (file-name-nondirectory
+                                 (directory-file-name (dired-get-subdir)))))
+          (should-not (get-text-property (match-beginning 1) 'invisible))
+          (re-search-forward dired-subdir-regexp)
+          (goto-char (match-beginning 1))
+          (should (equal "play" (file-name-nondirectory
+                                 (directory-file-name (dired-get-subdir)))))
+          (should-not (get-text-property (match-beginning 1) 'invisible)))
+      (kill-buffer buffer))))
+
 ;; `dired-insert-directory' output tests.
 (let* ((data-dir "insert-directory")
        (test-dir (file-name-as-directory
-- 
2.39.3 (Apple Git-146)