From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.devel Subject: tabulated-list: extend truncation into next align-right col Date: Tue, 1 Nov 2016 02:41:00 +0900 (JST) Message-ID: NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; format=flowed; charset=US-ASCII X-Trace: blaine.gmane.org 1477937336 17585 195.159.176.226 (31 Oct 2016 18:08:56 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 31 Oct 2016 18:08:56 +0000 (UTC) User-Agent: Alpine 2.20 (DEB 67 2015-01-07) Cc: Tino Calancha , Emacs developers To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Oct 31 19:08:52 2016 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1c1H0F-0007rz-1Y for ged-emacs-devel@m.gmane.org; Mon, 31 Oct 2016 19:08:11 +0100 Original-Received: from localhost ([::1]:37605 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1c1H0H-0004aE-Jv for ged-emacs-devel@m.gmane.org; Mon, 31 Oct 2016 14:08:13 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37897) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1c1Ga6-0004jJ-DM for emacs-devel@gnu.org; Mon, 31 Oct 2016 13:41:11 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1c1Ga2-00041d-EQ for emacs-devel@gnu.org; Mon, 31 Oct 2016 13:41:10 -0400 Original-Received: from mail-pf0-x242.google.com ([2607:f8b0:400e:c00::242]:33323) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1c1Ga2-00041A-0P for emacs-devel@gnu.org; Mon, 31 Oct 2016 13:41:06 -0400 Original-Received: by mail-pf0-x242.google.com with SMTP id a136so5886603pfa.0 for ; Mon, 31 Oct 2016 10:41:05 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:date:to:cc:subject:message-id:user-agent:mime-version; bh=FVeLsquggZsI10TJJ16rtVg8Yd65AtIW7iUYR+xhcN0=; b=trXfhHp7L6NEiFRaBrCkryO2RbBIFu6rfPBIqXqZzssxhxo6tsaRUNr7v6IIo1lycu mC1k+J2kJjqI40ucmEBDpsxykI7zpp87WEmW7dua1Rxks2AyFSmylRwbP2/E1OdR47O1 dZVali7pXD28K6mtXXQ/nv8CfbxJCtOcm/YIsziKbXhWegneDZ2EXqkBHE5knPT/UyTi +QsUtOGNUtKdiYt51mE2m2CfJCjM62kJHi15E1gH5iuEb3ZwdEiPvrSW/N8LyXjfwPDJ Ny49uzV7wxOO5sL6aqJ0gJVB4HEngsoAaElLvtIvtn03ZxZEH1z3hmUNo/8YprlDDaDz r6Sw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:from:date:to:cc:subject:message-id:user-agent :mime-version; bh=FVeLsquggZsI10TJJ16rtVg8Yd65AtIW7iUYR+xhcN0=; b=CBNzrhg7J3yFkE7fnBfacc1yagXAUmLZD5HSl9+WgwRqTz2k7aGFZSft7f2xj/s8a9 vEZCDOd9i1Uns0m6kgRIxHqCEeIADDdwBKfMeue9qa5U2V16XWjALJiQykUiC0mDo/ku qW22uA4r0Qmq4/IxNQsSkXW1Q/LIq/oeNfRnuxWQAuToYCR4Y+oE8RDTKVfCXk+XDr2A vzVfMgFEleqKp2jyRF5HT+VtszVC+jBmRbnB4xiOZVK4Ez9Yf3qQn4D/oUSk1EcdYhhj t3axVc+59lvollbeNUqqe5Mj0q8zHy9WXjSGDjTzfI85qy83CBvJXDtd6GOOsBIUzjOr ONOw== X-Gm-Message-State: ABUngvdxagiVKQ7hBShXI0NpTancuL7fxb0dzwbbOfNfaCK974IAdvhkORSgIerO2pyYnQ== X-Received: by 10.99.161.2 with SMTP id b2mr41769312pgf.5.1477935663548; Mon, 31 Oct 2016 10:41:03 -0700 (PDT) Original-Received: from calancha-pc (57.92.100.220.dy.bbexcite.jp. [220.100.92.57]) by smtp.gmail.com with ESMTPSA id j63sm36917151pfj.70.2016.10.31.10.41.01 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Mon, 31 Oct 2016 10:41:03 -0700 (PDT) X-Google-Original-From: Tino Calancha X-X-Sender: calancha@calancha-pc X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2607:f8b0:400e:c00::242 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:209031 Archived-At: Hi Stefan, i am trying to address following TODO in tabulated-list.el (commit f0809a9): + ;; TODO: don't truncate to `width' if the next column is align-right + ;; and has some space left. Following example compares the patch below with the current behaviour: emacs -r -Q -eval '(switch-to-buffer "*abcdefghijklmnopqrstuvwxyz*")' M-x list-buffers RET ;; List this buffer as: ;; Before patch: *abcdefghijklmno... ;; After patch: *abcdefghijklmnopqrs... Please, take a look on it when you have time. Regards, Tino ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; >From e150d919e59ca339115a1657cf04b0b32385d1a1 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Tue, 1 Nov 2016 02:15:09 +0900 Subject: [PATCH] tabulated-list: extend truncation into next align-right column * lisp/emacs-lisp/tabulated-list.el (tabulated-list--col-max-widths): New variable. (tabulated-list--col-max-widths): New defun. (tabulated-list-print, tabulated-list-set-col): Use it. (tabulated-list-print-col): If the next column is align-right, and has some space left then don't truncate to width, use some of the available space from the next column. --- lisp/emacs-lisp/tabulated-list.el | 59 ++++++++++++++++++++++++++++++++------- 1 file changed, 49 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 00b029d..6ad0707 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -36,6 +36,7 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) ;; The reason `tabulated-list-format' and other variables are ;; permanent-local is to make it convenient to switch to a different ;; major mode, switch back, and have the original Tabulated List data @@ -86,6 +87,10 @@ tabulated-list-entries arguments and must return a list of the above form.") (put 'tabulated-list-entries 'permanent-local t) +(defvar-local tabulated-list--col-max-widths nil + "List of maximum entry widths per each column.") +(put 'tabulated-list--col-max-widths 'permanent-local t) + (defvar-local tabulated-list-padding 0 "Number of characters preceding each Tabulated List mode entry. By default, lines are padded with spaces, but you can use the @@ -298,6 +303,22 @@ tabulated-list--get-sorter (lambda (a b) (not (funcall sorter a b))) sorter)))) +(defun tabulated-list--col-max-widths () + "Update `tabulated-list--col-max-widths'." + (let ((entries (if (functionp tabulated-list-entries) + (funcall tabulated-list-entries) + tabulated-list-entries))) + (setq tabulated-list--col-max-widths + (cl-loop for n from 0 to (1- (length tabulated-list-format)) + collect + (apply #'max (mapcar (lambda (x) + (let ((desc (elt (cadr x) n))) + (string-width + (if (stringp desc) + desc + (car desc))))) + entries)))))) + (defun tabulated-list-print (&optional remember-pos update) "Populate the current Tabulated List mode buffer. This sorts the `tabulated-list-entries' list if sorting is @@ -339,6 +360,8 @@ tabulated-list-print (erase-buffer) (unless tabulated-list-use-header-line (tabulated-list-print-fake-header))) + ;; Update columns max element widths list. + (tabulated-list--col-max-widths) ;; Finally, print the resulting list. (dolist (elt entries) (let ((id (car elt))) @@ -402,8 +425,6 @@ tabulated-list-print-col N is the column number, COL-DESC is a column descriptor (see `tabulated-list-entries'), and X is the column number at point. Return the column number after insertion." - ;; TODO: don't truncate to `width' if the next column is align-right - ;; and has some space left. (let* ((format (aref tabulated-list-format n)) (name (nth 0 format)) (width (nth 1 format)) @@ -414,12 +435,29 @@ tabulated-list-print-col (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 (< (1+ n) (length tabulated-list-format))) + available-space) + (when not-last-col + (let* ((next-col-format (aref tabulated-list-format (1+ n))) + (next-col-right-align (plist-get (nthcdr 3 next-col-format) + :right-align)) + (next-col-width (nth 1 next-col-format))) + (setq available-space + (if (and (not right-align) + next-col-right-align) + (- + (+ width next-col-width) + (min next-col-width + (nth (1+ n) tabulated-list--col-max-widths))) + width)))) ;; Truncate labels if necessary (except last column). - (and not-last-col - (> label-width width) - (setq label (truncate-string-to-width label width nil nil t) - label-width width)) + ;; 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) + 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))) @@ -437,7 +475,7 @@ tabulated-list-print-col (when not-last-col (when (> pad-right 0) (insert (make-string pad-right ?\s))) (insert (propertize - (make-string (- next-x x label-width pad-right) ?\s) + (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))) @@ -495,8 +533,9 @@ tabulated-list-set-col (delete-region pos (next-single-property-change pos prop nil eol)) (goto-char pos) (tabulated-list-print-col col desc (current-column)) - (if change-entry-data - (aset entry col desc)) + (when change-entry-data + (aset entry col desc) + (tabulated-list--col-max-widths)) (put-text-property pos (point) 'tabulated-list-id id) (put-text-property pos (point) 'tabulated-list-entry entry) (goto-char opoint)))) -- 2.10.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; In GNU Emacs 26.0.50.9 (x86_64-pc-linux-gnu, GTK+ Version 3.22.1) of 2016-11-01 Repository revision: 8e7b1af1d708dcf41695cf3fbeff9d35cdb8e5b6