193 lines
7.0 KiB
EmacsLisp
193 lines
7.0 KiB
EmacsLisp
|
;;; list-buffer.el --- view a list as a table in a buffer
|
||
|
|
|
||
|
|
;; Copyright (C) 2013 Free Software Foundation, Inc.
|
||
|
|
|
||
|
|
;; Author: Eric Schulte <schulte.eric@gmail.com>
|
||
|
|
;; Created: 2013-08-02
|
||
|
|
;; Version: 0.1
|
||
|
|
;; Keywords: list buffer cl
|
||
|
|
|
||
|
|
;; This software is free software: you can redistribute it and/or modify
|
||
|
|
;; it under the terms of the GNU General Public License as published by
|
||
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
||
|
|
;; (at your option) any later version.
|
||
|
|
|
||
|
|
;; This software is distributed in the hope that it will be useful,
|
||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
;; GNU General Public License for more details.
|
||
|
|
|
||
|
|
;; You should have received a copy of the GNU General Public License
|
||
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||
|
|
|
||
|
|
;;; Code:
|
||
|
|
(eval-when-compile (require 'cl))
|
||
|
|
(require 'go-util)
|
||
|
|
|
||
|
|
(defvar *buffer-list* nil
|
||
|
|
"List associated with the current list buffer.")
|
||
|
|
|
||
|
|
(defvar *buffer-headers* nil
|
||
|
|
"Headers associated with the current list buffer.")
|
||
|
|
|
||
|
|
(defvar *buffer-width* nil
|
||
|
|
"Width associated with the current list buffer.")
|
||
|
|
|
||
|
|
(defvar *enter-function* nil
|
||
|
|
"Function used to enter a list element.
|
||
|
|
The function should take two arguments, the current row and
|
||
|
|
column respectively and may access the current buffer list
|
||
|
|
through the `*buffer-list*' variable.")
|
||
|
|
|
||
|
|
(defvar *refresh-function* nil
|
||
|
|
"Function used to refresh a list element or the whole list.
|
||
|
|
The function should take two arguments, the current row and
|
||
|
|
column respectively and may access the current buffer list
|
||
|
|
through the `*buffer-list*' variable.")
|
||
|
|
|
||
|
|
(defun list-buffer-create
|
||
|
|
(buffer list &optional headers enter-function refresh-function)
|
||
|
|
(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))
|
||
|
|
(set (make-local-variable '*enter-function*)
|
||
|
|
(or enter-function
|
||
|
|
(lambda (row col)
|
||
|
|
(message "enter %S" (nth col (nth row *buffer-list*))))))
|
||
|
|
(set (make-local-variable '*refresh-function*)
|
||
|
|
(or refresh-function
|
||
|
|
(lambda (row col)
|
||
|
|
(message "refresh %S" (nth col (nth row *buffer-list*))))))
|
||
|
|
;; refresh every time the buffer changes size
|
||
|
|
(set (make-local-variable 'window-size-change-functions)
|
||
|
|
(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 &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 ()
|
||
|
|
(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)))
|
||
|
|
(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 *enter-function* (list-current-row) (list-current-col)))
|
||
|
|
|
||
|
|
(defun list-refresh ()
|
||
|
|
(interactive)
|
||
|
|
(funcall *refresh-function* (list-current-row) (list-current-col)))
|
||
|
|
|
||
|
|
(defun list-filter ()
|
||
|
|
(interactive)
|
||
|
|
(error "not implemented."))
|
||
|
|
|
||
|
|
(defun list-move-col (direction)
|
||
|
|
(cl-flet ((col () (or (get-text-property (point) :col) start-col)))
|
||
|
|
(let ((start-col (col)))
|
||
|
|
(while (= start-col (col))
|
||
|
|
(case direction
|
||
|
|
(:forward (forward-char))
|
||
|
|
(:backward (backward-char))))
|
||
|
|
(when (eql direction :backward)
|
||
|
|
(let ((end-col (col)))
|
||
|
|
(while (= end-col (col)) (backward-char))
|
||
|
|
(forward-char))))))
|
||
|
|
|
||
|
|
(defun list-next-col () (interactive) (list-move-col :forward))
|
||
|
|
(defun list-prev-col () (interactive) (list-move-col :backward))
|
||
|
|
|
||
|
|
(defvar list-mode-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
;; navigation
|
||
|
|
(define-key map (kbd "j") 'next-line)
|
||
|
|
(define-key map (kbd "k") 'previous-line)
|
||
|
|
(define-key map (kbd "u") 'scroll-down-command)
|
||
|
|
(define-key map (kbd "<tab>") 'list-next-col)
|
||
|
|
(define-key map (kbd "<S-iso-lefttab>") 'list-prev-col)
|
||
|
|
;; list functions
|
||
|
|
(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 "r") 'list-refresh)
|
||
|
|
(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)
|
||
|
|
;;; list-buffer.el ends here
|