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

[Tino Calancha <tino.calancha@gmail.com>]

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 <tino.calancha@gmail.com>
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