aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLars Ingebrigtsen2021-08-27 18:41:42 +0200
committerLars Ingebrigtsen2021-08-27 18:41:42 +0200
commite26d628a4ea197d1e1ae39f51c5ebaecec4f6483 (patch)
tree5060cd625f3bc8fa178946ebcef9ec7cc1234988
parent185759e07adc9acda25eff7e1d551619cfba874b (diff)
downloademacs-e26d628a4ea197d1e1ae39f51c5ebaecec4f6483.tar.gz
emacs-e26d628a4ea197d1e1ae39f51c5ebaecec4f6483.zip
Don't overly truncate tabulated-list headers
* lisp/emacs-lisp/tabulated-list.el (tabulated-list-init-header): Don't overly truncate headers that are before a right-aligned column (bug#44594). (tabulated-list--available-space): Separated out into own function... (tabulated-list-print-col): ... from here.
-rw-r--r--lisp/emacs-lisp/tabulated-list.el58
1 files changed, 35 insertions, 23 deletions
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index fecfa91147e..f148bc1768c 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -271,12 +271,15 @@ Populated by `tabulated-list-init-header'.")
271(defun tabulated-list-init-header () 271(defun tabulated-list-init-header ()
272 "Set up header line for the Tabulated List buffer." 272 "Set up header line for the Tabulated List buffer."
273 ;; FIXME: Should share code with tabulated-list-print-col! 273 ;; FIXME: Should share code with tabulated-list-print-col!
274 (let ((x (max tabulated-list-padding 0)) 274 (let* ((x (max tabulated-list-padding 0))
275 (button-props `(help-echo "Click to sort by column" 275 (button-props `(help-echo "Click to sort by column"
276 mouse-face header-line-highlight 276 mouse-face header-line-highlight
277 keymap ,tabulated-list-sort-button-map)) 277 keymap ,tabulated-list-sort-button-map))
278 (len (length tabulated-list-format)) 278 (len (length tabulated-list-format))
279 (cols nil)) 279 ;; Pre-compute width for available-space compution.
280 (hcols (mapcar #'car tabulated-list-format))
281 (tabulated-list--near-rows (list hcols hcols))
282 (cols nil))
280 (if display-line-numbers 283 (if display-line-numbers
281 (setq x (+ x (tabulated-list-line-number-width)))) 284 (setq x (+ x (tabulated-list-line-number-width))))
282 (push (propertize " " 'display `(space :align-to ,x)) cols) 285 (push (propertize " " 'display `(space :align-to ,x)) cols)
@@ -290,9 +293,17 @@ Populated by `tabulated-list-init-header'.")
290 (props (nthcdr 3 col)) 293 (props (nthcdr 3 col))
291 (pad-right (or (plist-get props :pad-right) 1)) 294 (pad-right (or (plist-get props :pad-right) 1))
292 (right-align (plist-get props :right-align)) 295 (right-align (plist-get props :right-align))
293 (next-x (+ x pad-right width))) 296 (next-x (+ x pad-right width))
294 (when (and (>= lablen 3) (> lablen width) not-last-col) 297 (available-space
295 (setq label (truncate-string-to-width label (- lablen 1) nil nil t))) 298 (and not-last-col
299 (if right-align
300 width
301 (tabulated-list--available-space width n)))))
302 (when (and (>= lablen 3)
303 not-last-col
304 (> lablen available-space))
305 (setq label (truncate-string-to-width label available-space
306 nil nil t)))
296 (push 307 (push
297 (cond 308 (cond
298 ;; An unsortable column 309 ;; An unsortable column
@@ -514,6 +525,17 @@ of column descriptors."
514 beg (point) 525 beg (point)
515 `(tabulated-list-id ,id tabulated-list-entry ,cols)))) 526 `(tabulated-list-id ,id tabulated-list-entry ,cols))))
516 527
528(defun tabulated-list--available-space (width n)
529 (let* ((next-col-format (aref tabulated-list-format (1+ n)))
530 (next-col-right-align (plist-get (nthcdr 3 next-col-format)
531 :right-align))
532 (next-col-width (nth 1 next-col-format)))
533 (if next-col-right-align
534 (- (+ width next-col-width)
535 (min next-col-width
536 (tabulated-list--col-local-max-widths (1+ n))))
537 width)))
538
517(defun tabulated-list-print-col (n col-desc x) 539(defun tabulated-list-print-col (n col-desc x)
518 "Insert a specified Tabulated List entry at point. 540 "Insert a specified Tabulated List entry at point.
519N is the column number, COL-DESC is a column descriptor (see 541N is the column number, COL-DESC is a column descriptor (see
@@ -530,20 +552,10 @@ Return the column number after insertion."
530 (help-echo (concat (car format) ": " label)) 552 (help-echo (concat (car format) ": " label))
531 (opoint (point)) 553 (opoint (point))
532 (not-last-col (< (1+ n) (length tabulated-list-format))) 554 (not-last-col (< (1+ n) (length tabulated-list-format)))
533 available-space) 555 (available-space (and not-last-col
534 (when not-last-col 556 (if right-align
535 (let* ((next-col-format (aref tabulated-list-format (1+ n))) 557 width
536 (next-col-right-align (plist-get (nthcdr 3 next-col-format) 558 (tabulated-list--available-space width n)))))
537 :right-align))
538 (next-col-width (nth 1 next-col-format)))
539 (setq available-space
540 (if (and (not right-align)
541 next-col-right-align)
542 (-
543 (+ width next-col-width)
544 (min next-col-width
545 (tabulated-list--col-local-max-widths (1+ n))))
546 width))))
547 ;; Truncate labels if necessary (except last column). 559 ;; Truncate labels if necessary (except last column).
548 ;; Don't truncate to `width' if the next column is align-right 560 ;; Don't truncate to `width' if the next column is align-right
549 ;; and has some space left, truncate to `available-space' instead. 561 ;; and has some space left, truncate to `available-space' instead.