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: Mon, 05 Sep 2022 21:58:18 +0200 Message-ID: <875yi1iof9.fsf@gmail.com> References: <87r134ihdd.fsf@gmail.com> <877d4vfrzu.fsf@gmail.com> <87bkrtzkgm.fsf_-_@gnus.org> 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="15590"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 56345@debbugs.gnu.org To: Lars Ingebrigtsen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Sep 05 21:59:11 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 1oVIFS-0003sx-6l for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 05 Sep 2022 21:59:10 +0200 Original-Received: from localhost ([::1]:55344 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oVIFQ-0006YL-QM for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 05 Sep 2022 15:59:08 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:42244) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oVIFK-0006Y5-F1 for bug-gnu-emacs@gnu.org; Mon, 05 Sep 2022 15:59:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:60325) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oVIFK-000117-5l for bug-gnu-emacs@gnu.org; Mon, 05 Sep 2022 15:59:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oVIFJ-0000u7-UF for bug-gnu-emacs@gnu.org; Mon, 05 Sep 2022 15:59:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Thuna Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 05 Sep 2022 19:59:01 +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.16624079153440 (code B ref 56345); Mon, 05 Sep 2022 19:59:01 +0000 Original-Received: (at 56345) by debbugs.gnu.org; 5 Sep 2022 19:58:35 +0000 Original-Received: from localhost ([127.0.0.1]:49024 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oVIEs-0000tO-ES for submit@debbugs.gnu.org; Mon, 05 Sep 2022 15:58:35 -0400 Original-Received: from mail-ej1-f42.google.com ([209.85.218.42]:44987) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oVIEq-0000tC-Gw for 56345@debbugs.gnu.org; Mon, 05 Sep 2022 15:58:33 -0400 Original-Received: by mail-ej1-f42.google.com with SMTP id kk26so18906818ejc.11 for <56345@debbugs.gnu.org>; Mon, 05 Sep 2022 12:58:32 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=mime-version:message-id:date:references:in-reply-to:subject:cc:to :from:from:to:cc:subject:date; bh=6aG83/RGOTwdh5vvG4JW36nRYOif/2mcJmGMz7cQp8Y=; b=EProwkrFuBxJYu2KaP4zmFWTqJ1j7I73mWBUE3h8RtJbi3bD7frpTVuKsBvrR169wj CT7eIRr+MRN3hRcU6hyz5FVMiyA8O/p90dzg7pPZlSsfVi3Y7TNkoxJ8X6dP5Y0q06PJ n54U1/9YtgiB+Q96PcE5mAsdVsAZPrp99UtMKAcxIV3Hj/Yfkdmb/HlYsbW5ddv6zBzF pa2uCcOXj39nsyIla2y4cTaiUtooEYPPetFJhpOxp97NSBLCGkki24XWGOh/qwyqxorw FDCoRIcmXaZlR/bhGGL6R9tGNrAGGk+lBI2ekS6dJqkx9DBVccC1YrR1RgHTprHUY4c/ 39Xw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=mime-version:message-id:date:references:in-reply-to:subject:cc:to :from:x-gm-message-state:from:to:cc:subject:date; bh=6aG83/RGOTwdh5vvG4JW36nRYOif/2mcJmGMz7cQp8Y=; b=jZ7GsewfcJfcp/5hKBvYVxyRqEss0pERLMADkmJ1xB8xn7MqOhT7gsN73w0h4c32Nn wXeKYDZ19GVZPFoN8C+3Jiu/z9PzKCsS+0nrcT7H4j+qX3OtG7EgczzvP2C6jxlrpYCV k+qcGUsH3fsdW+GFAxK1o31yiQAHwRzibKW5SuEKAkwKfUmDoCd4ilkcj8aOrGPPJgqs WpFDwHLzpwkcKVTjHO/ZIJ0TCICuoJP7zdKTFhWbLW3cIKXYm+vd2ZiR5E9rzRda4MCi fBn/+oER0UvCAEIkbLLw/RCOV9S8+E3n6LJPTfEVH9C7oUHDbhy77igABoqGcnlHOihO ftEQ== X-Gm-Message-State: ACgBeo16746j4k4E5z9EKrMk13D8EBS40Be/a4dGLTrN1sgb2fC1MOsc srOC6NdOJFP/jDuRJgy8cxg7rQO4E3w= X-Google-Smtp-Source: AA6agR5GPQtNSbQdzz258rmDl5wehjJCSse7e47to/+gD/A5lCYIu6S66xv6nvpMLsyV172IjO6h4Q== X-Received: by 2002:a17:907:75dc:b0:730:9c68:9a2e with SMTP id jl28-20020a17090775dc00b007309c689a2emr38555783ejc.22.1662407906297; Mon, 05 Sep 2022 12:58:26 -0700 (PDT) Original-Received: from thuna (eduroam-049.unibocconi.it. [90.147.70.49]) by smtp.gmail.com with ESMTPSA id 21-20020a170906301500b00738467f743dsm5393036ejz.5.2022.09.05.12.58.25 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 05 Sep 2022 12:58:25 -0700 (PDT) In-Reply-To: <87bkrtzkgm.fsf_-_@gnus.org> 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: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:241600 Archived-At: --=-=-= Content-Type: text/plain This should be all the previous patches merged into a single one. I don't mind signing the papers, but I have a few questions about it, where do I send them? --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Add-column-hiding-to-tabulated-list-mode.patch Content-Description: single patch >From 2a5b5759de4d3acd0104cb1c9e9f75130f0c58e9 Mon Sep 17 00:00:00 2001 From: Thuna Date: Fri, 1 Jul 2022 18:19:52 +0300 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-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 | 271 +++++++++++++++++------------- 1 file changed, 151 insertions(+), 120 deletions(-) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 9868d8c4ec..a24b051d9c 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'. @@ -285,7 +291,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 +299,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 +538,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 +574,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 +750,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 +768,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 --=-=-=--