536 lines
18 KiB
EmacsLisp
536 lines
18 KiB
EmacsLisp
;;; bui-list.el --- 'List' buffer interface for displaying data -*- lexical-binding: t -*-
|
||
|
||
;; Copyright © 2014–2018 Alex Kost <alezost@gmail.com>
|
||
|
||
;; This program 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 program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This file provides 'list' buffer interface for displaying an arbitrary
|
||
;; data.
|
||
|
||
;;; Code:
|
||
|
||
(require 'cl-lib)
|
||
(require 'dash)
|
||
(require 'tabulated-list)
|
||
(require 'bui-core)
|
||
(require 'bui-button)
|
||
(require 'bui-entry)
|
||
(require 'bui-utils)
|
||
|
||
(bui-define-groups bui-list)
|
||
|
||
|
||
;;; General 'list' variables
|
||
|
||
(defvar bui-list-format nil
|
||
"List of methods to get values of the displayed columns.
|
||
Each element of the list has a form:
|
||
|
||
(PARAM VALUE-FUN WIDTH SORT . PROPS)
|
||
|
||
PARAM is a name of an entry parameter.
|
||
|
||
VALUE-FUN may be either nil or a function returning a value that
|
||
will be inserted. The function is called with 2 arguments: the
|
||
first one is the value of the parameter; the second one is an
|
||
entry (alist of parameter names and values).
|
||
|
||
For the meaning of WIDTH, SORT and PROPS, see
|
||
`tabulated-list-format'.")
|
||
(put 'bui-list-format 'permanent-local t)
|
||
|
||
(defcustom bui-list-sort-key nil
|
||
"Default sort key for 'list' buffer.
|
||
Should be nil (no sort) or have a form:
|
||
|
||
(PARAM . FLIP)
|
||
|
||
PARAM is the name of an entry parameter. For the meaning of
|
||
FLIP, see `tabulated-list-sort-key'."
|
||
:type '(choice (const :tag "No sort" nil)
|
||
(cons symbol boolean))
|
||
:group 'bui-list)
|
||
(put 'bui-list-sort-key 'permanent-local t)
|
||
|
||
(defvar bui-list-additional-marks nil
|
||
"Alist of additional marks for 'list' buffer.
|
||
Marks from this list are used along with `bui-list-default-marks'.")
|
||
(put 'bui-list-additional-marks 'permanent-local t)
|
||
|
||
(defcustom bui-list-show-single nil
|
||
"If non-nil, list an entry even if it is the only matching result.
|
||
If nil, show a single entry in the 'info' buffer instead."
|
||
:type 'boolean
|
||
:group 'bui-list)
|
||
(put 'bui-list-show-single 'permanent-local t)
|
||
|
||
(defcustom bui-list-describe-warning-count 10
|
||
"The maximum number of entries to describe without a warning.
|
||
If you want to describe more than this number of marked entries,
|
||
you will be prompted for confirmation. See also
|
||
`bui-list-describe'."
|
||
:type 'integer
|
||
:group 'bui-list)
|
||
(put 'bui-list-describe-warning-count 'permanent-local t)
|
||
|
||
(defvar bui-list-describe-function nil
|
||
"Function used by `bui-list-describe'.
|
||
It is applied to the entries IDs as the rest arguments.
|
||
If nil, 'describing' is not performed (it usually means that
|
||
'info' interface is not defined).")
|
||
(put 'bui-list-describe-function 'permanent-local t)
|
||
|
||
(defconst bui-list-symbol-specifications
|
||
'((:describe-function describe-function t)
|
||
(:describe-count describe-warning-count t)
|
||
(:format format t)
|
||
(:list-single? show-single t)
|
||
(:marks additional-marks)
|
||
(:sort-key sort-key t))
|
||
"Specifications for generating 'list' variables.
|
||
See `bui-symbol-specifications' for details.")
|
||
|
||
|
||
;;; Displaying 'info' buffer
|
||
|
||
(defun bui-list-describe (&rest mark-names)
|
||
"Describe entries marked with MARK-NAMES.
|
||
'Describe' means display entries in 'info' buffer.
|
||
If no entries are marked, describe the current entry.
|
||
|
||
Available MARK-NAMES are symbols from `bui-list-marks'.
|
||
|
||
Interactively, describe entries marked with a general mark. With
|
||
prefix argument, describe entries marked with any mark."
|
||
(interactive (unless current-prefix-arg '(general)))
|
||
(or bui-list-describe-function
|
||
(error "Can't display 'info' buffer: '%S' is unset"
|
||
(bui-list-symbol (bui-current-entry-type)
|
||
'describe-function)))
|
||
(let* ((ids (or (apply #'bui-list-get-marked-id-list mark-names)
|
||
(list (bui-list-current-id))))
|
||
(count (length ids)))
|
||
(when (or (<= count bui-list-describe-warning-count)
|
||
(y-or-n-p (format "Do you really want to describe %d entries? "
|
||
count)))
|
||
(apply bui-list-describe-function ids))))
|
||
|
||
|
||
;;; Wrappers for 'list' variables
|
||
|
||
(defun bui-list-symbol (entry-type symbol)
|
||
"Return symbol for ENTRY-TYPE and 'list' buffer type."
|
||
(bui-symbol entry-type 'list symbol))
|
||
|
||
(defun bui-list-symbol-value (entry-type symbol)
|
||
"Return SYMBOL's value for ENTRY-TYPE and 'list' buffer type."
|
||
(bui-symbol-value entry-type 'list symbol))
|
||
|
||
(defun bui-list-param-title (entry-type param)
|
||
"Return column title of an ENTRY-TYPE parameter PARAM."
|
||
(bui-param-title entry-type 'list param))
|
||
|
||
(defun bui-list-format (entry-type)
|
||
"Return column format for ENTRY-TYPE."
|
||
(bui-list-symbol-value entry-type 'format))
|
||
|
||
(defun bui-list-displayed-params (entry-type)
|
||
"Return a list of ENTRY-TYPE parameters that should be displayed."
|
||
(mapcar #'car (bui-list-format entry-type)))
|
||
|
||
(defun bui-list-show-single-entry? (entry-type)
|
||
"Return non-nil, if a single entry of ENTRY-TYPE should be listed."
|
||
(or (bui-list-symbol-value entry-type 'show-single)
|
||
bui-list-show-single))
|
||
|
||
|
||
;;; Tabulated list internals
|
||
|
||
(defun bui-list-sort-numerically (column a b)
|
||
"Compare COLUMN of tabulated entries A and B numerically.
|
||
This function is used for sort predicates for `tabulated-list-format'.
|
||
Return non-nil, if B is bigger than A."
|
||
(cl-flet ((num (entry)
|
||
(string-to-number (aref (cadr entry) column))))
|
||
(> (num b) (num a))))
|
||
|
||
(defmacro bui-list-define-numerical-sorter (column)
|
||
"Define numerical sort predicate for COLUMN.
|
||
See `bui-list-sort-numerically' for details."
|
||
(let ((name (intern (format "bui-list-sort-numerically-%d" column)))
|
||
(doc (format "\
|
||
Predicate to sort tabulated list by column %d numerically.
|
||
See `bui-list-sort-numerically' for details."
|
||
column)))
|
||
`(defun ,name (a b)
|
||
,doc
|
||
(bui-list-sort-numerically ,column a b))))
|
||
|
||
(defmacro bui-list-define-numerical-sorters (n)
|
||
"Define numerical sort predicates for columns from 0 to N.
|
||
See `bui-list-define-numerical-sorter' for details."
|
||
`(progn
|
||
,@(mapcar (lambda (i)
|
||
`(bui-list-define-numerical-sorter ,i))
|
||
(number-sequence 0 n))))
|
||
|
||
(bui-list-define-numerical-sorters 9)
|
||
|
||
(defun bui-list-tabulated-sort-key ()
|
||
"Return sort key for `tabulated-list-sort-key'."
|
||
(and bui-list-sort-key
|
||
(cons (bui-current-param-title (car bui-list-sort-key))
|
||
(cdr bui-list-sort-key))))
|
||
|
||
(defun bui-list-tabulated-vector (fun)
|
||
"Call FUN on each column specification.
|
||
|
||
FUN is applied to column specification as arguments (see
|
||
`bui-list-format').
|
||
|
||
Return a vector made of values of FUN calls."
|
||
(apply #'vector
|
||
(mapcar (lambda (col-spec)
|
||
(apply fun col-spec))
|
||
bui-list-format)))
|
||
|
||
(defun bui-list-tabulated-format ()
|
||
"Return list specification for `tabulated-list-format'."
|
||
(bui-list-tabulated-vector
|
||
(lambda (param _ &rest rest-spec)
|
||
(cons (bui-current-param-title param)
|
||
rest-spec))))
|
||
|
||
(defun bui-list-tabulated-entries (entries entry-type)
|
||
"Return a list of ENTRY-TYPE values for `tabulated-list-entries'."
|
||
(mapcar (lambda (entry)
|
||
(list (bui-entry-id entry)
|
||
(bui-list-tabulated-entry entry entry-type)))
|
||
entries))
|
||
|
||
(defun bui-list-tabulated-entry (entry entry-type)
|
||
"Return array of values for `tabulated-list-entries'.
|
||
Parameters are taken from ENTRY-TYPE ENTRY."
|
||
(bui-list-tabulated-vector
|
||
(lambda (param fun &rest _)
|
||
(let ((value (bui-entry-value entry param)))
|
||
(cond
|
||
;; If function is specified, then it should probably return
|
||
;; something, even if VALUE is void, so give it the precedence.
|
||
(fun (funcall fun (bui-entry-non-void-value entry param) entry))
|
||
((bui-void-value? value) bui-empty-string)
|
||
((and (null value)
|
||
(bui-boolean-param? entry-type 'list param))
|
||
bui-false-string)
|
||
(t (bui-get-string value)))))))
|
||
|
||
|
||
;;; Displaying entries
|
||
|
||
(defun bui-list-get-display-entries (entry-type &rest args)
|
||
"Search for entries and show them in a 'list' buffer preferably."
|
||
(let ((entries (bui-get-entries entry-type 'list args)))
|
||
(if (or (null entries) ; = 0
|
||
(cdr entries) ; > 1
|
||
(bui-list-show-single-entry? entry-type)
|
||
(not (bui-interface-defined? entry-type 'info)))
|
||
(bui-display-entries entries entry-type 'list args)
|
||
(if (equal (bui-symbol-value entry-type 'info 'get-entries-function)
|
||
(bui-symbol-value entry-type 'list 'get-entries-function))
|
||
(bui-display-entries entries entry-type 'info args)
|
||
(bui-get-display-entries entry-type 'info args)))))
|
||
|
||
(defun bui-list-insert-entries (entries entry-type)
|
||
"Print ENTRY-TYPE ENTRIES in the current buffer."
|
||
(setq tabulated-list-entries
|
||
(bui-list-tabulated-entries entries entry-type))
|
||
(tabulated-list-print))
|
||
|
||
(defun bui-list-get-one-line (value &optional _)
|
||
"Return one-line string from a multi-line string VALUE.
|
||
VALUE may be nil."
|
||
(bui-get-non-nil value
|
||
(bui-get-one-line value)))
|
||
|
||
(defun bui-list-get-time (time &optional _)
|
||
"Return formatted time string from TIME.
|
||
TIME may be nil or another value supported by `bui-get-time-string'."
|
||
(bui-get-non-nil time
|
||
(bui-get-string (bui-get-time-string time)
|
||
'bui-time)))
|
||
|
||
(defun bui-list-get-file-name (file-name &optional _)
|
||
"Return FILE-NAME button specification for `tabulated-list-entries'.
|
||
FILE-NAME may be nil."
|
||
(bui-get-non-nil file-name
|
||
(list file-name
|
||
:type 'bui-file
|
||
'file file-name)))
|
||
|
||
(defun bui-list-get-url (url &optional _)
|
||
"Return URL button specification for `tabulated-list-entries'.
|
||
URL may be nil."
|
||
(bui-get-non-nil url
|
||
(list url
|
||
:type 'bui-url
|
||
'url url)))
|
||
|
||
|
||
;;; 'List' lines
|
||
|
||
(defun bui-list-current-id ()
|
||
"Return ID of the entry at point."
|
||
(or (tabulated-list-get-id)
|
||
(user-error "No entry here")))
|
||
|
||
(defun bui-list-current-entry ()
|
||
"Return entry at point."
|
||
(bui-entry-by-id (bui-current-entries)
|
||
(bui-list-current-id)))
|
||
|
||
(defun bui-list-for-each-line (fun &rest args)
|
||
"Call FUN with ARGS for each entry line."
|
||
(or (derived-mode-p 'bui-list-mode)
|
||
(error "The current buffer is not in `bui-list-mode'"))
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(while (not (eobp))
|
||
(apply fun args)
|
||
(forward-line))))
|
||
|
||
(defun bui-list-fold-lines (fun init)
|
||
"Fold over entry lines in the current list buffer.
|
||
Call FUN with RESULT as argument for each line, using INIT as
|
||
the initial value of RESULT. Return the final result."
|
||
(let ((res init))
|
||
(bui-list-for-each-line
|
||
(lambda () (setq res (funcall fun res))))
|
||
res))
|
||
|
||
|
||
;;; Marking and sorting
|
||
|
||
(defvar-local bui-list-marked nil
|
||
"List of the marked entries.
|
||
Each element of the list has a form:
|
||
|
||
(ID MARK-NAME . ARGS)
|
||
|
||
ID is an entry ID.
|
||
MARK-NAME is a symbol from `bui-list-marks'.
|
||
ARGS is a list of additional values.")
|
||
|
||
(defvar-local bui-list-marks nil
|
||
"Alist of available mark names and mark characters.")
|
||
|
||
(defvar bui-list-default-marks
|
||
'((empty . ?\s)
|
||
(general . ?*))
|
||
"Alist of default mark names and mark characters.")
|
||
|
||
(defun bui-list-get-mark (name)
|
||
"Return mark character by its NAME."
|
||
(or (bui-assq-value bui-list-marks name)
|
||
(error "Mark '%S' not found" name)))
|
||
|
||
(defun bui-list-get-mark-string (name)
|
||
"Return mark string by its NAME."
|
||
(string (bui-list-get-mark name)))
|
||
|
||
(defun bui-list-current-mark ()
|
||
"Return mark character of the current line."
|
||
(char-after (line-beginning-position)))
|
||
|
||
(defun bui-list-current-mark-name ()
|
||
"Return name of the mark on the current line."
|
||
(or (car (bui-assq-value bui-list-marked (bui-list-current-id)))
|
||
'empty))
|
||
|
||
(defun bui-list-get-marked (&rest mark-names)
|
||
"Return list of specs of entries marked with any mark from MARK-NAMES.
|
||
Entry specs are elements from `bui-list-marked' list.
|
||
If MARK-NAMES are not specified, use all marks from
|
||
`bui-list-marks' except the `empty' one."
|
||
(or mark-names
|
||
(setq mark-names
|
||
(delq 'empty (mapcar #'car bui-list-marks))))
|
||
(-filter (-lambda ((_id name . _))
|
||
(memq name mark-names))
|
||
bui-list-marked))
|
||
|
||
(defun bui-list-get-marked-args (mark-name)
|
||
"Return list of (ID . ARGS) elements from lines marked with MARK-NAME.
|
||
See `bui-list-marked' for the meaning of ARGS."
|
||
(mapcar (-lambda ((id _name . args))
|
||
(cons id args))
|
||
(bui-list-get-marked mark-name)))
|
||
|
||
(defun bui-list-get-marked-id-list (&rest mark-names)
|
||
"Return list of IDs of entries marked with any mark from MARK-NAMES.
|
||
See `bui-list-get-marked' for details."
|
||
(mapcar #'car (apply #'bui-list-get-marked mark-names)))
|
||
|
||
(defun bui-list-marked-or-current (&rest mark-names)
|
||
"Return a list of IDs of the marked entries.
|
||
If nothing is marked, return a list with ID of the current entry.
|
||
See `bui-list-get-marked' for the meaning of MARK-NAMES."
|
||
(or (apply #'bui-list-get-marked-id-list mark-names)
|
||
(list (bui-list-current-id))))
|
||
|
||
(defun bui-list-map-marked (function &rest mark-names)
|
||
"Apply FUNCTION to each element of the marked entries.
|
||
If nothing is marked, call FUNCTION on the current entry.
|
||
See `bui-list-get-marked' for the meaning of MARK-NAMES."
|
||
(mapcar function
|
||
(apply #'bui-list-marked-or-current mark-names)))
|
||
|
||
(defun bui-list--mark (mark-name &optional advance &rest args)
|
||
"Put a mark on the current line.
|
||
Also add the current entry to `bui-list-marked' using its ID and ARGS.
|
||
MARK-NAME is a symbol from `bui-list-marks'.
|
||
If ADVANCE is non-nil, move forward by one line after marking."
|
||
(let ((id (bui-list-current-id)))
|
||
(if (eq mark-name 'empty)
|
||
(setq bui-list-marked (assq-delete-all id bui-list-marked))
|
||
(let ((assoc (assq id bui-list-marked))
|
||
(val (cons mark-name args)))
|
||
(if assoc
|
||
(setcdr assoc val)
|
||
(push (cons id val) bui-list-marked)))))
|
||
(tabulated-list-put-tag (bui-list-get-mark-string mark-name)
|
||
advance))
|
||
|
||
(defun bui-list-mark (&optional arg)
|
||
"Mark the current line and move to the next line.
|
||
With ARG, mark all lines."
|
||
(interactive "P")
|
||
(if arg
|
||
(bui-list-mark-all)
|
||
(bui-list--mark 'general t)))
|
||
|
||
(defun bui-list-mark-all (&optional mark-name)
|
||
"Mark all lines with MARK-NAME mark.
|
||
MARK-NAME is a symbol from `bui-list-marks'.
|
||
Interactively, put a general mark on all lines."
|
||
(interactive)
|
||
(or mark-name (setq mark-name 'general))
|
||
(setq bui-list-marked
|
||
(if (eq mark-name 'empty)
|
||
nil
|
||
(mapcar (lambda (entry)
|
||
(list (bui-entry-id entry) mark-name))
|
||
(bui-current-entries))))
|
||
(bui-list-for-each-line #'tabulated-list-put-tag
|
||
(bui-list-get-mark-string mark-name)))
|
||
|
||
(defun bui-list-unmark (&optional arg)
|
||
"Unmark the current line and move to the next line.
|
||
With ARG, unmark all lines."
|
||
(interactive "P")
|
||
(if arg
|
||
(bui-list-unmark-all)
|
||
(bui-list--mark 'empty t)))
|
||
|
||
(defun bui-list-unmark-backward ()
|
||
"Move up one line and unmark it."
|
||
(interactive)
|
||
(forward-line -1)
|
||
(bui-list--mark 'empty))
|
||
|
||
(defun bui-list-unmark-all ()
|
||
"Unmark all lines."
|
||
(interactive)
|
||
(bui-list-mark-all 'empty))
|
||
|
||
(defun bui-list-restore-marks ()
|
||
"Put marks according to `bui-list-marked'."
|
||
(bui-list-for-each-line
|
||
(lambda ()
|
||
(let ((mark-name (bui-list-current-mark-name)))
|
||
(unless (eq mark-name 'empty)
|
||
(tabulated-list-put-tag
|
||
(bui-list-get-mark-string mark-name)))))))
|
||
|
||
(defun bui-list-sort (&optional n)
|
||
"Sort list entries by the column at point.
|
||
With a numeric prefix argument N, sort the Nth column.
|
||
Same as `tabulated-list-sort', but also restore marks after sorting."
|
||
(interactive "P")
|
||
(tabulated-list-sort n)
|
||
(bui-list-restore-marks))
|
||
|
||
|
||
;;; Major mode
|
||
|
||
(defvar bui-list-mode-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(set-keymap-parent
|
||
map (make-composed-keymap bui-map
|
||
tabulated-list-mode-map))
|
||
(define-key map (kbd "i") 'bui-list-describe)
|
||
(define-key map (kbd "RET") 'bui-list-describe)
|
||
(define-key map (kbd "*") 'bui-list-mark)
|
||
(define-key map (kbd "m") 'bui-list-mark)
|
||
(define-key map (kbd "M") 'bui-list-mark-all)
|
||
(define-key map (kbd "u") 'bui-list-unmark)
|
||
(define-key map (kbd "DEL") 'bui-list-unmark-backward)
|
||
(define-key map (kbd "U") 'bui-list-unmark-all)
|
||
(define-key map (kbd "s") 'bui-list-sort)
|
||
(define-key map [remap tabulated-list-sort] 'bui-list-sort)
|
||
map)
|
||
"Keymap for `bui-list-mode' buffers.")
|
||
|
||
(defvar bui-list-mark-hint
|
||
'(("\\[bui-list-mark]") " mark; "
|
||
("\\[bui-list-unmark]") " unmark; "
|
||
("\\[bui-list-unmark-backward]") " unmark backward;\n")
|
||
"Hint with 'mark' keys for 'list' buffer.
|
||
See `bui-hint' for details.")
|
||
|
||
(defvar bui-list-sort-hint
|
||
'(("\\[bui-list-sort]") " sort by column;\n")
|
||
"Hint with 'sort' keys for 'list' buffer.
|
||
See `bui-hint' for details.")
|
||
|
||
(defvar bui-list-info-hint
|
||
'(("\\[bui-list-describe]") " show 'info' buffer;\n")
|
||
"Hint for 'list' buffer used only when 'info' interface is defined.
|
||
See `bui-hint' for details.")
|
||
|
||
(defun bui-list-hint ()
|
||
"Return hint structure for the current 'list' buffer."
|
||
(bui-format-hints
|
||
bui-list-mark-hint
|
||
(and (bui-interface-defined? (bui-current-entry-type) 'info)
|
||
bui-list-info-hint)
|
||
bui-list-sort-hint))
|
||
|
||
(define-derived-mode bui-list-mode tabulated-list-mode "BUI-List"
|
||
"Parent mode for displaying data in 'list' form."
|
||
(bui-list-initialize))
|
||
|
||
(defun bui-list-initialize ()
|
||
"Set up the current 'list' buffer."
|
||
(setq tabulated-list-padding 2
|
||
tabulated-list-format (bui-list-tabulated-format)
|
||
tabulated-list-sort-key (bui-list-tabulated-sort-key))
|
||
(setq-local bui-list-marks (append bui-list-default-marks
|
||
bui-list-additional-marks))
|
||
(tabulated-list-init-header))
|
||
|
||
(provide 'bui-list)
|
||
|
||
;;; bui-list.el ends here
|