From: Stefan Monnier Date: Mon, 7 May 2012 16:29:55 +0000 (-0400) Subject: * lisp/buff-menu.el (list-buffers--refresh): Mark `size' as right-align. X-Git-Tag: emacs-24.2.90~471^2~168 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f0809a9d058443cd92f7145a70c25ce10d285971;p=emacs.git * 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1db2fb1c715..33138c34809 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2012-05-07 Stefan Monnier + + * 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 * 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 @@ -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) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 4ea9dcea8b4..10c097bbf93 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -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) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 5471640e039..e56fea58553 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -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.