tabulated-list: extend truncation into next align-right col

[Tino Calancha]

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 <address@hidden>
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