unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#56345: 29.0.50; [PATCH] Add column hiding to tabulated-list
@ 2022-07-01 22:43 Thuna
  2022-07-02  6:06 ` Eli Zaretskii
                   ` (3 more replies)
  0 siblings, 4 replies; 21+ messages in thread
From: Thuna @ 2022-07-01 22:43 UTC (permalink / raw)
  To: 56345

[-- 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.

^ permalink raw reply related	[flat|nested] 21+ messages in thread

end of thread, other threads:[~2022-11-25  8:17 UTC | newest]

Thread overview: 21+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-01 22:43 bug#56345: 29.0.50; [PATCH] Add column hiding to tabulated-list Thuna
2022-07-02  6:06 ` 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

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).