Subject: bug#67161: 30.0.50; [PATCH] Add option `dired-filename-display-length'

From: Liu Hui <[email-masked]>
Date: Mon, 20 Nov 2023 12:34:13 +0800

Eli Zaretskii <[email-masked]> 于2023年11月18日周六 18:55写道：

> If there are two different modes of using this function, the doc
> string could describe them both.  Currently, it only describes the use
> case where dired-filename-display-length is an integer, in which case
> it is a simple accessor.  The other use case is more subtle, and the
> doc string is completely silent about that, in particular it doesn't
> mention that point should be at the first character of the file name
> in that case.

Thanks for the explanation. I have updated the doc string as suggested.

> > BTW, I just find isearch doesn't handle hidden filenames based on
> > 'invisible' text property, which needs to be fixed. So maybe an
> > overlay-based approach is better? though I don't know if there is any
> > possible problem with using overlays for this feature. WDYT?
>
> Doesn't "M-x i" during isearch handle this?

No. I want to search text in hidden part rather than only in the
visible part, which is necessary for users to find relevant files even
if they are partly hidden.

Here is an example illustrating the problem:
1. emacs -Q
2. type M-: (insert "visible " (propertize "hidden" 'invisible t))
3. C-s hidden

isearch fails to match the invisible text by default, unless
search-invisible is changed to t. However, the default value of
search-invisible is open and it cannot be changed to t during isearch
by M-s i.

Therefore, I would like to change

  (put-text-property ell-beg (point) 'invisible 'dired-filename-hide)

to

  (let ((ov (make-overlay ell-beg (point))))
    (overlay-put ov 'invisible 'dired-filename-hide)
    (overlay-put ov 'isearch-open-invisible t)
    (overlay-put ov 'evaporate t))

in the attached patch, then text in hidden part can be matched
regardless of search-invisible being open or t. It also has a bonus
that hidden text can be revealed during isearch.

> > --- a/lisp/wdired.el
> > +++ b/lisp/wdired.el
> > @@ -261,6 +261,9 @@ wdired-change-to-wdired-mode
> >    (add-function :override (local 'revert-buffer-function) #'wdired-revert)
> >    (set-buffer-modified-p nil)
> >    (setq buffer-undo-list nil)
> > +  ;; remove filename invisibility spec to ensure filenames are visible
> > +  ;; for editing
>
> Comments should be complete sentences: begin with a capital letter and
> end with a period.  Also, please mention here the new defcustom you
> add to Dired, so that the comment could better explain itself.
>
> Thanks.

Fixed.
From 17a02e8af4502c84054fd7bac9d69f004d09d6a4 Mon Sep 17 00:00:00 2001
From: Liu Hui <[email-masked]>
Date: Mon, 20 Nov 2023 12:09:15 +0800
Subject: [PATCH] Add option `dired-filename-display-length'

* lisp/dired.el (dired-filename-display-length): New option.
(dired-insert-set-properties): Set invisibility spec for long
filenames.
(dired--get-ellipsis-length)
(dired--get-filename-display-length)
(dired-filename-update-invisibility-spec): New functions.
(dired-mode): Add filename invisibility spec.
(dired-make-directory-clickable):
(dired-kill-when-opening-new-dired-buffer):
(dired-hide-details-preserved-columns): Add missing group.
* lisp/wdired.el (wdired-change-to-wdired-mode)
(wdired-change-to-dired-mode): Update filename invisibility spec.
* etc/NEWS: Announce the change.
---
 etc/NEWS       |   7 +++
 lisp/dired.el  | 141 +++++++++++++++++++++++++++++++++++--------------
 lisp/wdired.el |   7 +++
 3 files changed, 114 insertions(+), 41 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 23f4a8b5311..ad9bda54b5e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -472,6 +472,13 @@ empty lines.  It also controls how to move point when encountering a
 boundary (e.g., if every line is visible, invoking 'dired-next-line'
 at the last line will move to the first line).  The default is nil.
 
+*** New user option 'dired-filename-display-length'.
+It is an integer representing the maximum display length of filenames.
+The middle part of filename whose length exceeds the restriction is
+hidden and an ellipsis is displayed instead.  A value of 'window'
+means using the right edge of window as the display restriction.  The
+default is nil.
+
 ** Ediff
 
 ---
diff --git a/lisp/dired.el b/lisp/dired.el
index 8919d2c223f..e1893b1e8f1 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -350,6 +350,7 @@ dired-after-readin-hook
 (defcustom dired-make-directory-clickable t
   "When non-nil, make the directory at the start of the dired buffer clickable."
   :version "29.1"
+  :group 'dired
   :type 'boolean)
 
 (defcustom dired-initial-position-hook nil
@@ -429,6 +430,7 @@ dired-mark-region
 (defcustom dired-kill-when-opening-new-dired-buffer nil
   "If non-nil, kill the current buffer when selecting a new directory."
   :type 'boolean
+  :group 'dired
   :version "28.1")
 
 (defcustom dired-guess-shell-case-fold-search t
@@ -515,6 +517,22 @@ dired-movement-style
 (defcustom dired-hide-details-preserved-columns nil
   "List of columns which are not hidden in `dired-hide-details-mode'."
   :type '(repeat integer)
+  :group 'dired
+  :version "30.1")
+
+(defcustom dired-filename-display-length nil
+  "If non-nil, restrict the display length of filenames.
+If the value is the symbol `window', the right edge of current
+window is used as the restriction.  Otherwise, it should be an
+integer representing the maximum filename length.
+
+The middle part of filename whose length exceeds the restriction
+is hidden by using the `invisible' property and an ellipsis is
+displayed instead."
+  :type '(choice (const   :tag "No restriction" nil)
+                 (const   :tag "Window" window)
+                 (integer :tag "Integer"))
+  :group 'dired
   :version "30.1")
 
 
@@ -1903,48 +1921,61 @@ dired-insert-set-properties
   "Add various text properties to the lines in the region, from BEG to END."
   (save-excursion
     (goto-char beg)
-    (while (< (point) end)
-      (ignore-errors
-	(if (not (dired-move-to-filename))
-	    (unless (or (looking-at-p "^$")
-			(looking-at-p dired-subdir-regexp))
-	      (put-text-property (line-beginning-position)
-				 (1+ (line-end-position))
-				 'invisible 'dired-hide-details-information))
-	  (save-excursion
-            (let ((end (1- (point)))
-                  (opoint (goto-char (1+ (pos-bol))))
-                  (i 0))
-              (put-text-property opoint end 'invisible 'dired-hide-details-detail)
-              (while (re-search-forward "[^ ]+" end t)
-                (when (member (cl-incf i) dired-hide-details-preserved-columns)
-                  (put-text-property opoint (point) 'invisible nil))
-                (setq opoint (point)))))
-          (let ((beg (point)) (end (save-excursion
-	                             (dired-move-to-end-of-filename)
-	                             (1- (point)))))
-            (if dired-click-to-select-mode
-                (put-text-property beg end 'keymap
-                                   dired-click-to-select-map)
-              (when (and dired-mouse-drag-files (fboundp 'x-begin-drag))
-                (put-text-property beg end 'keymap
-                                   dired-mouse-drag-files-map)))
-	    (add-text-properties
-	     beg (1+ end)
-	     `(mouse-face
-	       highlight
-	       dired-filename t
-	       help-echo ,(if dired-click-to-select-mode
-                              "mouse-2: mark or unmark this file"
-                            (if (and dired-mouse-drag-files
-                                     (fboundp 'x-begin-drag))
-                                "down-mouse-1: drag this file to another program
+    (let ((ell-len (dired--get-ellipsis-length)) maxlen filename-col)
+      (while (< (point) end)
+        (ignore-errors
+	  (if (not (dired-move-to-filename))
+	      (unless (or (looking-at-p "^$")
+			  (looking-at-p dired-subdir-regexp))
+	        (put-text-property (line-beginning-position)
+				   (1+ (line-end-position))
+				   'invisible 'dired-hide-details-information))
+	    (save-excursion
+              (let ((end (1- (point)))
+                    (opoint (goto-char (1+ (pos-bol))))
+                    (i 0))
+                (put-text-property opoint end 'invisible 'dired-hide-details-detail)
+                (while (re-search-forward "[^ ]+" end t)
+                  (when (member (cl-incf i) dired-hide-details-preserved-columns)
+                    (put-text-property opoint (point) 'invisible nil))
+                  (setq opoint (point)))))
+            (let ((beg (point)) (end (save-excursion
+	                               (dired-move-to-end-of-filename)
+	                               (1- (point)))))
+              (if dired-click-to-select-mode
+                  (put-text-property beg end 'keymap
+                                     dired-click-to-select-map)
+                (when (and dired-mouse-drag-files (fboundp 'x-begin-drag))
+                  (put-text-property beg end 'keymap
+                                     dired-mouse-drag-files-map)))
+              (when dired-filename-display-length
+                (let ((len (string-width (buffer-substring beg (1+ end))))
+                      ell-beg)
+                  (or maxlen (setq maxlen (dired--get-filename-display-length)))
+                  (when (and (integerp maxlen) (> len maxlen (+ ell-len 2)))
+                    (or filename-col (setq filename-col (current-column)))
+                    (move-to-column (+ filename-col (/ maxlen 2)))
+                    (setq ell-beg (point))
+                    (move-to-column (+ filename-col (/ maxlen 2)
+                                       (- len maxlen) ell-len))
+                    (put-text-property
+                     ell-beg (point) 'invisible 'dired-filename-hide))))
+	      (add-text-properties
+	       beg (1+ end)
+	       `(mouse-face
+	         highlight
+	         dired-filename t
+	         help-echo ,(if dired-click-to-select-mode
+                                "mouse-2: mark or unmark this file"
+                              (if (and dired-mouse-drag-files
+                                       (fboundp 'x-begin-drag))
+                                  "down-mouse-1: drag this file to another program
 mouse-2: visit this file in other window"
-                              "mouse-2: visit this file in other window"))))
-	    (when (< (+ end 5) (line-end-position))
-	      (put-text-property (+ end 5) (line-end-position)
-			         'invisible 'dired-hide-details-link)))))
-      (forward-line 1))))
+                                "mouse-2: visit this file in other window"))))
+	      (when (< (+ end 5) (line-end-position))
+	        (put-text-property (+ end 5) (line-end-position)
+			           'invisible 'dired-hide-details-link)))))
+        (forward-line 1)))))
 
 (defun dired--make-directory-clickable ()
   (save-excursion
@@ -1976,6 +2007,24 @@ dired--make-directory-clickable
                           "RET" click))))
           (setq segment-start (point)))))))
 
