From 991ea588df6799331a7feea9e83493ef0d724096 Mon Sep 17 00:00:00 2001 From: Liu Hui 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