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

[Tino Calancha]

Stefan Monnier <address@hidden> writes:

>> +                   (min next-col-width
>> +                        (tabulated-list--near-cols-max-widths
>> +                         (1- (line-number-at-pos))
>
> Hmm... this (line-number-at-pos) and the inverse `nth` inside
> tabulated-list--near-cols-max-widths are both O(N), and since we go
> through this loop N times, this gives us an O(N^2) complexity.
>
> Can't we just get "the next row" and "the previous row" more directly?

We might introduce one variable `tabulated-list--current-row'.
Please, let me know if there is a cleaner way.

It might be convenient to define the predicate mentioned in Bug#24855.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>From fdd805264d19b46c81a2abc42d47e0e403395a5e Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Thu, 3 Nov 2016 00:01:11 +0900
Subject: [PATCH] tabulated-list: extend truncation into next align-right
 column

See discussion on:
https://lists.gnu.org/archive/html/emacs-devel/2016-10/msg01101.html
* lisp/emacs-lisp/tabulated-list.el
(tabulated-list--current-row): New variable.
(tabulated-list-print, tabulated-list-set-col): Use it.
(tabulated-list--next-col-local-max-widths): New defun.
(tabulated-list-print-col): Use it.  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 | 63 +++++++++++++++++++++++++++++++++------
 1 file changed, 54 insertions(+), 9 deletions(-)

diff --git a/lisp/emacs-lisp/tabulated-list.el 
b/lisp/emacs-lisp/tabulated-list.el
index 00b029d..cc91ae0 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -102,6 +102,8 @@ tabulated-list-printer
 object identifying the entry, and COLS is a vector of column
 descriptors, as documented in `tabulated-list-entries'.")
 
+(defvar tabulated-list--current-row)
+
 (defvar-local tabulated-list-sort-key nil
   "Sort key for the current Tabulated List mode buffer.
 If nil, no additional sorting is performed.
@@ -298,6 +300,28 @@ tabulated-list--get-sorter
           (lambda (a b) (not (funcall sorter a b)))
         sorter))))
 
+(defun tabulated-list--next-col-local-max-widths (col)
+  (let ((entries (if (functionp tabulated-list-entries)
+                     (funcall tabulated-list-entries)
+                   tabulated-list-entries)))
+    (let* ((row tabulated-list--current-row)
+           (entry (nth row entries))
+           (entry-up (if (> row 0)
+                         (nth (1- row) entries)
+                       entry))
+           (entry-down (if (< row (1- (length entries)))
+                           (nth (1+ row) entries)
+                         entry))
+           (desc (elt (cadr entry) col))
+           (desc-up (elt (cadr entry-up) col))
+           (desc-down (elt (cadr entry-down) col)))
+      (apply #'max (mapcar (lambda (x)
+                             (string-width
+                              (if (stringp x)
+                                  x
+                                (car x))))
+                           (list desc desc-up desc-down))))))
+
 (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
@@ -319,6 +343,7 @@ tabulated-list-print
                     (funcall tabulated-list-entries)
                   tabulated-list-entries))
         (sorter (tabulated-list--get-sorter))
+        (tabulated-list--current-row -1)
        entry-id saved-pt saved-col window-line)
     (and remember-pos
         (setq entry-id (tabulated-list-get-id))
@@ -341,6 +366,8 @@ tabulated-list-print
         (tabulated-list-print-fake-header)))
     ;; Finally, print the resulting list.
     (dolist (elt entries)
+      (setq tabulated-list--current-row
+            (1+ tabulated-list--current-row))
       (let ((id (car elt)))
         (and entry-id
              (equal entry-id id)
@@ -402,8 +429,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 +439,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
+                        (tabulated-list--next-col-local-max-widths (1+ n))))
+                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 +479,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)))
@@ -494,7 +536,10 @@ tabulated-list-set-col
     (when (< pos eol)
       (delete-region pos (next-single-property-change pos prop nil eol))
       (goto-char pos)
-      (tabulated-list-print-col col desc (current-column))
+      (let ((tabulated-list--current-row
+             (- (line-number-at-pos)
+                (if (overlays-at (point-min)) 2 1))))
+        (tabulated-list-print-col col desc (current-column)))
       (if change-entry-data
          (aset entry col desc))
       (put-text-property pos (point) 'tabulated-list-id id)
-- 
2.10.1

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.5 (x86_64-pc-linux-gnu, GTK+ Version 3.22.2)
 of 2016-11-02 built on calancha-pc
Repository revision: 126c879df42f741fe486236aea538290a8c2ed64