Add option `dired-filename-display-length'

* lisp/dired.el (dired-filename-display-length): New option.
(dired-insert-set-properties): Set invisible property 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.  (Bug#67161)

diff --git a/etc/NEWS b/etc/NEWS
index 259af667c03647dc0b94b788428dfe5a2ac44544..458e9e513de272fb64d533d3f0fa18ac7c90f23b 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -496,6 +496,13 @@ 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 a3d7c636d293dd569e9acac4d6b24493ee3fc255..23a6fc034e18d75d7c266a57a3b0595069b3cd6f 100644 (file)
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -350,6 +350,7 @@ with the buffer narrowed to the listing."
 (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 @@ is anywhere on its Dired line, except the beginning of the line."
 (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
@@ -516,6 +518,22 @@ Possible non-nil values:
 (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")
 
 \f
@@ -1901,51 +1919,72 @@ other marked file as well.  Otherwise, unmark all files."
 (defvar dired-click-to-select-map)
 
 (defun dired-insert-set-properties (beg end)
-  "Add various text properties to the lines in the region, from BEG to END."
+  "Add various text properties to the lines in the region, from BEG to END.
+Overlays could be added when some user options are enabled, e.g.,
+`dired-filename-display-length'."
+  (remove-overlays beg end 'invisible 'dired-filename-hide)
   (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))
+                    ;; Here we use overlays because isearch by default
+                    ;; doesn't support finding matches in hidden text
+                    ;; made invisible via text properties.
+                    (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)))))
+             (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
@@ -1977,6 +2016,24 @@ mouse-2: visit this file in other window"
                           "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))))
+
 \f
 ;;; Reverting a dired buffer
 
@@ -2618,6 +2675,7 @@ Keybindings:
        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)))
@@ -3117,6 +3175,15 @@ See options: `dired-hide-details-hide-symlink-targets' and
 \f
 ;;; 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 079d93d601124956814a16e7d18ff136e7b269b5..b5b01f0d089b21daf1abaa3ce805bcd04af1348e 100644 (file)
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -261,6 +261,10 @@ See `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 @@ non-nil means return old filename."
   (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)