From: Thuna <thuna.cing@gmail.com>
To: 56345@debbugs.gnu.org
Subject: bug#56345: 29.0.50; [PATCH] Add column hiding to tabulated-list
Date: Sat, 02 Jul 2022 01:43:26 +0300 [thread overview]
Message-ID: <87r134ihdd.fsf@gmail.com> (raw)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Actual patch --]
[-- Type: text/x-patch, Size: 16965 bytes --]
From b49d5876afa3d969ce82df0d723a8a8b766009a0 Mon Sep 17 00:00:00 2001
From: Thuna <thuna.cing@gmail.com>
Date: Fri, 1 Jul 2022 18:19:52 +0300
Subject: [PATCH 1/2] Add column hiding to tabulated-list-mode
Add the keyword `:hidden' to `tabulated-list-format' for controlling
the visibility of a specific column.
Introduce the commands `tabulated-list-hide-current-column' and
`tabulated-list-make-column-visible' for interactively changing the
`:hidden' property of the column. The commands are bound to "." and
"+" respectively.
Change calculations involving other columns to account for the
`:hidden' property.
Make the current column calculation into its own function named
`tabulated-list-get-column'. Make `tabulated-list-widen-current-column'
use that instead. Use the text property `tabulated-list-column-name'
to find the current tabulated-list column instead of `current-column'.
---
lisp/emacs-lisp/tabulated-list.el | 273 +++++++++++++++++-------------
1 file changed, 153 insertions(+), 120 deletions(-)
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 7d815a3ced..868ed141ec 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -104,7 +104,8 @@ tabulated-list-format
Currently supported properties are:
- `:right-align': If non-nil, the column should be right-aligned.
- `:pad-right': Number of additional padding spaces to the
- right of the column (defaults to 1 if omitted).")
+ right of the column (defaults to 1 if omitted).
+ - `:hidden': If non-nil, the column should not be visible.")
(put 'tabulated-list-format 'permanent-local t)
(defvar-local tabulated-list-use-header-line t
@@ -179,6 +180,11 @@ tabulated-list-get-entry
no entry at POS. POS, if omitted or nil, defaults to point."
(get-text-property (or pos (point)) 'tabulated-list-entry))
+(defun tabulated-list-get-column (&optional pos)
+ "Return the column name of the Tabulated List cell at POS.
+POS, if omitted or nil, defaults to point."
+ (get-text-property (or pos (point)) 'tabulated-list-column-name))
+
(defun tabulated-list-put-tag (tag &optional advance)
"Put TAG in the padding area of the current line.
TAG should be a string, with length <= `tabulated-list-padding'.
@@ -228,6 +234,8 @@ tabulated-list-mode-map
(define-key map "S" 'tabulated-list-sort)
(define-key map "}" 'tabulated-list-widen-current-column)
(define-key map "{" 'tabulated-list-narrow-current-column)
+ (define-key map "." 'tabulated-list-hide-current-column)
+ (define-key map "+" 'tabulated-list-make-column-visible)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'mouse-select-window)
map)
@@ -290,7 +298,7 @@ tabulated-list-init-header
cols)
(dotimes (n len)
(let* ((col (aref tabulated-list-format n))
- (not-last-col (< n (1- len)))
+ (not-last-col (tabulated-list--next-visible-column n))
(label (nth 0 col))
(lablen (length label))
(pname label)
@@ -298,62 +306,64 @@ tabulated-list-init-header
(props (nthcdr 3 col))
(pad-right (or (plist-get props :pad-right) 1))
(right-align (plist-get props :right-align))
+ (hidden (plist-get props :hidden))
(next-x (+ x pad-right width))
(available-space
(and not-last-col
(if right-align
width
(tabulated-list--available-space width n)))))
- (when (and (>= lablen 3)
- not-last-col
- (> lablen available-space))
- (setq label (truncate-string-to-width label available-space
- nil nil t)))
- (push
- (cond
- ;; An unsortable column
- ((not (nth 2 col))
- (propertize label 'tabulated-list-column-name pname))
- ;; The selected sort column
- ((equal (car col) (car tabulated-list-sort-key))
- (apply 'propertize
- (concat label
- (cond
- ((and (< lablen 3) not-last-col) "")
- ((cdr tabulated-list-sort-key)
- (format " %c"
- tabulated-list-gui-sort-indicator-desc))
- (t (format " %c"
- tabulated-list-gui-sort-indicator-asc))))
- 'face 'bold
- 'tabulated-list-column-name pname
- button-props))
- ;; Unselected sortable column.
- (t (apply 'propertize label
- 'tabulated-list-column-name pname
- button-props)))
- cols)
- (when right-align
- (let ((shift (- width (string-width (car cols)))))
- (when (> shift 0)
- (setq cols
- (cons (car cols)
- (cons
- (propertize
- (make-string shift ?\s)
- 'display
- `(space :align-to
- (+ header-line-indent-width ,(+ x shift))))
- (cdr cols))))
- (setq x (+ x shift)))))
- (if (>= pad-right 0)
- (push (propertize
- " "
- 'display `(space :align-to
- (+ header-line-indent-width ,next-x))
- 'face 'fixed-pitch)
- cols))
- (setq x next-x)))
+ (unless hidden
+ (when (and (>= lablen 3)
+ not-last-col
+ (> lablen available-space))
+ (setq label (truncate-string-to-width label available-space
+ nil nil t)))
+ (push
+ (cond
+ ;; An unsortable column
+ ((not (nth 2 col))
+ (propertize label 'tabulated-list-column-name pname))
+ ;; The selected sort column
+ ((equal (car col) (car tabulated-list-sort-key))
+ (apply 'propertize
+ (concat label
+ (cond
+ ((and (< lablen 3) not-last-col) "")
+ ((cdr tabulated-list-sort-key)
+ (format " %c"
+ tabulated-list-gui-sort-indicator-desc))
+ (t (format " %c"
+ tabulated-list-gui-sort-indicator-asc))))
+ 'face 'bold
+ 'tabulated-list-column-name pname
+ button-props))
+ ;; Unselected sortable column.
+ (t (apply 'propertize label
+ 'tabulated-list-column-name pname
+ button-props)))
+ cols)
+ (when right-align
+ (let ((shift (- width (string-width (car cols)))))
+ (when (> shift 0)
+ (setq cols
+ (cons (car cols)
+ (cons
+ (propertize
+ (make-string shift ?\s)
+ 'display
+ `(space :align-to
+ (+ header-line-indent-width ,(+ x shift))))
+ (cdr cols))))
+ (setq x (+ x shift)))))
+ (if (>= pad-right 0)
+ (push (propertize
+ " "
+ 'display `(space :align-to
+ (+ header-line-indent-width ,next-x))
+ 'face 'fixed-pitch)
+ cols))
+ (setq x next-x))))
(setq cols (apply 'concat (nreverse cols)))
(if tabulated-list-use-header-line
(setq header-line-format (list "" 'header-line-indent cols))
@@ -535,15 +545,29 @@ tabulated-list-print-entry
beg (point)
`(tabulated-list-id ,id tabulated-list-entry ,cols))))
+(defun tabulated-list--next-visible-column (n)
+ (let ((len (length tabulated-list-format))
+ (col-nb (1+ n))
+ found)
+ (while (and (< col-nb len)
+ (not found))
+ (if (plist-get (nthcdr 3 (aref tabulated-list-format col-nb))
+ :hidden)
+ (setq col-nb (1+ col-nb))
+ (setq found t)))
+ (when (< col-nb len)
+ col-nb)))
+
(defun tabulated-list--available-space (width n)
- (let* ((next-col-format (aref tabulated-list-format (1+ n)))
+ (let* ((next-col (tabulated-list--next-visible-column n))
+ (next-col-format (aref tabulated-list-format next-col))
(next-col-right-align (plist-get (nthcdr 3 next-col-format)
:right-align))
(next-col-width (nth 1 next-col-format)))
(if next-col-right-align
(- (+ width next-col-width)
(min next-col-width
- (tabulated-list--col-local-max-widths (1+ n))))
+ (tabulated-list--col-local-max-widths next-col)))
width)))
(defun tabulated-list-print-col (n col-desc x)
@@ -557,50 +581,52 @@ tabulated-list-print-col
(props (nthcdr 3 format))
(pad-right (or (plist-get props :pad-right) 1))
(right-align (plist-get props :right-align))
+ (hidden (plist-get props :hidden))
(label (cond ((stringp col-desc) col-desc)
((eq (car col-desc) 'image) " ")
(t (car col-desc))))
(label-width (string-width label))
(help-echo (concat (car format) ": " label))
(opoint (point))
- (not-last-col (< (1+ n) (length tabulated-list-format)))
+ (not-last-col (tabulated-list--next-visible-column n))
(available-space (and not-last-col
(if right-align
width
(tabulated-list--available-space width n)))))
- ;; Truncate labels if necessary (except last column).
- ;; Don't truncate to `width' if the next column is align-right
- ;; and has some space left, truncate to `available-space' instead.
- (when (and not-last-col
- (> label-width available-space))
- (setq label (truncate-string-to-width
- label available-space nil nil t t)
- label-width available-space))
- (setq label (bidi-string-mark-left-to-right label))
- (when (and right-align (> width label-width))
- (let ((shift (- width label-width)))
- (insert (propertize (make-string shift ?\s)
- 'display `(space :align-to ,(+ x shift))))
- (setq width (- width shift))
- (setq x (+ x shift))))
- (cond ((stringp col-desc)
- (insert (if (get-text-property 0 'help-echo label)
- label
- (propertize label 'help-echo help-echo))))
- ((eq (car col-desc) 'image)
- (insert (propertize " "
- 'display col-desc
- 'help-echo help-echo)))
- ((apply 'insert-text-button label (cdr col-desc))))
- (let ((next-x (+ x pad-right width)))
- ;; No need to append any spaces if this is the last column.
- (when not-last-col
- (when (> pad-right 0) (insert (make-string pad-right ?\s)))
- (insert (propertize
- (make-string (- width (min width label-width)) ?\s)
- 'display `(space :align-to ,next-x))))
- (put-text-property opoint (point) 'tabulated-list-column-name name)
- next-x)))
+ (if hidden x
+ ;; Truncate labels if necessary (except last column).
+ ;; Don't truncate to `width' if the next column is align-right
+ ;; and has some space left, truncate to `available-space' instead.
+ (when (and not-last-col
+ (> label-width available-space))
+ (setq label (truncate-string-to-width
+ label available-space nil nil t t)
+ label-width available-space))
+ (setq label (bidi-string-mark-left-to-right label))
+ (when (and right-align (> width label-width))
+ (let ((shift (- width label-width)))
+ (insert (propertize (make-string shift ?\s)
+ 'display `(space :align-to ,(+ x shift))))
+ (setq width (- width shift))
+ (setq x (+ x shift))))
+ (cond ((stringp col-desc)
+ (insert (if (get-text-property 0 'help-echo label)
+ label
+ (propertize label 'help-echo help-echo))))
+ ((eq (car col-desc) 'image)
+ (insert (propertize " "
+ 'display col-desc
+ 'help-echo help-echo)))
+ ((apply 'insert-text-button label (cdr col-desc))))
+ (let ((next-x (+ x pad-right width)))
+ ;; No need to append any spaces if this is the last column.
+ (when not-last-col
+ (when (> pad-right 0) (insert (make-string pad-right ?\s)))
+ (insert (propertize
+ (make-string (- width (min width label-width)) ?\s)
+ 'display `(space :align-to ,next-x))))
+ (put-text-property opoint (point) 'tabulated-list-column-name name)
+ next-x))))
(defun tabulated-list-delete-entry ()
"Delete the Tabulated List entry at point.
@@ -731,38 +757,16 @@ tabulated-list-widen-current-column
Interactively, N is the prefix numeric argument, and defaults to
1."
(interactive "p")
- (let ((start (current-column))
- (entry (tabulated-list-get-entry))
- (nb-cols (length tabulated-list-format))
- (col-nb 0)
- (total-width 0)
- (found nil)
- col-width)
- (while (and (not found)
- (< col-nb nb-cols))
- (if (>= start
- (setq total-width
- (+ total-width
- (max (setq col-width
- (cadr (aref tabulated-list-format
- col-nb)))
- (let ((desc (aref entry col-nb)))
- (string-width (if (stringp desc)
- desc
- (car desc)))))
- (or (plist-get (nthcdr 3 (aref tabulated-list-format
- col-nb))
- :pad-right)
- 1))))
- (setq col-nb (1+ col-nb))
- (setq found t)
- ;; `tabulated-list-format' may be a constant (sharing list
- ;; structures), so copy it before mutating.
- (setq tabulated-list-format (copy-tree tabulated-list-format t))
- (setf (cadr (aref tabulated-list-format col-nb))
- (max 1 (+ col-width n)))
- (tabulated-list-print t)
- (tabulated-list-init-header)))))
+ (let* ((col-nb (tabulated-list--column-number
+ (tabulated-list-get-column)))
+ (col-width (cadr (aref tabulated-list-format col-nb))))
+ ;; `tabulated-list-format' may be a constant (sharing list
+ ;; structures), so copy it before mutating.
+ (setq tabulated-list-format (copy-tree tabulated-list-format t))
+ (setf (cadr (aref tabulated-list-format col-nb))
+ (max 1 (+ col-width n)))
+ (tabulated-list-print t)
+ (tabulated-list-init-header)))
(defun tabulated-list-narrow-current-column (&optional n)
"Narrow the current tabulated list column by N chars.
@@ -771,6 +775,35 @@ tabulated-list-narrow-current-column
(interactive "p")
(tabulated-list-widen-current-column (- n)))
+(defun tabulated-list-hide-current-column ()
+ "Hide the current tabulated list column."
+ (interactive)
+ (let ((col-nb (tabulated-list--column-number
+ (tabulated-list-get-column))))
+ (setf (nthcdr 3 (aref tabulated-list-format col-nb))
+ (plist-put (nthcdr 3 (aref tabulated-list-format col-nb))
+ :hidden t)))
+ (tabulated-list-init-header)
+ (tabulated-list-print t t))
+
+(defun tabulated-list-make-column-visible (name)
+ "Make the tabulated list column NAME visible.
+Interactively, NAME is a hidden column propmted for with
+`completing-read'."
+ (interactive
+ (list
+ (completing-read "Colummn name: "
+ (append tabulated-list-format nil)
+ (lambda (col)
+ (plist-get (nthcdr 3 col) :hidden))
+ t)))
+ (let ((col-nb (tabulated-list--column-number name)))
+ (setf (nthcdr 3 (aref tabulated-list-format col-nb))
+ (plist-put (nthcdr 3 (aref tabulated-list-format col-nb))
+ :hidden nil)))
+ (tabulated-list-init-header)
+ (tabulated-list-print t t))
+
(defun tabulated-list-next-column (&optional arg)
"Go to the start of the next column after point on the current line.
If ARG is provided, move that many columns."
--
2.35.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: fix --]
[-- Type: text/x-patch, Size: 1723 bytes --]
From 3348b627bc1ad8d0d187a0c8bd0ce45f6a769d33 Mon Sep 17 00:00:00 2001
From: Thuna <thuna.cing@gmail.com>
Date: Sat, 2 Jul 2022 00:03:38 +0300
Subject: [PATCH 2/2] Fix `tabulated-list-format' sharing list structures
* tabulated-list.el (tabulated-list-hide-current-column
tabulated-list-make-column-visible): Copy tabulated-list-format
recursively before mutating it.
---
lisp/emacs-lisp/tabulated-list.el | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 868ed141ec..4e0b3b9e95 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -780,6 +780,9 @@ tabulated-list-hide-current-column
(interactive)
(let ((col-nb (tabulated-list--column-number
(tabulated-list-get-column))))
+ ;; `tabulated-list-format' may be a constant (sharing list
+ ;; structures), so copy it before mutating.
+ (setq tabulated-list-format (copy-tree tabulated-list-format t))
(setf (nthcdr 3 (aref tabulated-list-format col-nb))
(plist-put (nthcdr 3 (aref tabulated-list-format col-nb))
:hidden t)))
@@ -798,6 +801,9 @@ tabulated-list-make-column-visible
(plist-get (nthcdr 3 col) :hidden))
t)))
(let ((col-nb (tabulated-list--column-number name)))
+ ;; `tabulated-list-format' may be a constant (sharing list
+ ;; structures), so copy it before mutating.
+ (setq tabulated-list-format (copy-tree tabulated-list-format t))
(setf (nthcdr 3 (aref tabulated-list-format col-nb))
(plist-put (nthcdr 3 (aref tabulated-list-format col-nb))
:hidden nil)))
--
2.35.1
[-- Attachment #3: Type: text/plain, Size: 469 bytes --]
The attached patches introduce column hiding to tabulated-list-mode,
which works by adding the keyword `:hidden' to `tabulated-list-format'.
Patch 0001 is the actual patch itself while 0002 is a bug fix. 0001
compiled fine for me but I did not test 0002, though it should be
perfectly safe.
I went through tabulated-list.el and fixed everything I could find that
would be affected by the visibility of columns. I don't believe I
missed anything but it is possible.
next reply other threads:[~2022-07-01 22:43 UTC|newest]
Thread overview: 21+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-07-01 22:43 Thuna [this message]
2022-07-02 6:06 ` bug#56345: 29.0.50; [PATCH] Add column hiding to tabulated-list Eli Zaretskii
2022-07-02 15:34 ` bug#56345: Typo fix and convenience function Thuna
2022-09-05 19:31 ` bug#56345: 29.0.50; [PATCH] Add column hiding to tabulated-list Lars Ingebrigtsen
2022-09-05 19:58 ` Thuna
2022-09-06 10:07 ` Lars Ingebrigtsen
2022-09-06 13:59 ` Thuna
2022-09-07 3:23 ` Michael Heerdegen
2022-09-07 12:41 ` Lars Ingebrigtsen
2022-09-08 5:53 ` Michael Heerdegen
2022-09-07 12:42 ` Lars Ingebrigtsen
2022-09-07 12:50 ` Thuna
2022-09-07 12:52 ` Lars Ingebrigtsen
2022-11-25 1:26 ` Stefan Kangas
2022-11-25 7:58 ` Thuna
2022-11-25 8:17 ` Eli Zaretskii
2022-09-07 15:35 ` Drew Adams
2022-09-07 10:37 ` Thuna
2022-09-08 5:57 ` Michael Heerdegen
2022-09-08 18:14 ` Jean Louis
2022-10-27 23:12 ` Thuna
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87r134ihdd.fsf@gmail.com \
--to=thuna.cing@gmail.com \
--cc=56345@debbugs.gnu.org \
/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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.