[elpa] 217/255: sorting columns

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit 639328e029d0f0095152f016b08f6530388c6173
Author: Eric Schulte <address@hidden>
Date:   Tue Aug 6 23:59:36 2013 -0600

    sorting columns
---
 go-util.el     |    3 +
 list-buffer.el |  126 +++++++++++++++++++++++++++++++++++++++++--------------
 2 files changed, 97 insertions(+), 32 deletions(-)

diff --git a/go-util.el b/go-util.el
index 45b7049..023bfb4 100644
--- a/go-util.el
+++ b/go-util.el
@@ -46,6 +46,9 @@
              more-functions
              :initial-value function))
 
+(defun indexed (list)
+  (loop for el in list as i from 0 collect (list i el)))
+
 (defun rcons (x lst)
   (append lst (list x)))
 
diff --git a/list-buffer.el b/list-buffer.el
index 7f9e762..c4503f3 100644
--- a/list-buffer.el
+++ b/list-buffer.el
@@ -35,52 +35,114 @@
 (defvar *buffer-headers* nil
   "Headers associated with the current list buffer.")
 
+(defvar *buffer-width* nil
+  "Width associated with the current list buffer.")
+
 (defun list-buffer-create (buffer list &optional headers)
   (pop-to-buffer buffer)
+  (list-mode)
+  (set (make-local-variable '*buffer-width*) (window-total-width))
   (set (make-local-variable '*buffer-list*) list)
   (set (make-local-variable '*buffer-headers*)
        (mapcar (curry #'format "%s") headers))
   ;; refresh every time the buffer changes size
   (set (make-local-variable 'window-size-change-functions)
-       (cons (lambda (b) (list-buffer-refresh)) window-size-change-functions))
-  ;; set commands at the bottom
+       (cons (lambda (b)
+               (when (or (not (numberp *buffer-width*))
+                         (not (equal *buffer-width* (window-total-width))))
+                 (set '*buffer-width* (window-total-width))
+                 (list-buffer-refresh)))
+             window-size-change-functions))
+  (goto-char (point-min))
   (list-buffer-refresh))
 
-(defun list-format-row (widths row)
-  (apply #'concat
-         (cl-mapcar
-          (lambda (width cell)
-            (if (< (length cell) width)
-                (concat cell (make-list (- width (length cell)) ?\ ))
-              (concat (subseq cell 0 (- width 2)) "… ")))
-          widths row)))
+(defun list-format-row (widths row &optional row-num)
+  (cl-flet ((num (type number string)
+                 (put-text-property 0 (length string) type number string)
+                 string))
+    (let ((col 0))
+      (num :row row-num
+           (apply #'concat
+                  (cl-mapcar
+                   (lambda (width cell)
+                     (prog1
+                         (num :col col
+                              (if (< (length cell) width)
+                                  (concat cell
+                                          (make-list (- width (length cell))
+                                                     ?\ ))
+                                (concat (subseq cell 0 (- width 2)) "… ")))
+                       (incf col)))
+                   widths row))))))
 
 (defun list-buffer-refresh ()
-  (let* ((strings (mapcar (curry #'mapcar (curry #'format "%s")) 
*buffer-list*))
-         (lengths (mapcar (curry #'mapcar #'length)
-                          (if *buffer-headers*
-                              (cons *buffer-headers* strings)
-                            strings)))
-         (widths (apply #'cl-mapcar (compose '1+ #'max) lengths))
-         ;; scale widths by buffer width
-         (widths (mapcar (compose #'floor (curry #'* (/ (window-total-width)
-                                              (float (apply #'+ widths)))))
-                         widths)))
-    ;; write headers
-    (when *buffer-headers*
-      (set (make-local-variable 'header-line-format)
-           (concat " " (list-format-row widths *buffer-headers*))))
-    ;; write rows
-    (delete-region (point-min) (point-max))
-    (insert (mapconcat (curry #'list-format-row widths) strings "\n")))
-  (goto-char (point-min)))
+  (when *buffer-list*
+    (let* ((start (point))
+           (strings (mapcar (curry #'mapcar (curry #'format "%s")) 
*buffer-list*))
+           (lengths (mapcar (curry #'mapcar #'length)
+                            (if *buffer-headers*
+                                (cons *buffer-headers* strings)
+                              strings)))
+           (widths (apply #'cl-mapcar (compose '1+ #'max) lengths))
+           ;; scale widths by buffer width
+           (widths (mapcar (compose #'floor (curry #'* (/ (window-total-width)
+                                                (float (apply #'+ widths)))))
+                           widths)))
+      ;; write headers
+      (when *buffer-headers*
+        (set (make-local-variable 'header-line-format)
+             (concat " " (list-format-row widths *buffer-headers*))))
+      ;; write rows
+      (delete-region (point-min) (point-max))
+      (insert (mapconcat (compose (curry #'apply #'list-format-row widths) 
#'reverse)
+                         (indexed strings) "\n"))
+      (goto-char start))))
 
 (defun list-buffer-sort (col predicate)
-  (set *buffer-list* (cl-sort *buffer-list* predicate :key (curry #'nth col)))
+  (set '*buffer-list* (cl-sort *buffer-list* predicate :key (curry #'nth col)))
   (list-buffer-refresh))
 
-(defun list-buffer-filter (col filter)
-  (set *buffer-list* (cl-remove-if-not *buffer-list* filter :key (curry #'nth 
col)))
-  (list-buffer-refresh))
+(defun list-current-row () (get-text-property (point) :row))
+
+(defun list-current-col () (get-text-property (point) :col))
+
+(defun list< (a b)
+  (cond
+   ((and (numberp a) (numberp b) (< a b)))
+   ((and (stringp a) (stringp b) (string< a b)))))
+
+(defun list> (a b)
+  (cond
+   ((and (numberp a) (numberp b) (> a b)))
+   ((and (stringp a) (stringp b) (string> a b)))))
+
+(defun list-up ()
+  (interactive)
+  (list-buffer-sort (get-text-property (point) :col) #'list<))
+
+(defun list-down ()
+  (interactive)
+  (list-buffer-sort (get-text-property (point) :col) #'list>))
+
+(defun list-enter ()
+  (interactive)
+  (funcall *list-enter-function* (nth (list-current-row) *buffer-list*)))
+
+(defun list-filter ()
+  (interactive)
+  (error "not implemented."))
+
+(defvar list-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<up>")    'list-up)
+    (define-key map (kbd "<down>")  'list-down)
+    (define-key map (kbd "f")       'list-filter)
+    (define-key map (kbd "RET")     'list-enter)
+    (define-key map (kbd "q")       'bury-buffer)
+    map)
+  "Keymap for `list-mode'.")
+
+(define-derived-mode list-mode nil "list"
+  "Major mode for viewing a list.")
 
 (provide 'list-buffer)