Commit f0809a9d authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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.
parent b120cc17
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>
* 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--sort-by-column-name): Fix a corner case.
* buff-menu.el (list-buffers--refresh): Handle
Buffer-menu-use-header-line.
* buff-menu.el (list-buffers--refresh):
Handle Buffer-menu-use-header-line.
2012-05-06 Chong Yidong <cyd@gnu.org>
......@@ -32,7 +40,7 @@
(Buffer-menu-bury): Use Tabulated List machinery.
(Buffer-menu-mouse-select, Buffer-menu-sort-by-column)
(Buffer-menu-sort-button-map, Buffer-menu-make-sort-button):
Deleted.
Delete.
(list-buffers--refresh): New function.
(list-buffers-noselect): Use it.
(tabulated-list-entry-size->, Buffer-menu--pretty-name)
......
......@@ -269,6 +269,7 @@ ARG, show only buffers that are visiting files."
(message
"Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
;;;###autoload
(defun list-buffers (&optional arg)
"Display a list of existing buffers.
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.
;;;###autoload
(defun list-buffers-noselect (&optional files-only buffer-list)
"Create and return a Buffer Menu buffer.
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)
'("M" 1 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)
'("File" 1 t))))
(setq tabulated-list-use-header-line Buffer-menu-use-header-line)
......
......@@ -52,6 +52,7 @@ where:
of `tabulated-list-entries'.
- PROPS is a plist of additional column properties.
Currently supported properties are:
- `:right-align': if non-nil, the column should be right-aligned.
- `:pad-right': Number of additional padding spaces to the
right of the column (defaults to 1 if omitted).")
(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 ()
"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))
(button-props `(help-echo "Click to sort by column"
mouse-face highlight
......@@ -190,8 +192,9 @@ If ADVANCE is non-nil, move forward by one line afterwards."
(label (nth 0 col))
(width (nth 1 col))
(props (nthcdr 3 col))
(pad-right (or (plist-get props :pad-right) 1)))
(setq x (+ x pad-right width))
(pad-right (or (plist-get props :pad-right) 1))
(right-align (plist-get props :right-align))
(next-x (+ x pad-right width)))
(push
(cond
;; An unsortable column
......@@ -202,10 +205,8 @@ If ADVANCE is non-nil, move forward by one line afterwards."
(apply 'propertize
(concat label
(cond
((> (+ 2 (length label)) width)
"")
((cdr tabulated-list-sort-key)
" ▲")
((> (+ 2 (length label)) width) "")
((cdr tabulated-list-sort-key) " ▲")
(t " ▼")))
'face 'bold
'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
button-props)))
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)
(push (propertize " "
'display `(space :align-to ,x)
'display `(space :align-to ,next-x)
'face 'fixed-pitch)
cols))))
cols))
(setq x next-x)))
(setq cols (apply 'concat (nreverse cols)))
(if tabulated-list-use-header-line
(setq header-line-format cols)
......@@ -276,7 +288,7 @@ to the entry with the same ID element as the current line."
(erase-buffer)
(unless tabulated-list-use-header-line
(tabulated-list-print-fake-header))
;; Sort the buffers, if necessary.
;; Sort the entries, if necessary.
(when (and tabulated-list-sort-key
(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
`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))
(props (nthcdr 3 format))
(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-width (string-width label))
(help-echo (concat (car format) ": " label))
(opoint (point))
(not-last-col (< (1+ n) (length tabulated-list-format))))
;; Truncate labels if necessary (except last column).
(and not-last-col
(> (string-width label) width)
(setq label (truncate-string-to-width label width nil nil t)))
(> label-width width)
(setq label (truncate-string-to-width label width nil nil t)
label-width width))
(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)
(insert (propertize label 'help-echo help-echo))
(apply 'insert-text-button label (cdr col-desc)))
(setq x (+ x pad-right width))
;; No need to append any spaces if this is the last column.
(if not-last-col
(indent-to x pad-right))
(put-text-property opoint (point) 'tabulated-list-column-name name)
x))
(let ((next-x (+ x pad-right width)))
;; No need to append any spaces if this is the last column.
(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)
'display `(space :align-to ,next-x))))
(put-text-property opoint (point) 'tabulated-list-column-name name)
next-x)))
(defun tabulated-list-delete-entry ()
"Delete the Tabulated List entry at point.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment