1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

* lisp/buff-menu.el (list-buffers--refresh): Mark `size' as right-align.

* lisp/emacs-lisp/tabulated-list.el (tabulated-list-init-header):
Handle new :right-align column property.
(tabulated-list-print-col): Idem, plus use `display' text-property to
try and preserve alignment for variable pitch fonts.
This commit is contained in:
Stefan Monnier 2012-05-07 12:29:55 -04:00
parent b120cc17ae
commit f0809a9d05
3 changed files with 58 additions and 21 deletions

View file

@ -1,3 +1,11 @@
2012-05-07 Stefan Monnier <monnier@iro.umontreal.ca>
* buff-menu.el (list-buffers--refresh): Mark `size' as right-align.
* emacs-lisp/tabulated-list.el (tabulated-list-init-header):
Handle new :right-align column property.
(tabulated-list-print-col): Idem, plus use `display' text-property to
try and preserve alignment for variable pitch fonts.
2012-05-07 Chong Yidong <cyd@gnu.org> 2012-05-07 Chong Yidong <cyd@gnu.org>
* emacs-lisp/tabulated-list.el: Add no-header-line alternative. * emacs-lisp/tabulated-list.el: Add no-header-line alternative.
@ -11,8 +19,8 @@
(tabulated-list-col-sort): Handle non-header-line button case. (tabulated-list-col-sort): Handle non-header-line button case.
(tabulated-list--sort-by-column-name): Fix a corner case. (tabulated-list--sort-by-column-name): Fix a corner case.
* buff-menu.el (list-buffers--refresh): Handle * buff-menu.el (list-buffers--refresh):
Buffer-menu-use-header-line. Handle Buffer-menu-use-header-line.
2012-05-06 Chong Yidong <cyd@gnu.org> 2012-05-06 Chong Yidong <cyd@gnu.org>
@ -32,7 +40,7 @@
(Buffer-menu-bury): Use Tabulated List machinery. (Buffer-menu-bury): Use Tabulated List machinery.
(Buffer-menu-mouse-select, Buffer-menu-sort-by-column) (Buffer-menu-mouse-select, Buffer-menu-sort-by-column)
(Buffer-menu-sort-button-map, Buffer-menu-make-sort-button): (Buffer-menu-sort-button-map, Buffer-menu-make-sort-button):
Deleted. Delete.
(list-buffers--refresh): New function. (list-buffers--refresh): New function.
(list-buffers-noselect): Use it. (list-buffers-noselect): Use it.
(tabulated-list-entry-size->, Buffer-menu--pretty-name) (tabulated-list-entry-size->, Buffer-menu--pretty-name)

View file

@ -269,6 +269,7 @@ ARG, show only buffers that are visiting files."
(message (message
"Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help.")) "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
;;;###autoload
(defun list-buffers (&optional arg) (defun list-buffers (&optional arg)
"Display a list of existing buffers. "Display a list of existing buffers.
The list is displayed in a buffer named \"*Buffer List*\". The list is displayed in a buffer named \"*Buffer List*\".
@ -543,6 +544,7 @@ The current window remains selected."
;;; Functions for populating the Buffer Menu. ;;; Functions for populating the Buffer Menu.
;;;###autoload
(defun list-buffers-noselect (&optional files-only buffer-list) (defun list-buffers-noselect (&optional files-only buffer-list)
"Create and return a Buffer Menu buffer. "Create and return a Buffer Menu buffer.
This is called by `buffer-menu' and others as a subroutine. This is called by `buffer-menu' and others as a subroutine.
@ -571,7 +573,8 @@ means list those buffers and no others."
'("R" 1 t :pad-right 0) '("R" 1 t :pad-right 0)
'("M" 1 t) '("M" 1 t)
`("Buffer" ,name-width t) `("Buffer" ,name-width t)
`("Size" ,size-width tabulated-list-entry-size->) `("Size" ,size-width tabulated-list-entry-size->
:right-align t)
`("Mode" ,Buffer-menu-mode-width t) `("Mode" ,Buffer-menu-mode-width t)
'("File" 1 t)))) '("File" 1 t))))
(setq tabulated-list-use-header-line Buffer-menu-use-header-line) (setq tabulated-list-use-header-line Buffer-menu-use-header-line)

View file

@ -52,6 +52,7 @@ where:
of `tabulated-list-entries'. of `tabulated-list-entries'.
- PROPS is a plist of additional column properties. - PROPS is a plist of additional column properties.
Currently supported properties are: Currently supported properties are:
- `:right-align': if non-nil, the column should be right-aligned.
- `:pad-right': Number of additional padding spaces to the - `:pad-right': Number of additional padding spaces to the
right of the column (defaults to 1 if omitted).") right of the column (defaults to 1 if omitted).")
(make-variable-buffer-local 'tabulated-list-format) (make-variable-buffer-local 'tabulated-list-format)
@ -179,6 +180,7 @@ If ADVANCE is non-nil, move forward by one line afterwards."
(defun tabulated-list-init-header () (defun tabulated-list-init-header ()
"Set up header line for the Tabulated List buffer." "Set up header line for the Tabulated List buffer."
;; FIXME: Should share code with tabulated-list-print-col!
(let ((x (max tabulated-list-padding 0)) (let ((x (max tabulated-list-padding 0))
(button-props `(help-echo "Click to sort by column" (button-props `(help-echo "Click to sort by column"
mouse-face highlight mouse-face highlight
@ -190,8 +192,9 @@ If ADVANCE is non-nil, move forward by one line afterwards."
(label (nth 0 col)) (label (nth 0 col))
(width (nth 1 col)) (width (nth 1 col))
(props (nthcdr 3 col)) (props (nthcdr 3 col))
(pad-right (or (plist-get props :pad-right) 1))) (pad-right (or (plist-get props :pad-right) 1))
(setq x (+ x pad-right width)) (right-align (plist-get props :right-align))
(next-x (+ x pad-right width)))
(push (push
(cond (cond
;; An unsortable column ;; An unsortable column
@ -202,10 +205,8 @@ If ADVANCE is non-nil, move forward by one line afterwards."
(apply 'propertize (apply 'propertize
(concat label (concat label
(cond (cond
((> (+ 2 (length label)) width) ((> (+ 2 (length label)) width) "")
"") ((cdr tabulated-list-sort-key) "")
((cdr tabulated-list-sort-key)
"")
(t ""))) (t "")))
'face 'bold 'face 'bold
'tabulated-list-column-name label 'tabulated-list-column-name label
@ -215,11 +216,22 @@ If ADVANCE is non-nil, move forward by one line afterwards."
'tabulated-list-column-name label 'tabulated-list-column-name label
button-props))) button-props)))
cols) cols)
(when right-align
(let ((shift (- width (string-width (car cols)))))
(when (> shift 0)
(setq cols
(cons (car cols)
(cons (propertize (make-string shift ?\s)
'display
`(space :align-to ,(+ x shift)))
(cdr cols))))
(setq x (+ x shift)))))
(if (> pad-right 0) (if (> pad-right 0)
(push (propertize " " (push (propertize " "
'display `(space :align-to ,x) 'display `(space :align-to ,next-x)
'face 'fixed-pitch) 'face 'fixed-pitch)
cols)))) cols))
(setq x next-x)))
(setq cols (apply 'concat (nreverse cols))) (setq cols (apply 'concat (nreverse cols)))
(if tabulated-list-use-header-line (if tabulated-list-use-header-line
(setq header-line-format cols) (setq header-line-format cols)
@ -276,7 +288,7 @@ to the entry with the same ID element as the current line."
(erase-buffer) (erase-buffer)
(unless tabulated-list-use-header-line (unless tabulated-list-use-header-line
(tabulated-list-print-fake-header)) (tabulated-list-print-fake-header))
;; Sort the buffers, if necessary. ;; Sort the entries, if necessary.
(when (and tabulated-list-sort-key (when (and tabulated-list-sort-key
(car tabulated-list-sort-key)) (car tabulated-list-sort-key))
(let* ((sort-column (car tabulated-list-sort-key)) (let* ((sort-column (car tabulated-list-sort-key))
@ -332,29 +344,43 @@ 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))
(props (nthcdr 3 format)) (props (nthcdr 3 format))
(pad-right (or (plist-get props :pad-right) 1)) (pad-right (or (plist-get props :pad-right) 1))
(right-align (plist-get props :right-align))
(label (if (stringp col-desc) col-desc (car col-desc))) (label (if (stringp col-desc) col-desc (car col-desc)))
(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))))
;; Truncate labels if necessary (except last column). ;; Truncate labels if necessary (except last column).
(and not-last-col (and not-last-col
(> (string-width label) width) (> label-width width)
(setq label (truncate-string-to-width label width nil nil t))) (setq label (truncate-string-to-width label width nil nil t)
label-width width))
(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))
(let ((shift (- width label-width)))
(insert (propertize (make-string shift ?\s)
'display `(space :align-to ,(+ x shift))))
(setq width (- width shift))
(setq x (+ x shift))))
(if (stringp col-desc) (if (stringp col-desc)
(insert (propertize label 'help-echo help-echo)) (insert (propertize label 'help-echo help-echo))
(apply 'insert-text-button label (cdr col-desc))) (apply 'insert-text-button label (cdr col-desc)))
(setq x (+ x pad-right width)) (let ((next-x (+ x pad-right width)))
;; No need to append any spaces if this is the last column. ;; No need to append any spaces if this is the last column.
(if not-last-col (when not-last-col
(indent-to x pad-right)) (when (> pad-right 0) (insert (make-string pad-right ?\s)))
(put-text-property opoint (point) 'tabulated-list-column-name name) (insert (propertize
x)) (make-string (- next-x x label-width pad-right) ?\s)
'display `(space :align-to ,next-x))))
(put-text-property opoint (point) 'tabulated-list-column-name name)
next-x)))
(defun tabulated-list-delete-entry () (defun tabulated-list-delete-entry ()
"Delete the Tabulated List entry at point. "Delete the Tabulated List entry at point.