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

From: Liu Hui <[email-masked]>
Date: Thu, 16 Nov 2023 18:07:04 +0800

Eli Zaretskii <[email-masked]> 于2023年11月15日周三 20:32写道：

> I actually wonder why we need it as a defcustom.  If you use
> truncate-string-ellipsis, you will get both a customizable setting and
> the correct string for the terminal at hand.  Why do we need an extra
> option?

As Stefan promptly pointed out, the ellipsis defcustom is actually
useless because the display of ellipsis is determined by the display
table. So I have deleted it in the attached patch.

> So you consider using the 'invisible' property a good feature?  I
> actually don't like using it for such purposes, as it gets in the way.

I don't know the drawback of the 'invisible' property. This patch is
inspired by dired-hide-details-mode, which uses the property to hide
file information.

> Btw, using string-width might not be the best possibility here.  I
> would recommend string-pixel-width instead (with subsequent division
> by what default-char-width returns), as that will produce a better
> approximation, especially on GUI frames.

I agree using pixel width is more accurate, though the approximation
based on character width is good enough in most cases. In fact, in
addition to string-width, move-to-column also needs to be replaced by
a function that moves the point to the character at a specific pixel
position. It seems there isn't such a built-in function.
From 991ea588df6799331a7feea9e83493ef0d724096 Mon Sep 17 00:00:00 2001
From: Liu Hui <[email-masked]>
Date: Tue, 14 Nov 2023 16:14:12 +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.
---
 lisp/dired.el  | 130 +++++++++++++++++++++++++++++++++----------------
 lisp/wdired.el |   2 +
 2 files changed, 91 insertions(+), 41 deletions(-)

diff --git a/lisp/dired.el b/lisp/dired.el
index 8919d2c223f..aad77a3dfc0 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,18 @@ 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, hide middle part of long filenames in Dired buffers.
+If the value is the symbol `window', then filenames are shortened
+to not exceed the right edge of current window.  Otherwise, it
+should be an integer representing the maximum filename length."
+  :type '(choice (const   :tag "Full" nil)
+                 (const   :tag "Window" window)
+                 (integer :tag "Integer"))
+  :group 'dired
   :version "30.1")
 
 
@@ -1903,48 +1917,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 +2003,20 @@ 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))))
+    (if glyphs (length glyphs) (eval-when-compile (length "...")))))
+
+(defun dired--get-filename-display-length ()
+  "Return maximum display length of filename."
+  (if (integerp dired-filename-display-length)
+      dired-filename-display-length
+    (- (window-max-chars-per-line) 1 (current-column))))
+
 
 ;;; Reverting a dired buffer
 
@@ -2617,6 +2658,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 +3148,12 @@ dired-hide-details-update-invisibility-spec
 
 ;;; Functions to hide/unhide text
 
+(defun dired-filename-update-invisibility-spec ()
+  (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..5d50a574290 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -261,6 +261,7 @@ wdired-change-to-wdired-mode
   (add-function :override (local 'revert-buffer-function) #'wdired-revert)
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
+  (dired-filename-update-invisibility-spec)
   (run-mode-hooks 'wdired-mode-hook)
   (message "%s" (substitute-command-keys
 		 "Press \\[wdired-finish-edit] when finished \
@@ -456,6 +457,7 @@ wdired-change-to-dired-mode
   (dired-sort-set-mode-line)
   (dired-advertise)
   (dired-hide-details-update-invisibility-spec)
+  (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