[Emacs-diffs] /srv/bzr/emacs/trunk r108147: * lisp/buff-menu.el (list-buffers--refresh): Mark `size' as right-align.

[Stefan Monnier]

------------------------------------------------------------
revno: 108147
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2012-05-07 12:29:55 -0400
message:
  * 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.
modified:
  lisp/ChangeLog
  lisp/buff-menu.el
  lisp/emacs-lisp/tabulated-list.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-05-07 05:37:38 +0000
+++ b/lisp/ChangeLog    2012-05-07 16:29:55 +0000
@@ -1,3 +1,11 @@
+2012-05-07  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * 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  <address@hidden>
 
@@ -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)

=== modified file 'lisp/buff-menu.el'
--- a/lisp/buff-menu.el 2012-05-07 05:37:38 +0000
+++ b/lisp/buff-menu.el 2012-05-07 16:29:55 +0000
@@ -269,6 +269,7 @@
   (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 @@
 
 ;;; 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 @@
                  '("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)

=== modified file 'lisp/emacs-lisp/tabulated-list.el'
--- a/lisp/emacs-lisp/tabulated-list.el 2012-05-07 05:37:38 +0000
+++ b/lisp/emacs-lisp/tabulated-list.el 2012-05-07 16:29:55 +0000
@@ -52,6 +52,7 @@
    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 @@
 
 (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 @@
             (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 @@
           (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 @@
                    '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 @@
     (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 @@
 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.