mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-15 09:47:20 +00:00
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.
This commit is contained in:
parent
0bf888422d
commit
db43613307
@ -102,6 +102,8 @@ It is called with two arguments, ID and COLS. ID is a Lisp
|
|||||||
object identifying the entry, and COLS is a vector of column
|
object identifying the entry, and COLS is a vector of column
|
||||||
descriptors, as documented in `tabulated-list-entries'.")
|
descriptors, as documented in `tabulated-list-entries'.")
|
||||||
|
|
||||||
|
(defvar tabulated-list--near-rows)
|
||||||
|
|
||||||
(defvar-local tabulated-list-sort-key nil
|
(defvar-local tabulated-list-sort-key nil
|
||||||
"Sort key for the current Tabulated List mode buffer.
|
"Sort key for the current Tabulated List mode buffer.
|
||||||
If nil, no additional sorting is performed.
|
If nil, no additional sorting is performed.
|
||||||
@ -298,6 +300,14 @@ column. Negate the predicate that would be returned if
|
|||||||
(lambda (a b) (not (funcall sorter a b)))
|
(lambda (a b) (not (funcall sorter a b)))
|
||||||
sorter))))
|
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)
|
(defun tabulated-list-print (&optional remember-pos update)
|
||||||
"Populate the current Tabulated List mode buffer.
|
"Populate the current Tabulated List mode buffer.
|
||||||
This sorts the `tabulated-list-entries' list if sorting is
|
This sorts the `tabulated-list-entries' list if sorting is
|
||||||
@ -340,8 +350,14 @@ changing `tabulated-list-sort-key'."
|
|||||||
(unless tabulated-list-use-header-line
|
(unless tabulated-list-use-header-line
|
||||||
(tabulated-list-print-fake-header)))
|
(tabulated-list-print-fake-header)))
|
||||||
;; Finally, print the resulting list.
|
;; Finally, print the resulting list.
|
||||||
(dolist (elt entries)
|
(while entries
|
||||||
(let ((id (car elt)))
|
(let* ((elt (car entries))
|
||||||
|
(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
|
(and entry-id
|
||||||
(equal entry-id id)
|
(equal entry-id id)
|
||||||
(setq entry-id nil
|
(setq entry-id nil
|
||||||
@ -368,7 +384,8 @@ changing `tabulated-list-sort-key'."
|
|||||||
(t t)))
|
(t t)))
|
||||||
(let ((old (point)))
|
(let ((old (point)))
|
||||||
(forward-line 1)
|
(forward-line 1)
|
||||||
(delete-region old (point)))))))
|
(delete-region old (point))))))
|
||||||
|
(setq entries (cdr entries)))
|
||||||
(set-buffer-modified-p nil)
|
(set-buffer-modified-p nil)
|
||||||
;; If REMEMBER-POS was specified, move to the "old" location.
|
;; If REMEMBER-POS was specified, move to the "old" location.
|
||||||
(if saved-pt
|
(if saved-pt
|
||||||
@ -402,8 +419,6 @@ of column descriptors."
|
|||||||
N is the column number, COL-DESC is a column descriptor (see
|
N is the column number, COL-DESC is a column descriptor (see
|
||||||
`tabulated-list-entries'), and X is the column number at point.
|
`tabulated-list-entries'), and X is the column number at point.
|
||||||
Return the column number after insertion."
|
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))
|
(let* ((format (aref tabulated-list-format n))
|
||||||
(name (nth 0 format))
|
(name (nth 0 format))
|
||||||
(width (nth 1 format))
|
(width (nth 1 format))
|
||||||
@ -414,12 +429,29 @@ Return the column number after insertion."
|
|||||||
(label-width (string-width label))
|
(label-width (string-width label))
|
||||||
(help-echo (concat (car format) ": " label))
|
(help-echo (concat (car format) ": " label))
|
||||||
(opoint (point))
|
(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).
|
;; Truncate labels if necessary (except last column).
|
||||||
(and not-last-col
|
;; Don't truncate to `width' if the next column is align-right
|
||||||
(> label-width width)
|
;; and has some space left, truncate to `available-space' instead.
|
||||||
(setq label (truncate-string-to-width label width nil nil t)
|
(when (and not-last-col
|
||||||
label-width width))
|
(> 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))
|
(setq label (bidi-string-mark-left-to-right label))
|
||||||
(when (and right-align (> width label-width))
|
(when (and right-align (> width label-width))
|
||||||
(let ((shift (- width label-width)))
|
(let ((shift (- width label-width)))
|
||||||
@ -437,7 +469,7 @@ Return the column number after insertion."
|
|||||||
(when not-last-col
|
(when not-last-col
|
||||||
(when (> pad-right 0) (insert (make-string pad-right ?\s)))
|
(when (> pad-right 0) (insert (make-string pad-right ?\s)))
|
||||||
(insert (propertize
|
(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))))
|
'display `(space :align-to ,next-x))))
|
||||||
(put-text-property opoint (point) 'tabulated-list-column-name name)
|
(put-text-property opoint (point) 'tabulated-list-column-name name)
|
||||||
next-x)))
|
next-x)))
|
||||||
@ -494,7 +526,12 @@ this is the vector stored within it."
|
|||||||
(when (< pos eol)
|
(when (< pos eol)
|
||||||
(delete-region pos (next-single-property-change pos prop nil eol))
|
(delete-region pos (next-single-property-change pos prop nil eol))
|
||||||
(goto-char pos)
|
(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
|
(if change-entry-data
|
||||||
(aset entry col desc))
|
(aset entry col desc))
|
||||||
(put-text-property pos (point) 'tabulated-list-id id)
|
(put-text-property pos (point) 'tabulated-list-id id)
|
||||||
|
Loading…
Reference in New Issue
Block a user