Commit | Line | Data |
---|---|---|
6c40b7b7 AK |
1 | ;;; guix-buffer.el --- Buffer interface for displaying data -*- lexical-binding: t -*- |
2 | ||
3 | ;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> | |
4 | ||
5 | ;; This file is part of GNU Guix. | |
6 | ||
7 | ;; GNU Guix is free software; you can redistribute it and/or modify | |
8 | ;; it under the terms of the GNU General Public License as published by | |
9 | ;; the Free Software Foundation, either version 3 of the License, or | |
10 | ;; (at your option) any later version. | |
11 | ||
12 | ;; GNU Guix is distributed in the hope that it will be useful, | |
13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;; GNU General Public License for more details. | |
16 | ||
17 | ;; You should have received a copy of the GNU General Public License | |
18 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | ;;; Commentary: | |
21 | ||
22 | ;; This file provides a general 'buffer' interface for displaying an | |
23 | ;; arbitrary data. | |
24 | ||
25 | ;;; Code: | |
26 | ||
27 | (require 'cl-lib) | |
28 | (require 'guix-history) | |
29 | (require 'guix-utils) | |
30 | ||
31 | (defvar guix-buffer-map | |
32 | (let ((map (make-sparse-keymap))) | |
33 | (define-key map (kbd "l") 'guix-history-back) | |
34 | (define-key map (kbd "r") 'guix-history-forward) | |
35 | (define-key map (kbd "g") 'revert-buffer) | |
36 | (define-key map (kbd "R") 'guix-buffer-redisplay) | |
37 | map) | |
38 | "Parent keymap for Guix buffer modes.") | |
39 | ||
40 | \f | |
41 | ;;; Buffer item | |
42 | ||
43 | (cl-defstruct (guix-buffer-item | |
44 | (:constructor nil) | |
45 | (:constructor guix-buffer-make-item | |
46 | (entries buffer-type entry-type args)) | |
47 | (:copier nil)) | |
48 | entries buffer-type entry-type args) | |
49 | ||
50 | (defvar-local guix-buffer-item nil | |
51 | "Data (structure) for the current Guix buffer. | |
52 | The structure consists of the following elements: | |
53 | ||
54 | - `entries': list of the currently displayed entries. | |
55 | ||
56 | Each element of the list is an alist with an entry data of the | |
57 | following form: | |
58 | ||
59 | ((PARAM . VAL) ...) | |
60 | ||
61 | PARAM is a name of the entry parameter. | |
62 | VAL is a value of this parameter. | |
63 | ||
64 | - `entry-type': type of the currently displayed entries. | |
65 | ||
66 | - `buffer-type': type of the current buffer. | |
67 | ||
68 | - `args': search arguments used to get the current entries.") | |
69 | (put 'guix-buffer-item 'permanent-local t) | |
70 | ||
71 | (defmacro guix-buffer-with-item (item &rest body) | |
72 | "Evaluate BODY using buffer ITEM. | |
73 | The following local variables are available inside BODY: | |
74 | `%entries', `%buffer-type', `%entry-type', `%args'. | |
75 | See `guix-buffer-item' for details." | |
76 | (declare (indent 1) (debug t)) | |
77 | (let ((item-var (make-symbol "item"))) | |
78 | `(let ((,item-var ,item)) | |
79 | (let ((%entries (guix-buffer-item-entries ,item-var)) | |
80 | (%buffer-type (guix-buffer-item-buffer-type ,item-var)) | |
81 | (%entry-type (guix-buffer-item-entry-type ,item-var)) | |
82 | (%args (guix-buffer-item-args ,item-var))) | |
83 | ,@body)))) | |
84 | ||
85 | (defmacro guix-buffer-with-current-item (&rest body) | |
86 | "Evaluate BODY using `guix-buffer-item'. | |
87 | See `guix-buffer-with-item' for details." | |
88 | (declare (indent 0) (debug t)) | |
89 | `(guix-buffer-with-item guix-buffer-item | |
90 | ,@body)) | |
91 | ||
92 | (defmacro guix-buffer-define-current-item-accessor (name) | |
93 | "Define `guix-buffer-current-NAME' function to access NAME | |
94 | element of `guix-buffer-item' structure. | |
95 | NAME should be a symbol." | |
96 | (let* ((name-str (symbol-name name)) | |
97 | (accessor (intern (concat "guix-buffer-item-" name-str))) | |
98 | (fun-name (intern (concat "guix-buffer-current-" name-str))) | |
99 | (doc (format "\ | |
100 | Return '%s' of the current Guix buffer. | |
101 | See `guix-buffer-item' for details." | |
102 | name-str))) | |
103 | `(defun ,fun-name () | |
104 | ,doc | |
105 | (and guix-buffer-item | |
106 | (,accessor guix-buffer-item))))) | |
107 | ||
108 | (defmacro guix-buffer-define-current-item-accessors (&rest names) | |
109 | "Define `guix-buffer-current-NAME' functions for NAMES. | |
110 | See `guix-buffer-define-current-item-accessor' for details." | |
111 | `(progn | |
112 | ,@(mapcar (lambda (name) | |
113 | `(guix-buffer-define-current-item-accessor ,name)) | |
114 | names))) | |
115 | ||
116 | (guix-buffer-define-current-item-accessors | |
117 | entries entry-type buffer-type args) | |
118 | ||
119 | (defmacro guix-buffer-define-current-args-accessor (n prefix name) | |
120 | "Define `PREFIX-NAME' function to access Nth element of 'args' | |
121 | field of `guix-buffer-item' structure. | |
122 | PREFIX and NAME should be strings." | |
123 | (let ((fun-name (intern (concat prefix "-" name))) | |
124 | (doc (format "\ | |
125 | Return '%s' of the current Guix buffer. | |
126 | '%s' is the element number %d in 'args' of `guix-buffer-item'." | |
127 | name name n))) | |
128 | `(defun ,fun-name () | |
129 | ,doc | |
130 | (nth ,n (guix-buffer-current-args))))) | |
131 | ||
132 | (defmacro guix-buffer-define-current-args-accessors (prefix &rest names) | |
133 | "Define `PREFIX-NAME' functions for NAMES. | |
134 | See `guix-buffer-define-current-args-accessor' for details." | |
135 | `(progn | |
136 | ,@(cl-loop for name in names | |
137 | for i from 0 | |
138 | collect `(guix-buffer-define-current-args-accessor | |
139 | ,i ,prefix ,name)))) | |
140 | ||
141 | \f | |
142 | ;;; Wrappers for defined variables | |
143 | ||
144 | (defvar guix-buffer-data nil | |
145 | "Alist with 'buffer' data. | |
146 | This alist is filled by `guix-buffer-define-interface' macro.") | |
147 | ||
148 | (defun guix-buffer-value (buffer-type entry-type symbol) | |
149 | "Return SYMBOL's value for BUFFER-TYPE/ENTRY-TYPE from `guix-buffer-data'." | |
150 | (symbol-value | |
151 | (guix-assq-value guix-buffer-data buffer-type entry-type symbol))) | |
152 | ||
153 | (defun guix-buffer-get-entries (buffer-type entry-type args) | |
154 | "Return ENTRY-TYPE entries. | |
155 | Call an appropriate 'get-entries' function from `guix-buffer' | |
156 | using ARGS as its arguments." | |
157 | (apply (guix-buffer-value buffer-type entry-type 'get-entries) | |
158 | args)) | |
159 | ||
160 | (defun guix-buffer-mode-enable (buffer-type entry-type) | |
161 | "Turn on major mode to display ENTRY-TYPE ENTRIES in BUFFER-TYPE buffer." | |
162 | (funcall (guix-buffer-value buffer-type entry-type 'mode))) | |
163 | ||
164 | (defun guix-buffer-mode-initialize (buffer-type entry-type) | |
165 | "Set up the current BUFFER-TYPE buffer to display ENTRY-TYPE entries." | |
166 | (let ((fun (guix-buffer-value buffer-type entry-type 'mode-init))) | |
167 | (when fun | |
168 | (funcall fun)))) | |
169 | ||
170 | (defun guix-buffer-insert-entries (entries buffer-type entry-type) | |
171 | "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." | |
172 | (funcall (guix-buffer-value buffer-type entry-type 'insert-entries) | |
173 | entries)) | |
174 | ||
175 | (defun guix-buffer-show-entries-default (entries buffer-type entry-type) | |
176 | "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." | |
177 | (let ((inhibit-read-only t)) | |
178 | (erase-buffer) | |
179 | (guix-buffer-mode-enable buffer-type entry-type) | |
180 | (guix-buffer-insert-entries entries buffer-type entry-type) | |
181 | (goto-char (point-min)))) | |
182 | ||
183 | (defun guix-buffer-show-entries (entries buffer-type entry-type) | |
184 | "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." | |
185 | (funcall (guix-buffer-value buffer-type entry-type 'show-entries) | |
186 | entries)) | |
187 | ||
188 | (defun guix-buffer-message (entries buffer-type entry-type args) | |
189 | "Display a message for BUFFER-ITEM after showing entries." | |
190 | (let ((fun (guix-buffer-value buffer-type entry-type 'message))) | |
191 | (when fun | |
192 | (apply fun entries args)))) | |
193 | ||
194 | (defun guix-buffer-name (buffer-type entry-type args) | |
195 | "Return name of BUFFER-TYPE buffer for displaying ENTRY-TYPE entries." | |
196 | (let ((str-or-fun (guix-buffer-value buffer-type entry-type | |
197 | 'buffer-name))) | |
198 | (if (stringp str-or-fun) | |
199 | str-or-fun | |
200 | (apply str-or-fun args)))) | |
201 | ||
202 | (defun guix-buffer-param-title (buffer-type entry-type param) | |
203 | "Return PARAM title for BUFFER-TYPE/ENTRY-TYPE." | |
204 | (or (guix-assq-value (guix-buffer-value buffer-type entry-type 'titles) | |
205 | param) | |
206 | ;; Fallback to a title defined in 'info' interface. | |
207 | (unless (eq buffer-type 'info) | |
208 | (guix-assq-value (guix-buffer-value 'info entry-type 'titles) | |
209 | param)) | |
210 | (guix-symbol-title param))) | |
211 | ||
212 | (defun guix-buffer-history-size (buffer-type entry-type) | |
213 | "Return history size for BUFFER-TYPE/ENTRY-TYPE." | |
214 | (guix-buffer-value buffer-type entry-type 'history-size)) | |
215 | ||
216 | (defun guix-buffer-revert-confirm? (buffer-type entry-type) | |
217 | "Return 'revert-confirm' value for BUFFER-TYPE/ENTRY-TYPE." | |
218 | (guix-buffer-value buffer-type entry-type 'revert-confirm)) | |
219 | ||
220 | \f | |
221 | ;;; Displaying entries | |
222 | ||
223 | (defun guix-buffer-display (buffer) | |
224 | "Switch to a Guix BUFFER." | |
225 | (pop-to-buffer buffer | |
226 | '((display-buffer-reuse-window | |
227 | display-buffer-same-window)))) | |
228 | ||
229 | (defun guix-buffer-history-item (buffer-item) | |
230 | "Make and return a history item for displaying BUFFER-ITEM." | |
231 | (list #'guix-buffer-set buffer-item)) | |
232 | ||
233 | (defun guix-buffer-set (buffer-item &optional history) | |
234 | "Set up the current buffer for displaying BUFFER-ITEM. | |
235 | HISTORY should be one of the following: | |
236 | ||
237 | `nil' - do not save BUFFER-ITEM in history, | |
238 | ||
239 | `add' - add it to history, | |
240 | ||
241 | `replace' - replace the current history item." | |
242 | (guix-buffer-with-item buffer-item | |
243 | (when %entries | |
0338132e AK |
244 | ;; Set buffer item before showing entries, so that its value can |
245 | ;; be used by the code for displaying entries. | |
6c40b7b7 | 246 | (setq guix-buffer-item buffer-item) |
0338132e | 247 | (guix-buffer-show-entries %entries %buffer-type %entry-type) |
6c40b7b7 AK |
248 | (when history |
249 | (funcall (cl-ecase history | |
250 | (add #'guix-history-add) | |
251 | (replace #'guix-history-replace)) | |
252 | (guix-buffer-history-item buffer-item)))) | |
253 | (guix-buffer-message %entries %buffer-type %entry-type %args))) | |
254 | ||
255 | (defun guix-buffer-display-entries-current | |
256 | (entries buffer-type entry-type args &optional history) | |
257 | "Show ENTRIES in the current Guix buffer. | |
258 | See `guix-buffer-item' for the meaning of BUFFER-TYPE, ENTRY-TYPE | |
259 | and ARGS, and `guix-buffer-set' for the meaning of HISTORY." | |
260 | (let ((item (guix-buffer-make-item entries buffer-type | |
261 | entry-type args))) | |
262 | (guix-buffer-set item history))) | |
263 | ||
264 | (defun guix-buffer-get-display-entries-current | |
265 | (buffer-type entry-type args &optional history) | |
266 | "Search for entries and show them in the current Guix buffer. | |
267 | See `guix-buffer-display-entries-current' for details." | |
268 | (guix-buffer-display-entries-current | |
269 | (guix-buffer-get-entries buffer-type entry-type args) | |
270 | buffer-type entry-type args history)) | |
271 | ||
272 | (defun guix-buffer-display-entries | |
273 | (entries buffer-type entry-type args &optional history) | |
274 | "Show ENTRIES in a BUFFER-TYPE buffer. | |
275 | See `guix-buffer-display-entries-current' for details." | |
276 | (let ((buffer (get-buffer-create | |
277 | (guix-buffer-name buffer-type entry-type args)))) | |
278 | (with-current-buffer buffer | |
279 | (guix-buffer-display-entries-current | |
280 | entries buffer-type entry-type args history)) | |
281 | (when entries | |
282 | (guix-buffer-display buffer)))) | |
283 | ||
284 | (defun guix-buffer-get-display-entries | |
285 | (buffer-type entry-type args &optional history) | |
286 | "Search for entries and show them in a BUFFER-TYPE buffer. | |
287 | See `guix-buffer-display-entries-current' for details." | |
288 | (guix-buffer-display-entries | |
289 | (guix-buffer-get-entries buffer-type entry-type args) | |
290 | buffer-type entry-type args history)) | |
291 | ||
292 | (defun guix-buffer-revert (_ignore-auto noconfirm) | |
293 | "Update the data in the current Guix buffer. | |
294 | This function is suitable for `revert-buffer-function'. | |
295 | See `revert-buffer' for the meaning of NOCONFIRM." | |
296 | (guix-buffer-with-current-item | |
297 | (when (or noconfirm | |
298 | (not (guix-buffer-revert-confirm? %buffer-type %entry-type)) | |
299 | (y-or-n-p "Update the current buffer? ")) | |
300 | (guix-buffer-get-display-entries-current | |
301 | %buffer-type %entry-type %args 'replace)))) | |
302 | ||
303 | (defvar guix-buffer-after-redisplay-hook nil | |
304 | "Hook run by `guix-buffer-redisplay'. | |
305 | This hook is called before seting up a window position.") | |
306 | ||
307 | (defun guix-buffer-redisplay () | |
308 | "Redisplay the current Guix buffer. | |
309 | Restore the point and window positions after redisplaying. | |
310 | ||
311 | This function does not update the buffer data, use | |
312 | '\\[revert-buffer]' if you want the full update." | |
313 | (interactive) | |
314 | (let* ((old-point (point)) | |
315 | ;; For simplicity, ignore an unlikely case when multiple | |
316 | ;; windows display the same buffer. | |
317 | (window (car (get-buffer-window-list (current-buffer) nil t))) | |
318 | (window-start (and window (window-start window)))) | |
319 | (guix-buffer-set guix-buffer-item) | |
320 | (goto-char old-point) | |
321 | (run-hooks 'guix-buffer-after-redisplay-hook) | |
322 | (when window | |
323 | (set-window-point window (point)) | |
324 | (set-window-start window window-start)))) | |
325 | ||
326 | (defun guix-buffer-redisplay-goto-button () | |
327 | "Redisplay the current buffer and go to the next button, if needed." | |
328 | (let ((guix-buffer-after-redisplay-hook | |
329 | (cons (lambda () | |
330 | (unless (button-at (point)) | |
331 | (forward-button 1))) | |
332 | guix-buffer-after-redisplay-hook))) | |
333 | (guix-buffer-redisplay))) | |
334 | ||
335 | \f | |
8ed2c92e AK |
336 | ;;; Interface definers |
337 | ||
338 | (defmacro guix-define-groups (type &rest args) | |
339 | "Define `guix-TYPE' and `guix-TYPE-faces' custom groups. | |
340 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | |
341 | ||
342 | Optional keywords: | |
343 | ||
344 | - `:parent-group' - name of a parent custom group. | |
345 | ||
346 | - `:parent-faces-group' - name of a parent custom faces group. | |
347 | ||
348 | - `:group-doc' - docstring of a `guix-TYPE' group. | |
349 | ||
350 | - `:faces-group-doc' - docstring of a `guix-TYPE-faces' group." | |
351 | (declare (indent 1)) | |
352 | (let* ((type-str (symbol-name type)) | |
353 | (prefix (concat "guix-" type-str)) | |
354 | (group (intern prefix)) | |
355 | (faces-group (intern (concat prefix "-faces")))) | |
356 | (guix-keyword-args-let args | |
357 | ((parent-group :parent-group 'guix) | |
358 | (parent-faces-group :parent-faces-group 'guix-faces) | |
359 | (group-doc :group-doc | |
360 | (format "Settings for '%s' buffers." | |
361 | type-str)) | |
362 | (faces-group-doc :faces-group-doc | |
363 | (format "Faces for '%s' buffers." | |
364 | type-str))) | |
365 | `(progn | |
366 | (defgroup ,group nil | |
367 | ,group-doc | |
368 | :group ',parent-group) | |
369 | ||
370 | (defgroup ,faces-group nil | |
371 | ,faces-group-doc | |
372 | :group ',group | |
373 | :group ',parent-faces-group))))) | |
374 | ||
375 | (defmacro guix-define-entry-type (entry-type &rest args) | |
376 | "Define general code for ENTRY-TYPE. | |
377 | See `guix-define-groups'." | |
378 | (declare (indent 1)) | |
379 | `(guix-define-groups ,entry-type | |
380 | ,@args)) | |
381 | ||
382 | (defmacro guix-define-buffer-type (buffer-type &rest args) | |
383 | "Define general code for BUFFER-TYPE. | |
384 | See `guix-define-groups'." | |
385 | (declare (indent 1)) | |
386 | `(guix-define-groups ,buffer-type | |
387 | ,@args)) | |
6c40b7b7 AK |
388 | |
389 | (defmacro guix-buffer-define-interface (buffer-type entry-type &rest args) | |
390 | "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries. | |
391 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | |
392 | In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE. | |
393 | ||
394 | Required keywords: | |
395 | ||
396 | - `:buffer-name' - default value of the generated | |
397 | `guix-TYPE-buffer-name' variable. | |
398 | ||
399 | - `:get-entries-function' - default value of the generated | |
400 | `guix-TYPE-get-function' variable. | |
401 | ||
402 | - `:show-entries-function' - default value of the generated | |
403 | `guix-TYPE-show-function' variable. | |
404 | ||
405 | Alternatively, if `:show-entries-function' is not specified, a | |
406 | default `guix-TYPE-show-entries' will be generated, and the | |
407 | following keyword should be specified instead: | |
408 | ||
409 | - `:insert-entries-function' - default value of the generated | |
410 | `guix-TYPE-insert-function' variable. | |
411 | ||
412 | Optional keywords: | |
413 | ||
414 | - `:message-function' - default value of the generated | |
415 | `guix-TYPE-message-function' variable. | |
416 | ||
417 | - `:titles' - default value of the generated | |
418 | `guix-TYPE-titles' variable. | |
419 | ||
420 | - `:history-size' - default value of the generated | |
421 | `guix-TYPE-history-size' variable. | |
422 | ||
423 | - `:revert-confirm?' - default value of the generated | |
424 | `guix-TYPE-revert-confirm' variable. | |
425 | ||
426 | - `:mode-name' - name (a string appeared in the mode-line) of | |
427 | the generated `guix-TYPE-mode'. | |
428 | ||
429 | - `:mode-init-function' - default value of the generated | |
430 | `guix-TYPE-mode-initialize-function' variable. | |
431 | ||
432 | - `:reduced?' - if non-nil, generate only group, faces group | |
433 | and titles variable (if specified); all keywords become | |
434 | optional." | |
435 | (declare (indent 2)) | |
436 | (let* ((entry-type-str (symbol-name entry-type)) | |
437 | (buffer-type-str (symbol-name buffer-type)) | |
438 | (prefix (concat "guix-" entry-type-str "-" | |
439 | buffer-type-str)) | |
440 | (group (intern prefix)) | |
441 | (faces-group (intern (concat prefix "-faces"))) | |
442 | (get-entries-var (intern (concat prefix "-get-function"))) | |
443 | (show-entries-var (intern (concat prefix "-show-function"))) | |
444 | (show-entries-fun (intern (concat prefix "-show-entries"))) | |
445 | (message-var (intern (concat prefix "-message-function"))) | |
446 | (buffer-name-var (intern (concat prefix "-buffer-name"))) | |
447 | (titles-var (intern (concat prefix "-titles"))) | |
448 | (history-size-var (intern (concat prefix "-history-size"))) | |
449 | (revert-confirm-var (intern (concat prefix "-revert-confirm")))) | |
450 | (guix-keyword-args-let args | |
451 | ((get-entries-val :get-entries-function) | |
452 | (show-entries-val :show-entries-function) | |
453 | (insert-entries-val :insert-entries-function) | |
454 | (mode-name :mode-name (capitalize prefix)) | |
455 | (mode-init-val :mode-init-function) | |
456 | (message-val :message-function) | |
457 | (buffer-name-val :buffer-name) | |
458 | (titles-val :titles) | |
459 | (history-size-val :history-size 20) | |
460 | (revert-confirm-val :revert-confirm? t) | |
461 | (reduced? :reduced?)) | |
462 | `(progn | |
463 | (defgroup ,group nil | |
8ed2c92e | 464 | ,(format "Displaying '%s' entries in '%s' buffer." |
6c40b7b7 | 465 | entry-type-str buffer-type-str) |
8ed2c92e | 466 | :group ',(intern (concat "guix-" entry-type-str)) |
6c40b7b7 AK |
467 | :group ',(intern (concat "guix-" buffer-type-str))) |
468 | ||
469 | (defgroup ,faces-group nil | |
470 | ,(format "Faces for displaying '%s' entries in '%s' buffer." | |
471 | entry-type-str buffer-type-str) | |
8ed2c92e AK |
472 | :group ',group |
473 | :group ',(intern (concat "guix-" entry-type-str "-faces")) | |
6c40b7b7 AK |
474 | :group ',(intern (concat "guix-" buffer-type-str "-faces"))) |
475 | ||
476 | (defcustom ,titles-var ,titles-val | |
477 | ,(format "Alist of titles of '%s' parameters." | |
478 | entry-type-str) | |
479 | :type '(alist :key-type symbol :value-type string) | |
480 | :group ',group) | |
481 | ||
482 | ,(unless reduced? | |
483 | `(progn | |
484 | (defvar ,get-entries-var ,get-entries-val | |
485 | ,(format "\ | |
486 | Function used to receive '%s' entries for '%s' buffer." | |
487 | entry-type-str buffer-type-str)) | |
488 | ||
489 | (defvar ,show-entries-var | |
490 | ,(or show-entries-val `',show-entries-fun) | |
491 | ,(format "\ | |
492 | Function used to show '%s' entries in '%s' buffer." | |
493 | entry-type-str buffer-type-str)) | |
494 | ||
495 | (defvar ,message-var ,message-val | |
496 | ,(format "\ | |
497 | Function used to display a message after showing '%s' entries. | |
498 | If nil, do not display messages." | |
499 | entry-type-str)) | |
500 | ||
501 | (defcustom ,buffer-name-var ,buffer-name-val | |
502 | ,(format "\ | |
503 | Default name of '%s' buffer for displaying '%s' entries. | |
504 | May be a string or a function returning a string. The function | |
505 | is called with the same arguments as `%S'." | |
506 | buffer-type-str entry-type-str get-entries-var) | |
507 | :type '(choice string function) | |
508 | :group ',group) | |
509 | ||
510 | (defcustom ,history-size-var ,history-size-val | |
511 | ,(format "\ | |
512 | Maximum number of items saved in history of `%S' buffer. | |
513 | If 0, the history is disabled." | |
514 | buffer-name-var) | |
515 | :type 'integer | |
516 | :group ',group) | |
517 | ||
518 | (defcustom ,revert-confirm-var ,revert-confirm-val | |
519 | ,(format "\ | |
520 | If non-nil, ask to confirm for reverting `%S' buffer." | |
521 | buffer-name-var) | |
522 | :type 'boolean | |
523 | :group ',group) | |
524 | ||
525 | (guix-alist-put! | |
526 | '((get-entries . ,get-entries-var) | |
527 | (show-entries . ,show-entries-var) | |
528 | (message . ,message-var) | |
529 | (buffer-name . ,buffer-name-var) | |
530 | (history-size . ,history-size-var) | |
531 | (revert-confirm . ,revert-confirm-var)) | |
532 | 'guix-buffer-data ',buffer-type ',entry-type) | |
533 | ||
534 | ,(unless show-entries-val | |
535 | `(defun ,show-entries-fun (entries) | |
536 | ,(format "\ | |
537 | Show '%s' ENTRIES in the current '%s' buffer." | |
538 | entry-type-str buffer-type-str) | |
539 | (guix-buffer-show-entries-default | |
540 | entries ',buffer-type ',entry-type))) | |
541 | ||
542 | ,(when (or insert-entries-val | |
543 | (null show-entries-val)) | |
544 | (let ((insert-entries-var | |
545 | (intern (concat prefix "-insert-function")))) | |
546 | `(progn | |
547 | (defvar ,insert-entries-var ,insert-entries-val | |
548 | ,(format "\ | |
549 | Function used to print '%s' entries in '%s' buffer." | |
550 | entry-type-str buffer-type-str)) | |
551 | ||
552 | (guix-alist-put! | |
553 | ',insert-entries-var 'guix-buffer-data | |
554 | ',buffer-type ',entry-type | |
555 | 'insert-entries)))) | |
556 | ||
557 | ,(when (or mode-name | |
558 | mode-init-val | |
559 | (null show-entries-val)) | |
560 | (let* ((mode-str (concat prefix "-mode")) | |
561 | (mode-map-str (concat mode-str "-map")) | |
562 | (mode (intern mode-str)) | |
563 | (parent-mode (intern | |
564 | (concat "guix-" buffer-type-str | |
565 | "-mode"))) | |
566 | (mode-var (intern | |
567 | (concat mode-str "-function"))) | |
568 | (mode-init-var (intern | |
569 | (concat mode-str | |
570 | "-initialize-function")))) | |
571 | `(progn | |
572 | (defvar ,mode-var ',mode | |
573 | ,(format "\ | |
574 | Major mode for displaying '%s' entries in '%s' buffer." | |
575 | entry-type-str buffer-type-str)) | |
576 | ||
577 | (defvar ,mode-init-var ,mode-init-val | |
578 | ,(format "\ | |
579 | Function used to set up '%s' buffer for displaying '%s' entries." | |
580 | buffer-type-str entry-type-str)) | |
581 | ||
582 | (define-derived-mode ,mode ,parent-mode ,mode-name | |
583 | ,(format "\ | |
584 | Major mode for displaying '%s' entries in '%s' buffer. | |
585 | ||
586 | \\{%s}" | |
587 | entry-type-str buffer-type-str mode-map-str) | |
588 | (setq-local revert-buffer-function | |
589 | 'guix-buffer-revert) | |
590 | (setq-local guix-history-size | |
591 | (guix-buffer-history-size | |
592 | ',buffer-type ',entry-type)) | |
593 | (guix-buffer-mode-initialize | |
594 | ',buffer-type ',entry-type)) | |
595 | ||
596 | (guix-alist-put! | |
597 | ',mode-var 'guix-buffer-data | |
598 | ',buffer-type ',entry-type 'mode) | |
599 | (guix-alist-put! | |
600 | ',mode-init-var 'guix-buffer-data | |
601 | ',buffer-type ',entry-type | |
602 | 'mode-init)))))) | |
603 | ||
604 | (guix-alist-put! | |
605 | ',titles-var 'guix-buffer-data | |
606 | ',buffer-type ',entry-type 'titles))))) | |
607 | ||
608 | \f | |
609 | (defvar guix-buffer-font-lock-keywords | |
610 | (eval-when-compile | |
611 | `((,(rx "(" (group (or "guix-buffer-with-item" | |
612 | "guix-buffer-with-current-item" | |
8ed2c92e AK |
613 | "guix-buffer-define-interface" |
614 | "guix-define-groups" | |
615 | "guix-define-entry-type" | |
616 | "guix-define-buffer-type")) | |
6c40b7b7 AK |
617 | symbol-end) |
618 | . 1)))) | |
619 | ||
620 | (font-lock-add-keywords 'emacs-lisp-mode guix-buffer-font-lock-keywords) | |
621 | ||
622 | (provide 'guix-buffer) | |
623 | ||
624 | ;;; guix-buffer.el ends here |