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?

I have tested the new patch (see below) with:

(benchmark-run-compiled 1
  (with-current-buffer "*Packages*"
    (let ((inhibit-read-only t)) (erase-buffer))
    (tabulated-list-print)))


I) When `package-archives' equals '(("gnu" . "http://elpa.gnu.org/packages/";)),
i get 262 entries and the form above returns: (VALUE 0 0.0).
VALUE fluctuates around (0.012, 0.017).

II) After adding to `package-archives' `melpa' and `marmalade' repositories,
i get 4758 entries and the same form returns:  (VALUE 3 0.3869728290000012).
VALUE fluctuates around (0.71, 0.75).

The ratio on number of entries is N2/N1 = 4758/262 ~ 18.
The ratio of elapsed times is T2/T1 ~ 0.73/0.015 ~ 50 ~ 3 N2/N1.

Quite reasonable, right?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>From 84c7690717e8b59b62cce79f37d89a8acf526b58 Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Fri, 4 Nov 2016 23:17:41 +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--near-rows): New variable.
(tabulated-list-print, tabulated-list-set-col): Use it.
(tabulated-list--col-local-max-widths): New defsubst.
(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 | 55 ++++++++++++++++++++++++++++++++-------
 1 file changed, 45 insertions(+), 10 deletions(-)

diff --git a/lisp/emacs-lisp/tabulated-list.el 
b/lisp/emacs-lisp/tabulated-list.el
index 00b029d..7f05b34 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--near-rows)
+
 (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,14 @@ tabulated-list--get-sorter
           (lambda (a b) (not (funcall sorter a b)))
         sorter))))
 
+(defsubst tabulated-list--col-local-max-widths (col)
+   "Return maximum entry widths at column COL around current row.
+Check the current row, the previous one and the next row."
+  (apply #'max (mapcar (lambda (x)
+                         (let ((nt (elt x col)))
+                           (string-width (if (stringp nt) nt (car nt)))))
+                       tabulated-list--near-rows)))
+
 (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
@@ -341,7 +351,12 @@ tabulated-list-print
         (tabulated-list-print-fake-header)))
     ;; Finally, print the resulting list.
     (dolist (elt entries)
-      (let ((id (car elt)))
+      (let ((tabulated-list--near-rows
+             (list
+              (or (tabulated-list-get-entry (point-at-bol 0)) (cadr elt))
+              (cadr elt)
+              (or (cadr (cadr entries)) (cadr elt))))
+            (id (car elt)))
         (and entry-id
              (equal entry-id id)
              (setq entry-id nil
@@ -402,8 +417,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 +427,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--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 +467,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 +524,12 @@ 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--near-rows
+             (list
+              (tabulated-list-get-entry (point-at-bol 0))
+              entry
+              (or (tabulated-list-get-entry (point-at-bol 2)) entry))))
+        (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.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.2)
 of 2016-11-03 built on calancha-pc
Repository revision: 86bec41906c17f3b96288bd34ac0f835cde88a27