forked from Yuki-Inoue/tblui.el
-
Notifications
You must be signed in to change notification settings - Fork 0
/
tblui.el
233 lines (199 loc) · 9.18 KB
/
tblui.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
;;; tblui.el --- Define tabulated list UI easily -*- lexical-binding: t -*-
;; Copyright (C) 2016 Yuki Inoue
;; 2 function defs are taken from: https://github.com/politza/tablist
;; Namely, tblui--tablist-get-marked-items and tblui--tablist-map-over-marks
;; Those copyright belongs to:
;; Copyright (C) 2013, 2014 Andreas Politz
;; Author: Yuki Inoue <inouetakahiroki _at_ gmail.com>
;; URL: https://github.com/Yuki-Inoue/tblui.el
;; Version: 0.2.0
;; Package-Requires: ((dash "2.12.1") (magit-popup "2.6.0") (tablist "0.70") (cl-lib "0.5"))
;; This file is NOT part of GNU Emacs.
;; 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:
;; Define tabulated list UI easily.
;;; Code:
(require 'tablist)
(require 'dash)
(require 'magit-popup)
(require 'cl-lib)
(defun tblui--append-str-to-symbol (symbol str)
(intern (concat (symbol-name symbol) str)))
;; Following 2 functions taken from: https://github.com/politza/tablist
;; Copyright (C) 2013, 2014 Andreas Politz
;; licensed under GPLv3.
(defun tblui--tablist-map-over-marks (fn &optional arg show-progress
distinguish-one-marked)
(prog1
(cond
((and arg (integerp arg))
(let (results)
(tablist-repeat-over-lines
arg
(lambda ()
(if show-progress (sit-for 0))
(push (funcall fn) results)))
(if (< arg 0)
(nreverse results)
results)))
(arg
;; non-nil, non-integer ARG means use current item:
(tablist-skip-invisible-entries)
(unless (eobp)
(list (funcall fn))))
(t
(cl-labels ((cl-search (re)
(let (sucess)
(tablist-skip-invisible-entries)
(while (and (setq sucess
(re-search-forward re nil t))
(invisible-p (point)))
(tablist-forward-entry))
sucess)))
(let ((regexp (tablist-marker-regexp))
next-position results found)
(save-excursion
(goto-char (point-min))
;; remember position of next marked file before BODY
;; can insert lines before the just found file,
;; confusing us by finding the same marked file again
;; and again and...
(setq next-position (and (cl-search regexp)
(point-marker))
found (not (null next-position)))
(while next-position
(goto-char next-position)
(if show-progress (sit-for 0))
(push (funcall fn) results)
;; move after last match
(goto-char next-position)
(forward-line 1)
(set-marker next-position nil)
(setq next-position (and (cl-search regexp)
(point-marker)))))
(if (and distinguish-one-marked (= (length results) 1))
(setq results (cons t results)))
results))))
(tablist-move-to-major-column)))
(defun tblui--tablist-get-marked-items (&optional arg distinguish-one-marked)
"Return marked or ARG entries."
(let ((items (save-excursion
(tblui--tablist-map-over-marks
(lambda () (cons (tabulated-list-get-id)
(tabulated-list-get-entry)))
arg nil distinguish-one-marked))))
(if (and distinguish-one-marked
(eq (car items) t))
items
(nreverse items))))
;; end of copy from tablist
(defun tblui--select-if-empty (&optional _arg)
"Select current row is selection is empty."
(unless (tblui--tablist-get-marked-items)
(tablist-put-mark)))
;;;###autoload
(defmacro tblui-define (tblui-name title description entries-provider table-layout popup-definitions)
"Define tabulated list UI easily. Hereafter referred as tblui.
This macro defines functions and popups for the defined tblui.
User of this macro can focus on writing the logic for ui, let this
package handle the tabulated list buffer interaction part.
Each arguments are explained as follows:
* `TBLUI-NAME` : the symbol name of defining tblui. It will be used
as prefix for functions defined via this macro.
* `TITLE` : String title for the major mode created
* `DESCRIPTION` : Sting description for the major mode created
* `ENTRIES-PROVIDER` : the function which provides tabulated-list-entries
* `TABLE-LAYOUT` : the `tabulated-list-format` to be used for the tblui.
* `POPUP-DEFINITIONS` : list of popup definition.
A popup definition is an plist of
`(:key KEY :name NAME :funcs FUNCTIONS)`.
KEY is the key to be bound for the defined magit-popup.
NAME is the name for defined magit-popup.
FUNCTIONS is the list of action definition.
Action definition is a list of 3 elements,
which is `(ACTIONKEY DESCRIPTION FUNCTION)`.
ACTIONKEY is the key to be used as action key in the magit-popup.
DESCRIPTION is the description of the action.
FUNCTION is the logic to be called for this UI.
It is the elisp function which receives the IDs of tabulated-list entry,
and do what ever operation.
With this macro `TBLUI-NAME-goto-ui` function is defined.
Calling this function will popup and switch to the tblui buffer."
(let* ((goto-ui-symbol
(tblui--append-str-to-symbol tblui-name "-goto-ui"))
(ui-buffer-name
(concat "*" (symbol-name tblui-name) "*"))
(refresher-symbol
(tblui--append-str-to-symbol tblui-name "-refresher"))
(mode-name-symbol
(tblui--append-str-to-symbol tblui-name "-mode"))
(mode-map-symbol
(tblui--append-str-to-symbol mode-name-symbol "-map"))
(tabulated-list-format-symbol
(tblui--append-str-to-symbol tblui-name "-tabulated-list-format"))
(tabulated-list-format-docstring
(format "Table layout for %s." tblui-name))
(tablist-funcs
(->> popup-definitions
(mapcar (lambda (pdef) (plist-get pdef :funcs)))
(apply #'append)
(mapcar (apply-partially #'nth 2))))
(tablist-func-info-assoc
(->> tablist-funcs
(mapcar
(lambda (tablist-func)
(cons tablist-func
(tblui--append-str-to-symbol tablist-func "-popup-interface")))))))
`(progn
(defun ,refresher-symbol ()
(setq tabulated-list-entries (,entries-provider)))
,@(mapcar
(lambda (tablist-func-info-entry)
`(defun ,(cdr tablist-func-info-entry) ()
(interactive)
(,(car tablist-func-info-entry)
(mapcar #'car (tablist-get-marked-items)))))
tablist-func-info-assoc)
,@(mapcar
(lambda (popup-definition)
(let ((popup-name (plist-get popup-definition :name))
(associated-funcs (plist-get popup-definition :funcs)))
`(progn
(magit-define-popup ,popup-name (quote ,tblui-name)
:actions ',(mapcar
(lambda (entry)
(cl-multiple-value-bind
(key descr raw-func) entry
(list key descr (assoc-default raw-func tablist-func-info-assoc))))
associated-funcs))
(add-function :before (symbol-function ',popup-name) #'tblui--select-if-empty))))
popup-definitions)
(defvar ,tabulated-list-format-symbol ,table-layout ,tabulated-list-format-docstring)
(define-derived-mode ,mode-name-symbol tabulated-list-mode ,title ,description
,@(mapcar
(lambda (popup-definition)
(let ((key (plist-get popup-definition :key))
(popup-name (plist-get popup-definition :name)))
`(define-key ,mode-map-symbol ,key (function ,popup-name))))
popup-definitions)
(setq tabulated-list-format ,tabulated-list-format-symbol)
(setq tabulated-list-padding 2)
(add-hook 'tabulated-list-revert-hook (function ,refresher-symbol) nil t)
(tabulated-list-init-header)
(tablist-minor-mode))
(defun ,goto-ui-symbol ()
(pop-to-buffer ,ui-buffer-name)
(tabulated-list-init-header)
(,mode-name-symbol)
(tabulated-list-revert)))))
(provide 'tblui)
;;; tblui.el ends here