From: Liu Hui <liuhui1610@gmail.com>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 67161@debbugs.gnu.org, stefankangas@gmail.com, monnier@iro.umontreal.ca
Subject: bug#67161: 30.0.50; [PATCH] Add option `dired-filename-display-length'
Date: Wed, 22 Nov 2023 13:41:18 +0800 [thread overview]
Message-ID: <CAOQTW-OguzdSKKKm=UR5A+Kr=Z0FHSJE45a22yvRJiEf2Z-yuA@mail.gmail.com> (raw)
In-Reply-To: <CAOQTW-NN=nmvs5j6_AwMyrA8v9Zuo_vbn9KNKXPPsfn+J25gGA@mail.gmail.com>
[-- Attachment #1: Type: text/plain, Size: 616 bytes --]
> 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.
Since there is no objection to using overlay, I have updated the patch
accordingly with additional explanation. Thanks.
[-- Attachment #2: 0001-Add-option-dired-filename-display-length.patch --]
[-- Type: text/x-patch, Size: 12143 bytes --]
From f2fcbc4756e3beb270a89fe5db5d64e467cb6d1d Mon Sep 17 00:00:00 2001
From: Liu Hui <liuhui1610@gmail.com>
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 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.
---
etc/NEWS | 7 +++
lisp/dired.el | 151 +++++++++++++++++++++++++++++++++++--------------
lisp/wdired.el | 7 +++
3 files changed, 123 insertions(+), 42 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index e14d15a7487..b4a3014debd 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -487,6 +487,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 583cb2475e2..8812721bb3a 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")
\f
@@ -1900,51 +1918,72 @@ dired-click-to-select-mode
(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
@@ -1976,6 +2015,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))))
+
\f
;;; Reverting a dired buffer
@@ -2617,6 +2674,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 +3164,15 @@ dired-hide-details-update-invisibility-spec
\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 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
next prev parent reply other threads:[~2023-11-22 5:41 UTC|newest]
Thread overview: 37+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-11-14 9:52 bug#67161: 30.0.50; [PATCH] Add option `dired-filename-display-length' Liu Hui
2023-11-14 13:26 ` Eli Zaretskii
2023-11-15 10:04 ` Liu Hui
2023-11-15 12:32 ` Eli Zaretskii
2023-11-16 10:07 ` Liu Hui
2023-11-16 12:11 ` Eli Zaretskii
2023-11-18 9:23 ` Liu Hui
2023-11-18 10:55 ` Eli Zaretskii
2023-11-18 16:12 ` Drew Adams
2023-11-20 4:34 ` Liu Hui
2023-11-20 12:10 ` Eli Zaretskii
2023-11-20 17:54 ` Juri Linkov
2023-11-20 18:42 ` Eli Zaretskii
2023-11-20 18:55 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-20 19:17 ` Eli Zaretskii
2023-11-21 7:52 ` Juri Linkov
2023-11-21 11:55 ` Eli Zaretskii
2023-11-21 17:12 ` Juri Linkov
2023-11-20 17:20 ` Drew Adams
2023-11-22 5:41 ` Liu Hui [this message]
2023-11-25 10:52 ` Eli Zaretskii
2023-11-25 17:51 ` Juri Linkov
2023-11-25 20:02 ` Eli Zaretskii
2023-11-26 2:56 ` Liu Hui
2023-11-26 5:59 ` Eli Zaretskii
2023-11-26 10:49 ` Eli Zaretskii
2023-11-26 14:03 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-26 14:53 ` Eli Zaretskii
2023-11-26 17:08 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-26 17:58 ` Eli Zaretskii
2023-11-26 18:06 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-27 7:19 ` Juri Linkov
2023-11-27 8:32 ` Liu Hui
2023-11-27 17:16 ` Juri Linkov
2023-11-15 18:06 ` Drew Adams
2023-11-15 15:54 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-16 3:44 ` Liu Hui
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CAOQTW-OguzdSKKKm=UR5A+Kr=Z0FHSJE45a22yvRJiEf2Z-yuA@mail.gmail.com' \
--to=liuhui1610@gmail.com \
--cc=67161@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=monnier@iro.umontreal.ca \
--cc=stefankangas@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).