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 | |
244 | (guix-buffer-show-entries %entries %buffer-type %entry-type) | |
245 | (setq guix-buffer-item buffer-item) | |
246 | (when history | |
247 | (funcall (cl-ecase history | |
248 | (add #'guix-history-add) | |
249 | (replace #'guix-history-replace)) | |
250 | (guix-buffer-history-item buffer-item)))) | |
251 | (guix-buffer-message %entries %buffer-type %entry-type %args))) | |
252 | ||
253 | (defun guix-buffer-display-entries-current | |
254 | (entries buffer-type entry-type args &optional history) | |
255 | "Show ENTRIES in the current Guix buffer. | |
256 | See `guix-buffer-item' for the meaning of BUFFER-TYPE, ENTRY-TYPE | |
257 | and ARGS, and `guix-buffer-set' for the meaning of HISTORY." | |
258 | (let ((item (guix-buffer-make-item entries buffer-type | |
259 | entry-type args))) | |
260 | (guix-buffer-set item history))) | |
261 | ||
262 | (defun guix-buffer-get-display-entries-current | |
263 | (buffer-type entry-type args &optional history) | |
264 | "Search for entries and show them in the current Guix buffer. | |
265 | See `guix-buffer-display-entries-current' for details." | |
266 | (guix-buffer-display-entries-current | |
267 | (guix-buffer-get-entries buffer-type entry-type args) | |
268 | buffer-type entry-type args history)) | |
269 | ||
270 | (defun guix-buffer-display-entries | |
271 | (entries buffer-type entry-type args &optional history) | |
272 | "Show ENTRIES in a BUFFER-TYPE buffer. | |
273 | See `guix-buffer-display-entries-current' for details." | |
274 | (let ((buffer (get-buffer-create | |
275 | (guix-buffer-name buffer-type entry-type args)))) | |
276 | (with-current-buffer buffer | |
277 | (guix-buffer-display-entries-current | |
278 | entries buffer-type entry-type args history)) | |
279 | (when entries | |
280 | (guix-buffer-display buffer)))) | |
281 | ||
282 | (defun guix-buffer-get-display-entries | |
283 | (buffer-type entry-type args &optional history) | |
284 | "Search for entries and show them in a BUFFER-TYPE buffer. | |
285 | See `guix-buffer-display-entries-current' for details." | |
286 | (guix-buffer-display-entries | |
287 | (guix-buffer-get-entries buffer-type entry-type args) | |
288 | buffer-type entry-type args history)) | |
289 | ||
290 | (defun guix-buffer-revert (_ignore-auto noconfirm) | |
291 | "Update the data in the current Guix buffer. | |
292 | This function is suitable for `revert-buffer-function'. | |
293 | See `revert-buffer' for the meaning of NOCONFIRM." | |
294 | (guix-buffer-with-current-item | |
295 | (when (or noconfirm | |
296 | (not (guix-buffer-revert-confirm? %buffer-type %entry-type)) | |
297 | (y-or-n-p "Update the current buffer? ")) | |
298 | (guix-buffer-get-display-entries-current | |
299 | %buffer-type %entry-type %args 'replace)))) | |
300 | ||
301 | (defvar guix-buffer-after-redisplay-hook nil | |
302 | "Hook run by `guix-buffer-redisplay'. | |
303 | This hook is called before seting up a window position.") | |
304 | ||
305 | (defun guix-buffer-redisplay () | |
306 | "Redisplay the current Guix buffer. | |
307 | Restore the point and window positions after redisplaying. | |
308 | ||
309 | This function does not update the buffer data, use | |
310 | '\\[revert-buffer]' if you want the full update." | |
311 | (interactive) | |
312 | (let* ((old-point (point)) | |
313 | ;; For simplicity, ignore an unlikely case when multiple | |
314 | ;; windows display the same buffer. | |
315 | (window (car (get-buffer-window-list (current-buffer) nil t))) | |
316 | (window-start (and window (window-start window)))) | |
317 | (guix-buffer-set guix-buffer-item) | |
318 | (goto-char old-point) | |
319 | (run-hooks 'guix-buffer-after-redisplay-hook) | |
320 | (when window | |
321 | (set-window-point window (point)) | |
322 | (set-window-start window window-start)))) | |
323 | ||
324 | (defun guix-buffer-redisplay-goto-button () | |
325 | "Redisplay the current buffer and go to the next button, if needed." | |
326 | (let ((guix-buffer-after-redisplay-hook | |
327 | (cons (lambda () | |
328 | (unless (button-at (point)) | |
329 | (forward-button 1))) | |
330 | guix-buffer-after-redisplay-hook))) | |
331 | (guix-buffer-redisplay))) | |
332 | ||
333 | \f | |
8ed2c92e AK |
334 | ;;; Interface definers |
335 | ||
336 | (defmacro guix-define-groups (type &rest args) | |
337 | "Define `guix-TYPE' and `guix-TYPE-faces' custom groups. | |
338 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | |
339 | ||
340 | Optional keywords: | |
341 | ||
342 | - `:parent-group' - name of a parent custom group. | |
343 | ||
344 | - `:parent-faces-group' - name of a parent custom faces group. | |
345 | ||
346 | - `:group-doc' - docstring of a `guix-TYPE' group. | |
347 | ||
348 | - `:faces-group-doc' - docstring of a `guix-TYPE-faces' group." | |
349 | (declare (indent 1)) | |
350 | (let* ((type-str (symbol-name type)) | |
351 | (prefix (concat "guix-" type-str)) | |
352 | (group (intern prefix)) | |
353 | (faces-group (intern (concat prefix "-faces")))) | |
354 | (guix-keyword-args-let args | |
355 | ((parent-group :parent-group 'guix) | |
356 | (parent-faces-group :parent-faces-group 'guix-faces) | |
357 | (group-doc :group-doc | |
358 | (format "Settings for '%s' buffers." | |
359 | type-str)) | |
360 | (faces-group-doc :faces-group-doc | |
361 | (format "Faces for '%s' buffers." | |
362 | type-str))) | |
363 | `(progn | |
364 | (defgroup ,group nil | |
365 | ,group-doc | |
366 | :group ',parent-group) | |
367 | ||
368 | (defgroup ,faces-group nil | |
369 | ,faces-group-doc | |
370 | :group ',group | |
371 | :group ',parent-faces-group))))) | |
372 | ||
373 | (defmacro guix-define-entry-type (entry-type &rest args) | |
374 | "Define general code for ENTRY-TYPE. | |
375 | See `guix-define-groups'." | |
376 | (declare (indent 1)) | |
377 | `(guix-define-groups ,entry-type | |
378 | ,@args)) | |
379 | ||
380 | (defmacro guix-define-buffer-type (buffer-type &rest args) | |
381 | "Define general code for BUFFER-TYPE. | |
382 | See `guix-define-groups'." | |
383 | (declare (indent 1)) | |
384 | `(guix-define-groups ,buffer-type | |
385 | ,@args)) | |
6c40b7b7 AK |
386 | |
387 | (defmacro guix-buffer-define-interface (buffer-type entry-type &rest args) | |
388 | "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries. | |
389 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | |
390 | In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE. | |
391 | ||
392 | Required keywords: | |
393 | ||
394 | - `:buffer-name' - default value of the generated | |
395 | `guix-TYPE-buffer-name' variable. | |
396 | ||
397 | - `:get-entries-function' - default value of the generated | |
398 | `guix-TYPE-get-function' variable. | |
399 | ||
400 | - `:show-entries-function' - default value of the generated | |
401 | `guix-TYPE-show-function' variable. | |
402 | ||
403 | Alternatively, if `:show-entries-function' is not specified, a | |
404 | default `guix-TYPE-show-entries' will be generated, and the | |
405 | following keyword should be specified instead: | |
406 | ||
407 | - `:insert-entries-function' - default value of the generated | |
408 | `guix-TYPE-insert-function' variable. | |
409 | ||
410 | Optional keywords: | |
411 | ||
412 | - `:message-function' - default value of the generated | |
413 | `guix-TYPE-message-function' variable. | |
414 | ||
415 | - `:titles' - default value of the generated | |
416 | `guix-TYPE-titles' variable. | |
417 | ||
418 | - `:history-size' - default value of the generated | |
419 | `guix-TYPE-history-size' variable. | |
420 | ||
421 | - `:revert-confirm?' - default value of the generated | |
422 | `guix-TYPE-revert-confirm' variable. | |
423 | ||
424 | - `:mode-name' - name (a string appeared in the mode-line) of | |
425 | the generated `guix-TYPE-mode'. | |
426 | ||
427 | - `:mode-init-function' - default value of the generated | |
428 | `guix-TYPE-mode-initialize-function' variable. | |
429 | ||
430 | - `:reduced?' - if non-nil, generate only group, faces group | |
431 | and titles variable (if specified); all keywords become | |
432 | optional." | |
433 | (declare (indent 2)) | |
434 | (let* ((entry-type-str (symbol-name entry-type)) | |
435 | (buffer-type-str (symbol-name buffer-type)) | |
436 | (prefix (concat "guix-" entry-type-str "-" | |
437 | buffer-type-str)) | |
438 | (group (intern prefix)) | |
439 | (faces-group (intern (concat prefix "-faces"))) | |
440 | (get-entries-var (intern (concat prefix "-get-function"))) | |
441 | (show-entries-var (intern (concat prefix "-show-function"))) | |
442 | (show-entries-fun (intern (concat prefix "-show-entries"))) | |
443 | (message-var (intern (concat prefix "-message-function"))) | |
444 | (buffer-name-var (intern (concat prefix "-buffer-name"))) | |
445 | (titles-var (intern (concat prefix "-titles"))) | |
446 | (history-size-var (intern (concat prefix "-history-size"))) | |
447 | (revert-confirm-var (intern (concat prefix "-revert-confirm")))) | |
448 | (guix-keyword-args-let args | |
449 | ((get-entries-val :get-entries-function) | |
450 | (show-entries-val :show-entries-function) | |
451 | (insert-entries-val :insert-entries-function) | |
452 | (mode-name :mode-name (capitalize prefix)) | |
453 | (mode-init-val :mode-init-function) | |
454 | (message-val :message-function) | |
455 | (buffer-name-val :buffer-name) | |
456 | (titles-val :titles) | |
457 | (history-size-val :history-size 20) | |
458 | (revert-confirm-val :revert-confirm? t) | |
459 | (reduced? :reduced?)) | |
460 | `(progn | |
461 | (defgroup ,group nil | |
8ed2c92e | 462 | ,(format "Displaying '%s' entries in '%s' buffer." |
6c40b7b7 | 463 | entry-type-str buffer-type-str) |
8ed2c92e | 464 | :group ',(intern (concat "guix-" entry-type-str)) |
6c40b7b7 AK |
465 | :group ',(intern (concat "guix-" buffer-type-str))) |
466 | ||
467 | (defgroup ,faces-group nil | |
468 | ,(format "Faces for displaying '%s' entries in '%s' buffer." | |
469 | entry-type-str buffer-type-str) | |
8ed2c92e AK |
470 | :group ',group |
471 | :group ',(intern (concat "guix-" entry-type-str "-faces")) | |
6c40b7b7 AK |
472 | :group ',(intern (concat "guix-" buffer-type-str "-faces"))) |
473 | ||
474 | (defcustom ,titles-var ,titles-val | |
475 | ,(format "Alist of titles of '%s' parameters." | |
476 | entry-type-str) | |
477 | :type '(alist :key-type symbol :value-type string) | |
478 | :group ',group) | |
479 | ||
480 | ,(unless reduced? | |
481 | `(progn | |
482 | (defvar ,get-entries-var ,get-entries-val | |
483 | ,(format "\ | |
484 | Function used to receive '%s' entries for '%s' buffer." | |
485 | entry-type-str buffer-type-str)) | |
486 | ||
487 | (defvar ,show-entries-var | |
488 | ,(or show-entries-val `',show-entries-fun) | |
489 | ,(format "\ | |
490 | Function used to show '%s' entries in '%s' buffer." | |
491 | entry-type-str buffer-type-str)) | |
492 | ||
493 | (defvar ,message-var ,message-val | |
494 | ,(format "\ | |
495 | Function used to display a message after showing '%s' entries. | |
496 | If nil, do not display messages." | |
497 | entry-type-str)) | |
498 | ||
499 | (defcustom ,buffer-name-var ,buffer-name-val | |
500 | ,(format "\ | |
501 | Default name of '%s' buffer for displaying '%s' entries. | |
502 | May be a string or a function returning a string. The function | |
503 | is called with the same arguments as `%S'." | |
504 | buffer-type-str entry-type-str get-entries-var) | |
505 | :type '(choice string function) | |
506 | :group ',group) | |
507 | ||
508 | (defcustom ,history-size-var ,history-size-val | |
509 | ,(format "\ | |
510 | Maximum number of items saved in history of `%S' buffer. | |
511 | If 0, the history is disabled." | |
512 | buffer-name-var) | |
513 | :type 'integer | |
514 | :group ',group) | |
515 | ||
516 | (defcustom ,revert-confirm-var ,revert-confirm-val | |
517 | ,(format "\ | |
518 | If non-nil, ask to confirm for reverting `%S' buffer." | |
519 | buffer-name-var) | |
520 | :type 'boolean | |
521 | :group ',group) | |
522 | ||
523 | (guix-alist-put! | |
524 | '((get-entries . ,get-entries-var) | |
525 | (show-entries . ,show-entries-var) | |
526 | (message . ,message-var) | |
527 | (buffer-name . ,buffer-name-var) | |
528 | (history-size . ,history-size-var) | |
529 | (revert-confirm . ,revert-confirm-var)) | |
530 | 'guix-buffer-data ',buffer-type ',entry-type) | |
531 | ||
532 | ,(unless show-entries-val | |
533 | `(defun ,show-entries-fun (entries) | |
534 | ,(format "\ | |
535 | Show '%s' ENTRIES in the current '%s' buffer." | |
536 | entry-type-str buffer-type-str) | |
537 | (guix-buffer-show-entries-default | |
538 | entries ',buffer-type ',entry-type))) | |
539 | ||
540 | ,(when (or insert-entries-val | |
541 | (null show-entries-val)) | |
542 | (let ((insert-entries-var | |
543 | (intern (concat prefix "-insert-function")))) | |
544 | `(progn | |
545 | (defvar ,insert-entries-var ,insert-entries-val | |
546 | ,(format "\ | |
547 | Function used to print '%s' entries in '%s' buffer." | |
548 | entry-type-str buffer-type-str)) | |
549 | ||
550 | (guix-alist-put! | |
551 | ',insert-entries-var 'guix-buffer-data | |
552 | ',buffer-type ',entry-type | |
553 | 'insert-entries)))) | |
554 | ||
555 | ,(when (or mode-name | |
556 | mode-init-val | |
557 | (null show-entries-val)) | |
558 | (let* ((mode-str (concat prefix "-mode")) | |
559 | (mode-map-str (concat mode-str "-map")) | |
560 | (mode (intern mode-str)) | |
561 | (parent-mode (intern | |
562 | (concat "guix-" buffer-type-str | |
563 | "-mode"))) | |
564 | (mode-var (intern | |
565 | (concat mode-str "-function"))) | |
566 | (mode-init-var (intern | |
567 | (concat mode-str | |
568 | "-initialize-function")))) | |
569 | `(progn | |
570 | (defvar ,mode-var ',mode | |
571 | ,(format "\ | |
572 | Major mode for displaying '%s' entries in '%s' buffer." | |
573 | entry-type-str buffer-type-str)) | |
574 | ||
575 | (defvar ,mode-init-var ,mode-init-val | |
576 | ,(format "\ | |
577 | Function used to set up '%s' buffer for displaying '%s' entries." | |
578 | buffer-type-str entry-type-str)) | |
579 | ||
580 | (define-derived-mode ,mode ,parent-mode ,mode-name | |
581 | ,(format "\ | |
582 | Major mode for displaying '%s' entries in '%s' buffer. | |
583 | ||
584 | \\{%s}" | |
585 | entry-type-str buffer-type-str mode-map-str) | |
586 | (setq-local revert-buffer-function | |
587 | 'guix-buffer-revert) | |
588 | (setq-local guix-history-size | |
589 | (guix-buffer-history-size | |
590 | ',buffer-type ',entry-type)) | |
591 | (guix-buffer-mode-initialize | |
592 | ',buffer-type ',entry-type)) | |
593 | ||
594 | (guix-alist-put! | |
595 | ',mode-var 'guix-buffer-data | |
596 | ',buffer-type ',entry-type 'mode) | |
597 | (guix-alist-put! | |
598 | ',mode-init-var 'guix-buffer-data | |
599 | ',buffer-type ',entry-type | |
600 | 'mode-init)))))) | |
601 | ||
602 | (guix-alist-put! | |
603 | ',titles-var 'guix-buffer-data | |
604 | ',buffer-type ',entry-type 'titles))))) | |
605 | ||
606 | \f | |
607 | (defvar guix-buffer-font-lock-keywords | |
608 | (eval-when-compile | |
609 | `((,(rx "(" (group (or "guix-buffer-with-item" | |
610 | "guix-buffer-with-current-item" | |
8ed2c92e AK |
611 | "guix-buffer-define-interface" |
612 | "guix-define-groups" | |
613 | "guix-define-entry-type" | |
614 | "guix-define-buffer-type")) | |
6c40b7b7 AK |
615 | symbol-end) |
616 | . 1)))) | |
617 | ||
618 | (font-lock-add-keywords 'emacs-lisp-mode guix-buffer-font-lock-keywords) | |
619 | ||
620 | (provide 'guix-buffer) | |
621 | ||
622 | ;;; guix-buffer.el ends here |