From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Thuna Newsgroups: gmane.emacs.bugs Subject: bug#56345: 29.0.50; [PATCH] Add column hiding to tabulated-list Date: Fri, 28 Oct 2022 01:12:03 +0200 Message-ID: <871qqsuaik.fsf@gmail.com> References: <87r134ihdd.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="4420"; mail-complaints-to="usenet@ciao.gmane.io" To: 56345@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Oct 28 01:13:41 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1ooC4D-00010Q-55 for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 28 Oct 2022 01:13:41 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ooC3d-0003Uz-07; Thu, 27 Oct 2022 19:13:05 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ooC3b-0003U2-5F for bug-gnu-emacs@gnu.org; Thu, 27 Oct 2022 19:13:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ooC3a-0004Kd-TJ for bug-gnu-emacs@gnu.org; Thu, 27 Oct 2022 19:13:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ooC3a-0006OJ-F6 for bug-gnu-emacs@gnu.org; Thu, 27 Oct 2022 19:13:02 -0400 X-Loop: help-debbugs@gnu.org In-Reply-To: <87r134ihdd.fsf@gmail.com> Resent-From: Thuna Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 27 Oct 2022 23:13:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56345 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch moreinfo Original-Received: via spool by 56345-submit@debbugs.gnu.org id=B56345.166691233524512 (code B ref 56345); Thu, 27 Oct 2022 23:13:02 +0000 Original-Received: (at 56345) by debbugs.gnu.org; 27 Oct 2022 23:12:15 +0000 Original-Received: from localhost ([127.0.0.1]:59688 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ooC2o-0006NH-Tr for submit@debbugs.gnu.org; Thu, 27 Oct 2022 19:12:15 -0400 Original-Received: from mail-ed1-f50.google.com ([209.85.208.50]:37830) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ooC2m-0006N3-2A for 56345@debbugs.gnu.org; Thu, 27 Oct 2022 19:12:13 -0400 Original-Received: by mail-ed1-f50.google.com with SMTP id l11so4254677edb.4 for <56345@debbugs.gnu.org>; Thu, 27 Oct 2022 16:12:12 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=mime-version:message-id:date:subject:to:from:from:to:cc:subject :date:message-id:reply-to; bh=GZe+1UwnisvIRAPi7xPO7xB5JFtf6Q1iT0wsxjUbwFA=; b=Az30NvOcqhHV3mvh+fqkAzqHd64mhT5HnzAdKbwU7wcjyVG8gVmjH3CHbcZWBMSTHz CDtez54aoArS4mCZcmESx80FhWdTZt8WYISG2YOCl0o9ksfa612/6dGKJ/bo2aktkY1M ylfzgDWuCO1oyKB/bbZXEFFM21FvrNPQJfundfbeP3Dwgxjg5Odr+vjh/S/gQryPMPbU pQe8diZHJZN0ZvC8XaV6PPbAkq/NAa0zd9jiGkSOsn8cTvbVpPx20D26H2+PMZRhsgZn UckEXlyzs6p1wBj5vlxtHz3R70VyJZwCjkf8HuR3SRsbKGov4znyRW7PMJ13Ixab1+Ho 22WQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=mime-version:message-id:date:subject:to:from:x-gm-message-state :from:to:cc:subject:date:message-id:reply-to; bh=GZe+1UwnisvIRAPi7xPO7xB5JFtf6Q1iT0wsxjUbwFA=; b=CSd2JBgftHcAAwrf378xk9shgBXDpTdKC1gRZB1DB9onLzvXBAIvraEQgxmWf8zoMT 3iTQ8M4RhTN7Ie5cdY1hE4ZMYrQBB5vwS5BBode+VwrCRnjbjavVLhN44SoTskBqUATq ffzXe7Y+iOCTyGJrrWm/BkhwPy6WmgLP18NaAguNpULeU5N/ANWFH0TGu3WdMTJgVi9U RtAxY1c31SACrlAEJByROSarBmDSMtR7/TgpbsKkcrUQgkVC901h+8SaHbbTS0lTlJvl HxTwA1+AIMZKQ+xF34SPgyQpqV7XBwo4brQMWMT7N1cKkao3M+w4m1lXg/94sgQz3DJr YVGA== X-Gm-Message-State: ACrzQf2+7c+OpRZ6D22lXL6otisfff7ARx3NeXj1lR+Fu9PTdsCjc+xc lpefirQsxgH7nS5cBMfazwMAs5ZD3ps= X-Google-Smtp-Source: AMsMyM7abMOe7/uZaJADsgZHzHWlwvNJE09q7j0jKJnPqXwl5kkmF7yP3k6QcPQ0u+esGCo9+L2r8A== X-Received: by 2002:a05:6402:84d:b0:454:f41d:6ccf with SMTP id b13-20020a056402084d00b00454f41d6ccfmr47729611edz.129.1666912325827; Thu, 27 Oct 2022 16:12:05 -0700 (PDT) Original-Received: from thuna ([90.147.71.254]) by smtp.gmail.com with ESMTPSA id f30-20020a170906739e00b0078e05db7005sm1312035ejl.214.2022.10.27.16.12.04 for <56345@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 27 Oct 2022 16:12:04 -0700 (PDT) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: "bug-gnu-emacs" Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:246379 Archived-At: --=-=-= Content-Type: text/plain I fixed and improved a couple things (though the assignment is still pending). Namely, the commands are actually bound in `tabulated-list-mode-map' and the command `tabulated-list-make-column-visible' is renamed to `tabulated-list-unhide-column'. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Add-column-hiding-to-tabulated-list-mode.patch Content-Description: The new and improved patch >From 97e8d9e0dcc41bd32112072e0ff47ae703792378 Mon Sep 17 00:00:00 2001 From: Thuna Date: Tue, 11 Oct 2022 22:17:15 +0200 Subject: [PATCH] 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-unhide-column' 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 c01f3fd4fe..d86f4de5f5 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'. @@ -227,6 +233,8 @@ tabulated-list-mode-map "S" #'tabulated-list-sort "}" #'tabulated-list-widen-current-column "{" #'tabulated-list-narrow-current-column + "." #'tabulated-list-hide-current-column + "+" #'tabulated-list-unhide-column "" 'mouse-face "" #'mouse-select-window) @@ -285,7 +293,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) @@ -293,62 +301,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)) @@ -530,15 +540,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) @@ -552,50 +576,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. @@ -726,38 +752,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. @@ -766,6 +770,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-unhide-column (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 --=-=-=--