+(defun dired--get-ellipsis-length ()
+  "Return length of ellipsis."
+  (let* ((dt (or (window-display-table)
+                 buffer-display-table
+                 standard-display-table))
+         (glyphs (and dt (display-table-slot dt 'selective-display))))
+    (string-width (if glyphs (concat glyphs) "..."))))
+
+(defun dired--get-filename-display-length ()
+  "Return maximum display length of filename.
+When `dired-filename-display-length' is not an integer, the
+function actually returns the number of columns available for
+displaying the file names, and should be called with point at the
+first character of the file name."
+  (if (integerp dired-filename-display-length)
+      dired-filename-display-length
+    (- (window-max-chars-per-line) 1 (current-column))))
+
 
 ;;; Reverting a dired buffer
 
@@ -2617,6 +2666,7 @@ dired-mode
 	mode-line-buffer-identification
 	(propertized-buffer-identification "%17b"))
   (add-to-invisibility-spec '(dired . t))
+  (dired-filename-update-invisibility-spec)
   ;; Ignore dired-hide-details-* value of invisible text property by default.
   (when (eq buffer-invisibility-spec t)
     (setq buffer-invisibility-spec (list t)))
@@ -3106,6 +3156,15 @@ dired-hide-details-update-invisibility-spec
 
 ;;; Functions to hide/unhide text
 
+(defun dired-filename-update-invisibility-spec ()
+  "Update `buffer-invisibility-spec' for filenames.
+Specifically, the filename invisibility spec is added in Dired
+buffers and removed in WDired buffers."
+  (funcall (if (derived-mode-p 'dired-mode)
+               'add-to-invisibility-spec
+             'remove-from-invisibility-spec)
+           '(dired-filename-hide . t)))
+
 (defun dired--find-hidden-pos (start end)
   (text-property-any start end 'invisible 'dired))
 
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 079d93d6011..b5b01f0d089 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -261,6 +261,10 @@ wdired-change-to-wdired-mode
   (add-function :override (local 'revert-buffer-function) #'wdired-revert)
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
+  ;; Non-nil `dired-filename-display-length' may cause filenames to be
+  ;; hidden partly, so we remove filename invisibility spec
+  ;; temporarily to ensure filenames are visible for editing.
+  (dired-filename-update-invisibility-spec)
   (run-mode-hooks 'wdired-mode-hook)
   (message "%s" (substitute-command-keys
 		 "Press \\[wdired-finish-edit] when finished \
@@ -456,6 +460,9 @@ wdired-change-to-dired-mode
   (dired-sort-set-mode-line)
   (dired-advertise)
   (dired-hide-details-update-invisibility-spec)
+  ;; Restore filename invisibility spec that is removed in
+  ;; `wdired-change-to-wdired-mode'.
+  (dired-filename-update-invisibility-spec)
   (remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t)
   (remove-hook 'before-change-functions #'wdired--before-change-fn t)
   (remove-hook 'after-change-functions #'wdired--restore-properties t)
-- 
2.25.1