Commit | Line | Data |
---|---|---|
dfeb0239 | 1 | ;;; guix-base.el --- Common definitions -*- lexical-binding: t -*- |
457f60fa | 2 | |
056b5cef | 3 | ;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> |
457f60fa AK |
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 some base and common definitions for guix.el | |
23 | ;; package. | |
24 | ||
25 | ;; List and info buffers have many common patterns that are defined | |
26 | ;; using `guix-define-buffer-type' macro from this file. | |
27 | ||
28 | ;;; Code: | |
29 | ||
30 | (require 'cl-lib) | |
3db349cb | 31 | (require 'guix-profiles) |
457f60fa | 32 | (require 'guix-backend) |
c74cd6cc | 33 | (require 'guix-guile) |
457f60fa | 34 | (require 'guix-utils) |
62f261d8 AK |
35 | (require 'guix-history) |
36 | (require 'guix-messages) | |
457f60fa AK |
37 | |
38 | \f | |
457f60fa AK |
39 | ;;; Parameters of the entries |
40 | ||
41 | (defvar guix-param-titles | |
42 | '((package | |
43 | (id . "ID") | |
44 | (name . "Name") | |
45 | (version . "Version") | |
0b0fbf0c | 46 | (source . "Source") |
457f60fa AK |
47 | (license . "License") |
48 | (synopsis . "Synopsis") | |
49 | (description . "Description") | |
50 | (home-url . "Home page") | |
51 | (outputs . "Outputs") | |
52 | (inputs . "Inputs") | |
53 | (native-inputs . "Native inputs") | |
54 | (propagated-inputs . "Propagated inputs") | |
55 | (location . "Location") | |
56 | (installed . "Installed")) | |
57 | (installed | |
58 | (path . "Installed path") | |
59 | (dependencies . "Dependencies") | |
60 | (output . "Output")) | |
a54a237b AK |
61 | (output |
62 | (id . "ID") | |
63 | (name . "Name") | |
64 | (version . "Version") | |
0b0fbf0c | 65 | (source . "Source") |
a54a237b AK |
66 | (license . "License") |
67 | (synopsis . "Synopsis") | |
68 | (description . "Description") | |
69 | (home-url . "Home page") | |
70 | (output . "Output") | |
71 | (inputs . "Inputs") | |
72 | (native-inputs . "Native inputs") | |
73 | (propagated-inputs . "Propagated inputs") | |
74 | (location . "Location") | |
75 | (installed . "Installed") | |
76 | (path . "Installed path") | |
77 | (dependencies . "Dependencies")) | |
457f60fa AK |
78 | (generation |
79 | (id . "ID") | |
80 | (number . "Number") | |
81 | (prev-number . "Previous number") | |
c2379b3c | 82 | (current . "Current") |
457f60fa AK |
83 | (path . "Path") |
84 | (time . "Time"))) | |
85 | "List for defining titles of entry parameters. | |
86 | Titles are used for displaying information about entries. | |
87 | Each element of the list has a form: | |
88 | ||
89 | (ENTRY-TYPE . ((PARAM . TITLE) ...))") | |
90 | ||
91 | (defun guix-get-param-title (entry-type param) | |
92 | "Return title of an ENTRY-TYPE entry parameter PARAM." | |
51dac383 AK |
93 | (or (guix-assq-value guix-param-titles |
94 | entry-type param) | |
457f60fa AK |
95 | (prog1 (symbol-name param) |
96 | (message "Couldn't find title for '%S %S'." | |
97 | entry-type param)))) | |
98 | ||
99 | (defun guix-get-name-spec (name version &optional output) | |
100 | "Return Guix package specification by its NAME, VERSION and OUTPUT." | |
101 | (concat name "-" version | |
102 | (when output (concat ":" output)))) | |
103 | ||
104 | (defun guix-get-full-name (entry &optional output) | |
105 | "Return name specification of the package ENTRY and OUTPUT." | |
51dac383 AK |
106 | (guix-get-name-spec (guix-assq-value entry 'name) |
107 | (guix-assq-value entry 'version) | |
457f60fa AK |
108 | output)) |
109 | ||
d2b299a9 AK |
110 | (defun guix-entry-to-specification (entry) |
111 | "Return name specification by the package or output ENTRY." | |
51dac383 AK |
112 | (guix-get-name-spec (guix-assq-value entry 'name) |
113 | (guix-assq-value entry 'version) | |
114 | (guix-assq-value entry 'output))) | |
d2b299a9 AK |
115 | |
116 | (defun guix-entries-to-specifications (entries) | |
117 | "Return name specifications by the package or output ENTRIES." | |
118 | (cl-remove-duplicates (mapcar #'guix-entry-to-specification entries) | |
119 | :test #'string=)) | |
120 | ||
457f60fa AK |
121 | (defun guix-get-installed-outputs (entry) |
122 | "Return list of installed outputs for the package ENTRY." | |
123 | (mapcar (lambda (installed-entry) | |
51dac383 AK |
124 | (guix-assq-value installed-entry 'output)) |
125 | (guix-assq-value entry 'installed))) | |
457f60fa AK |
126 | |
127 | (defun guix-get-entry-by-id (id entries) | |
128 | "Return entry from ENTRIES by entry ID." | |
129 | (cl-find-if (lambda (entry) | |
51dac383 | 130 | (equal id (guix-assq-value entry 'id))) |
457f60fa AK |
131 | entries)) |
132 | ||
a54a237b AK |
133 | (defun guix-get-package-id-and-output-by-output-id (oid) |
134 | "Return list (PACKAGE-ID OUTPUT) by output id OID." | |
135 | (cl-multiple-value-bind (pid-str output) | |
136 | (split-string oid ":") | |
137 | (let ((pid (string-to-number pid-str))) | |
138 | (list (if (= 0 pid) pid-str pid) | |
139 | output)))) | |
140 | ||
457f60fa AK |
141 | \f |
142 | ;;; Location of the packages | |
143 | ||
144 | (defvar guix-directory nil | |
145 | "Default Guix directory. | |
146 | If it is not set by a user, it is set after starting Guile REPL. | |
147 | This directory is used to define location of the packages.") | |
148 | ||
149 | (defun guix-set-directory () | |
150 | "Set `guix-directory' if needed." | |
151 | (or guix-directory | |
152 | (setq guix-directory | |
153 | (guix-eval-read "%guix-dir")))) | |
154 | ||
155 | (add-hook 'guix-after-start-repl-hook 'guix-set-directory) | |
156 | ||
157 | (defun guix-find-location (location) | |
158 | "Go to LOCATION of a package. | |
159 | LOCATION is a string of the form: | |
160 | ||
161 | \"PATH:LINE:COLUMN\" | |
162 | ||
163 | If PATH is relative, it is considered to be relative to | |
164 | `guix-directory'." | |
165 | (cl-multiple-value-bind (path line col) | |
166 | (split-string location ":") | |
167 | (let ((file (expand-file-name path guix-directory)) | |
168 | (line (string-to-number line)) | |
169 | (col (string-to-number col))) | |
170 | (find-file file) | |
171 | (goto-char (point-min)) | |
172 | (forward-line (- line 1)) | |
173 | (move-to-column col) | |
174 | (recenter 1)))) | |
175 | ||
eb097f36 AK |
176 | (defun guix-package-location (id-or-name) |
177 | "Return location of a package with ID-OR-NAME. | |
178 | For the meaning of location, see `guix-find-location'." | |
179 | (guix-eval-read (guix-make-guile-expression | |
180 | 'package-location-string id-or-name))) | |
6248e326 | 181 | |
457f60fa | 182 | \f |
056b5cef AK |
183 | ;;; Receivable lists of packages, lint checkers, etc. |
184 | ||
43b40c4b AK |
185 | (guix-memoized-defun guix-graph-type-names () |
186 | "Return a list of names of available graph node types." | |
187 | (guix-eval-read (guix-make-guile-expression 'graph-type-names))) | |
188 | ||
6407ce8e AK |
189 | (guix-memoized-defun guix-refresh-updater-names () |
190 | "Return a list of names of available refresh updater types." | |
191 | (guix-eval-read (guix-make-guile-expression 'refresh-updater-names))) | |
192 | ||
056b5cef AK |
193 | (guix-memoized-defun guix-lint-checker-names () |
194 | "Return a list of names of available lint checkers." | |
195 | (guix-eval-read (guix-make-guile-expression 'lint-checker-names))) | |
196 | ||
25a2839c AK |
197 | (guix-memoized-defun guix-package-names () |
198 | "Return a list of names of available packages." | |
199 | (sort | |
200 | ;; Work around <https://github.com/jaor/geiser/issues/64>: | |
201 | ;; list of strings is parsed much slower than list of lists, | |
202 | ;; so we use 'package-names-lists' instead of 'package-names'. | |
203 | ||
204 | ;; (guix-eval-read (guix-make-guile-expression 'package-names)) | |
205 | ||
206 | (mapcar #'car | |
207 | (guix-eval-read (guix-make-guile-expression | |
208 | 'package-names-lists))) | |
209 | #'string<)) | |
210 | ||
056b5cef | 211 | \f |
49d758d2 AK |
212 | ;;; Buffers and auto updating. |
213 | ||
214 | (defcustom guix-update-after-operation 'current | |
215 | "Define what information to update after executing an operation. | |
216 | ||
217 | After successful executing an operation in the Guix REPL (for | |
218 | example after installing a package), information in Guix buffers | |
219 | will or will not be automatically updated depending on a value of | |
220 | this variable. | |
221 | ||
222 | If nil, update nothing (do not revert any buffer). | |
223 | If `current', update the buffer from which an operation was performed. | |
224 | If `all', update all Guix buffers (not recommended)." | |
225 | :type '(choice (const :tag "Do nothing" nil) | |
226 | (const :tag "Update operation buffer" current) | |
227 | (const :tag "Update all Guix buffers" all)) | |
228 | :group 'guix) | |
229 | ||
23459fa5 AK |
230 | (defcustom guix-buffer-name-function #'guix-buffer-name-default |
231 | "Function used to define name of a buffer for displaying information. | |
232 | The function is called with 4 arguments: PROFILE, BUFFER-TYPE, | |
233 | ENTRY-TYPE, SEARCH-TYPE. See `guix-get-entries' for the meaning | |
234 | of the arguments." | |
235 | :type '(choice (function-item guix-buffer-name-default) | |
236 | (function-item guix-buffer-name-simple) | |
237 | (function :tag "Other function")) | |
238 | :group 'guix) | |
239 | ||
240 | (defun guix-buffer-name-simple (_profile buffer-type entry-type | |
241 | &optional _search-type) | |
242 | "Return name of a buffer used for displaying information. | |
243 | The name is defined by `guix-ENTRY-TYPE-BUFFER-TYPE-buffer-name' | |
244 | variable." | |
245 | (symbol-value | |
246 | (guix-get-symbol "buffer-name" buffer-type entry-type))) | |
247 | ||
248 | (defun guix-buffer-name-default (profile buffer-type entry-type | |
249 | &optional _search-type) | |
250 | "Return name of a buffer used for displaying information. | |
251 | The name is almost the same as the one defined by | |
252 | `guix-buffer-name-simple' except the PROFILE name is added to it." | |
253 | (let ((simple-name (guix-buffer-name-simple | |
254 | profile buffer-type entry-type)) | |
255 | (profile-name (file-name-base (directory-file-name profile))) | |
256 | (re (rx string-start | |
257 | (group (? "*")) | |
258 | (group (*? any)) | |
259 | (group (? "*")) | |
260 | string-end))) | |
261 | (or (string-match re simple-name) | |
262 | (error "Unexpected error in defining guix buffer name")) | |
263 | (let ((first* (match-string 1 simple-name)) | |
264 | (name-body (match-string 2 simple-name)) | |
265 | (last* (match-string 3 simple-name))) | |
266 | ;; Handle the case when buffer name is wrapped by '*'. | |
267 | (if (and (string= "*" first*) | |
268 | (string= "*" last*)) | |
269 | (concat "*" name-body ": " profile-name "*") | |
270 | (concat simple-name ": " profile-name))))) | |
271 | ||
272 | (defun guix-buffer-name (profile buffer-type entry-type search-type) | |
273 | "Return name of a buffer used for displaying information. | |
274 | See `guix-buffer-name-function' for details." | |
275 | (let ((fun (if (functionp guix-buffer-name-function) | |
276 | guix-buffer-name-function | |
277 | #'guix-buffer-name-default))) | |
278 | (funcall fun profile buffer-type entry-type search-type))) | |
279 | ||
49d758d2 AK |
280 | (defun guix-switch-to-buffer (buffer) |
281 | "Switch to a 'list' or 'info' BUFFER." | |
282 | (pop-to-buffer buffer | |
283 | '((display-buffer-reuse-window | |
284 | display-buffer-same-window)))) | |
285 | ||
f209da9f AK |
286 | (defun guix-buffer-p (&optional buffer modes) |
287 | "Return non-nil if BUFFER mode is derived from any of the MODES. | |
288 | If BUFFER is nil, check current buffer. | |
289 | If MODES is nil, use `guix-list-mode' and `guix-info-mode'." | |
49d758d2 | 290 | (with-current-buffer (or buffer (current-buffer)) |
f209da9f AK |
291 | (apply #'derived-mode-p |
292 | (or modes | |
293 | '(guix-list-mode guix-info-mode))))) | |
294 | ||
295 | (defun guix-buffers (&optional modes) | |
296 | "Return list of all buffers with major modes derived from MODES. | |
297 | If MODES is nil, return list of all Guix 'list' and 'info' buffers." | |
298 | (cl-remove-if-not (lambda (buf) | |
299 | (guix-buffer-p buf modes)) | |
49d758d2 AK |
300 | (buffer-list))) |
301 | ||
f209da9f AK |
302 | (defun guix-update-buffer (buffer) |
303 | "Update information in a 'list' or 'info' BUFFER." | |
304 | (with-current-buffer buffer | |
305 | (guix-revert-buffer nil t))) | |
306 | ||
307 | (defun guix-update-buffers-maybe-after-operation () | |
49d758d2 AK |
308 | "Update buffers after Guix operation if needed. |
309 | See `guix-update-after-operation' for details." | |
f209da9f AK |
310 | (let ((to-update |
311 | (and guix-operation-buffer | |
312 | (cl-case guix-update-after-operation | |
313 | (current (and (buffer-live-p guix-operation-buffer) | |
314 | (guix-buffer-p guix-operation-buffer) | |
315 | (list guix-operation-buffer))) | |
316 | (all (guix-buffers)))))) | |
49d758d2 | 317 | (setq guix-operation-buffer nil) |
f209da9f AK |
318 | (mapc #'guix-update-buffer to-update))) |
319 | ||
320 | (add-hook 'guix-after-repl-operation-hook | |
321 | 'guix-update-buffers-maybe-after-operation) | |
49d758d2 AK |
322 | |
323 | \f | |
457f60fa AK |
324 | ;;; Common definitions for buffer types |
325 | ||
74cc6737 AK |
326 | (defvar guix-root-map |
327 | (let ((map (make-sparse-keymap))) | |
328 | (define-key map (kbd "l") 'guix-history-back) | |
329 | (define-key map (kbd "r") 'guix-history-forward) | |
330 | (define-key map (kbd "g") 'revert-buffer) | |
331 | (define-key map (kbd "R") 'guix-redisplay-buffer) | |
332 | (define-key map (kbd "M") 'guix-apply-manifest) | |
333 | (define-key map (kbd "C-c C-z") 'guix-switch-to-repl) | |
334 | map) | |
335 | "Parent keymap for all guix modes.") | |
336 | ||
23459fa5 AK |
337 | (defvar-local guix-profile nil |
338 | "Profile used for the current buffer.") | |
339 | (put 'guix-profile 'permanent-local t) | |
340 | ||
457f60fa AK |
341 | (defvar-local guix-entries nil |
342 | "List of the currently displayed entries. | |
343 | Each element of the list is alist with entry info of the | |
344 | following form: | |
345 | ||
346 | ((PARAM . VAL) ...) | |
347 | ||
348 | PARAM is a name of the entry parameter. | |
349 | VAL is a value of this parameter.") | |
350 | (put 'guix-entries 'permanent-local t) | |
351 | ||
dfeb0239 AK |
352 | (defvar-local guix-buffer-type nil |
353 | "Type of the current buffer.") | |
354 | (put 'guix-buffer-type 'permanent-local t) | |
355 | ||
356 | (defvar-local guix-entry-type nil | |
357 | "Type of the current entry.") | |
358 | (put 'guix-entry-type 'permanent-local t) | |
359 | ||
457f60fa AK |
360 | (defvar-local guix-search-type nil |
361 | "Type of the current search.") | |
362 | (put 'guix-search-type 'permanent-local t) | |
363 | ||
364 | (defvar-local guix-search-vals nil | |
365 | "Values of the current search.") | |
366 | (put 'guix-search-vals 'permanent-local t) | |
367 | ||
23459fa5 | 368 | (defsubst guix-set-vars (profile entries buffer-type entry-type |
dfeb0239 | 369 | search-type search-vals) |
23459fa5 AK |
370 | "Set local variables for the current Guix buffer." |
371 | (setq default-directory profile | |
372 | guix-profile profile | |
373 | guix-entries entries | |
374 | guix-buffer-type buffer-type | |
375 | guix-entry-type entry-type | |
376 | guix-search-type search-type | |
377 | guix-search-vals search-vals)) | |
457f60fa | 378 | |
dfeb0239 AK |
379 | (defun guix-get-symbol (postfix buffer-type &optional entry-type) |
380 | (intern (concat "guix-" | |
381 | (when entry-type | |
382 | (concat (symbol-name entry-type) "-")) | |
383 | (symbol-name buffer-type) "-" postfix))) | |
457f60fa | 384 | |
dfeb0239 AK |
385 | (defmacro guix-define-buffer-type (buf-type entry-type &rest args) |
386 | "Define common for BUF-TYPE buffers for displaying ENTRY-TYPE entries. | |
457f60fa AK |
387 | |
388 | In the text below TYPE means ENTRY-TYPE-BUF-TYPE. | |
389 | ||
dfeb0239 AK |
390 | This macro defines `guix-TYPE-mode', a custom group and several |
391 | user variables. | |
457f60fa AK |
392 | |
393 | The following stuff should be defined outside this macro: | |
394 | ||
395 | - `guix-BUF-TYPE-mode' - parent mode for the defined mode. | |
396 | ||
457f60fa AK |
397 | - `guix-TYPE-mode-initialize' (optional) - function for |
398 | additional mode settings; it is called without arguments. | |
399 | ||
400 | Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The | |
401 | following keywords are available: | |
402 | ||
a54a237b AK |
403 | - `:buffer-name' - default value for the defined |
404 | `guix-TYPE-buffer-name' variable. | |
405 | ||
457f60fa AK |
406 | - `:required' - default value for the defined |
407 | `guix-TYPE-required-params' variable. | |
408 | ||
409 | - `:history-size' - default value for the defined | |
410 | `guix-TYPE-history-size' variable. | |
411 | ||
412 | - `:revert' - default value for the defined | |
413 | `guix-TYPE-revert-no-confirm' variable." | |
414 | (let* ((entry-type-str (symbol-name entry-type)) | |
415 | (buf-type-str (symbol-name buf-type)) | |
416 | (Entry-type-str (capitalize entry-type-str)) | |
417 | (Buf-type-str (capitalize buf-type-str)) | |
418 | (entry-str (concat entry-type-str " entries")) | |
419 | (buf-str (concat buf-type-str " buffer")) | |
420 | (prefix (concat "guix-" entry-type-str "-" buf-type-str)) | |
421 | (group (intern prefix)) | |
46e17df6 | 422 | (faces-group (intern (concat prefix "-faces"))) |
457f60fa | 423 | (mode-map-str (concat prefix "-mode-map")) |
457f60fa AK |
424 | (parent-mode (intern (concat "guix-" buf-type-str "-mode"))) |
425 | (mode (intern (concat prefix "-mode"))) | |
426 | (mode-init-fun (intern (concat prefix "-mode-initialize"))) | |
427 | (buf-name-var (intern (concat prefix "-buffer-name"))) | |
428 | (revert-var (intern (concat prefix "-revert-no-confirm"))) | |
457f60fa | 429 | (history-var (intern (concat prefix "-history-size"))) |
457f60fa | 430 | (params-var (intern (concat prefix "-required-params"))) |
a54a237b | 431 | (buf-name-val (format "*Guix %s %s*" Entry-type-str Buf-type-str)) |
457f60fa AK |
432 | (revert-val nil) |
433 | (history-val 20) | |
434 | (params-val '(id))) | |
435 | ||
436 | ;; Process the keyword args. | |
437 | (while (keywordp (car args)) | |
438 | (pcase (pop args) | |
439 | (`:required (setq params-val (pop args))) | |
440 | (`:history-size (setq history-val (pop args))) | |
441 | (`:revert (setq revert-val (pop args))) | |
a54a237b | 442 | (`:buffer-name (setq buf-name-val (pop args))) |
457f60fa AK |
443 | (_ (pop args)))) |
444 | ||
445 | `(progn | |
446 | (defgroup ,group nil | |
447 | ,(concat Buf-type-str " buffer with " entry-str ".") | |
448 | :prefix ,(concat prefix "-") | |
449 | :group ',(intern (concat "guix-" buf-type-str))) | |
450 | ||
46e17df6 AK |
451 | (defgroup ,faces-group nil |
452 | ,(concat "Faces for " buf-type-str " buffer with " entry-str ".") | |
453 | :group ',(intern (concat "guix-" buf-type-str "-faces"))) | |
454 | ||
a54a237b | 455 | (defcustom ,buf-name-var ,buf-name-val |
457f60fa AK |
456 | ,(concat "Default name of the " buf-str " for displaying " entry-str ".") |
457 | :type 'string | |
458 | :group ',group) | |
459 | ||
460 | (defcustom ,history-var ,history-val | |
461 | ,(concat "Maximum number of items saved in the history of the " buf-str ".\n" | |
462 | "If 0, the history is disabled.") | |
463 | :type 'integer | |
464 | :group ',group) | |
465 | ||
466 | (defcustom ,revert-var ,revert-val | |
467 | ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".") | |
468 | :type 'boolean | |
469 | :group ',group) | |
470 | ||
471 | (defvar ,params-var ',params-val | |
472 | ,(concat "List of required " entry-type-str " parameters.\n\n" | |
473 | "Displayed parameters and parameters from this list are received\n" | |
474 | "for each " entry-type-str ".\n\n" | |
475 | "May be a special value `all', in which case all supported\n" | |
476 | "parameters are received (this may be very slow for a big number\n" | |
477 | "of entries).\n\n" | |
478 | "Do not remove `id' from this list as it is required for\n" | |
479 | "identifying an entry.")) | |
480 | ||
481 | (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str) | |
482 | ,(concat "Major mode for displaying information about " entry-str ".\n\n" | |
483 | "\\{" mode-map-str "}") | |
dfeb0239 | 484 | (setq-local revert-buffer-function 'guix-revert-buffer) |
457f60fa | 485 | (setq-local guix-history-size ,history-var) |
74cc6737 | 486 | (and (fboundp ',mode-init-fun) (,mode-init-fun)))))) |
dfeb0239 AK |
487 | |
488 | (put 'guix-define-buffer-type 'lisp-indent-function 'defun) | |
489 | ||
490 | \f | |
3472bb20 AK |
491 | ;;; Getting and displaying info about packages and generations |
492 | ||
493 | (defcustom guix-package-list-type 'output | |
494 | "Define how to display packages in a list buffer. | |
495 | May be a symbol `package' or `output' (if `output', display each | |
496 | output on a separate line; if `package', display each package on | |
497 | a separate line)." | |
498 | :type '(choice (const :tag "List of packages" package) | |
499 | (const :tag "List of outputs" output)) | |
500 | :group 'guix) | |
501 | ||
502 | (defcustom guix-package-info-type 'package | |
503 | "Define how to display packages in an info buffer. | |
504 | May be a symbol `package' or `output' (if `output', display each | |
505 | output separately; if `package', display outputs inside a package | |
506 | information)." | |
507 | :type '(choice (const :tag "Display packages" package) | |
508 | (const :tag "Display outputs" output)) | |
509 | :group 'guix) | |
dfeb0239 | 510 | |
23459fa5 | 511 | (defun guix-get-entries (profile entry-type search-type search-vals |
dfeb0239 AK |
512 | &optional params) |
513 | "Search for entries of ENTRY-TYPE. | |
514 | ||
515 | Call an appropriate scheme function and return a list of the | |
516 | form of `guix-entries'. | |
517 | ||
81b339fe AK |
518 | ENTRY-TYPE should be one of the following symbols: `package', |
519 | `output' or `generation'. | |
dfeb0239 AK |
520 | |
521 | SEARCH-TYPE may be one of the following symbols: | |
522 | ||
523 | - If ENTRY-TYPE is `package' or `output': `id', `name', `regexp', | |
524 | `all-available', `newest-available', `installed', `obsolete', | |
525 | `generation'. | |
526 | ||
23459fa5 | 527 | - If ENTRY-TYPE is `generation': `id', `last', `all', `time'. |
dfeb0239 AK |
528 | |
529 | PARAMS is a list of parameters for receiving. If nil, get | |
530 | information with all available parameters." | |
531 | (guix-eval-read (guix-make-guile-expression | |
81b339fe | 532 | 'entries |
23459fa5 | 533 | profile params entry-type search-type search-vals))) |
dfeb0239 | 534 | |
23459fa5 AK |
535 | (defun guix-get-show-entries (profile buffer-type entry-type search-type |
536 | &rest search-vals) | |
dfeb0239 AK |
537 | "Search for ENTRY-TYPE entries and show results in BUFFER-TYPE buffer. |
538 | See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS." | |
23459fa5 | 539 | (let ((entries (guix-get-entries profile entry-type search-type search-vals |
dfeb0239 AK |
540 | (guix-get-params-for-receiving |
541 | buffer-type entry-type)))) | |
23459fa5 | 542 | (guix-set-buffer profile entries buffer-type entry-type |
dfeb0239 AK |
543 | search-type search-vals))) |
544 | ||
23459fa5 | 545 | (defun guix-set-buffer (profile entries buffer-type entry-type search-type |
49d758d2 | 546 | search-vals &optional history-replace no-display) |
dfeb0239 AK |
547 | "Set up BUFFER-TYPE buffer for displaying ENTRY-TYPE ENTRIES. |
548 | ||
49d758d2 | 549 | Insert ENTRIES in buffer, set variables and make history item. |
dfeb0239 AK |
550 | ENTRIES should have a form of `guix-entries'. |
551 | ||
552 | See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS. | |
553 | ||
554 | If HISTORY-REPLACE is non-nil, replace current history item, | |
49d758d2 AK |
555 | otherwise add the new one. |
556 | ||
557 | If NO-DISPLAY is non-nil, do not switch to the buffer." | |
dfeb0239 | 558 | (when entries |
23459fa5 AK |
559 | (let ((buf (if (and (eq major-mode |
560 | (guix-get-symbol "mode" buffer-type entry-type)) | |
561 | (equal guix-profile profile)) | |
dfeb0239 AK |
562 | (current-buffer) |
563 | (get-buffer-create | |
23459fa5 AK |
564 | (guix-buffer-name profile buffer-type |
565 | entry-type search-type))))) | |
dfeb0239 AK |
566 | (with-current-buffer buf |
567 | (guix-show-entries entries buffer-type entry-type) | |
23459fa5 | 568 | (guix-set-vars profile entries buffer-type entry-type |
dfeb0239 AK |
569 | search-type search-vals) |
570 | (funcall (if history-replace | |
571 | #'guix-history-replace | |
572 | #'guix-history-add) | |
573 | (guix-make-history-item))) | |
49d758d2 AK |
574 | (or no-display |
575 | (guix-switch-to-buffer buf)))) | |
62f261d8 AK |
576 | (guix-result-message profile entries entry-type |
577 | search-type search-vals)) | |
dfeb0239 AK |
578 | |
579 | (defun guix-show-entries (entries buffer-type entry-type) | |
580 | "Display ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." | |
581 | (let ((inhibit-read-only t)) | |
582 | (erase-buffer) | |
583 | (funcall (symbol-function (guix-get-symbol | |
584 | "mode" buffer-type entry-type))) | |
585 | (funcall (guix-get-symbol "insert-entries" buffer-type) | |
586 | entries entry-type) | |
587 | (goto-char (point-min)))) | |
588 | ||
23459fa5 | 589 | (defun guix-history-call (profile entries buffer-type entry-type |
dfeb0239 AK |
590 | search-type search-vals) |
591 | "Function called for moving by history." | |
592 | (guix-show-entries entries buffer-type entry-type) | |
23459fa5 | 593 | (guix-set-vars profile entries buffer-type entry-type |
dfeb0239 | 594 | search-type search-vals) |
62f261d8 AK |
595 | (guix-result-message profile entries entry-type |
596 | search-type search-vals)) | |
dfeb0239 AK |
597 | |
598 | (defun guix-make-history-item () | |
599 | "Make and return a history item for the current buffer." | |
600 | (list #'guix-history-call | |
23459fa5 | 601 | guix-profile guix-entries guix-buffer-type guix-entry-type |
dfeb0239 AK |
602 | guix-search-type guix-search-vals)) |
603 | ||
604 | (defun guix-get-params-for-receiving (buffer-type entry-type) | |
605 | "Return parameters that should be received for BUFFER-TYPE, ENTRY-TYPE." | |
606 | (let* ((required-var (guix-get-symbol "required-params" | |
607 | buffer-type entry-type)) | |
608 | (required (symbol-value required-var))) | |
609 | (unless (equal required 'all) | |
610 | (cl-union required | |
611 | (funcall (guix-get-symbol "get-displayed-params" | |
612 | buffer-type) | |
613 | entry-type))))) | |
614 | ||
615 | (defun guix-revert-buffer (_ignore-auto noconfirm) | |
616 | "Update information in the current buffer. | |
457f60fa AK |
617 | The function is suitable for `revert-buffer-function'. |
618 | See `revert-buffer' for the meaning of NOCONFIRM." | |
dfeb0239 AK |
619 | (when (or noconfirm |
620 | (symbol-value | |
621 | (guix-get-symbol "revert-no-confirm" | |
622 | guix-buffer-type guix-entry-type)) | |
623 | (y-or-n-p "Update current information? ")) | |
d2b299a9 AK |
624 | (let* ((search-type guix-search-type) |
625 | (search-vals guix-search-vals) | |
626 | (params (guix-get-params-for-receiving guix-buffer-type | |
627 | guix-entry-type)) | |
628 | (entries (guix-get-entries | |
629 | guix-profile guix-entry-type | |
630 | guix-search-type guix-search-vals params)) | |
631 | ;; If a REPL was restarted, package/output IDs are not actual | |
632 | ;; anymore, because 'object-address'-es died with the REPL, so if a | |
633 | ;; search by ID didn't give results, search again by name. | |
634 | (entries (if (and (null entries) | |
635 | (eq guix-search-type 'id) | |
636 | (or (eq guix-entry-type 'package) | |
637 | (eq guix-entry-type 'output))) | |
638 | (progn | |
639 | (setq search-type 'name | |
640 | search-vals (guix-entries-to-specifications | |
641 | guix-entries)) | |
642 | (guix-get-entries | |
643 | guix-profile guix-entry-type | |
644 | search-type search-vals params)) | |
645 | entries))) | |
23459fa5 | 646 | (guix-set-buffer guix-profile entries guix-buffer-type guix-entry-type |
d2b299a9 | 647 | search-type search-vals t t)))) |
dfeb0239 | 648 | |
37c4ffc2 AK |
649 | (cl-defun guix-redisplay-buffer (&key buffer profile entries buffer-type |
650 | entry-type search-type search-vals) | |
651 | "Redisplay a Guix BUFFER. | |
652 | Restore the point and window positions after redisplaying if possible. | |
653 | ||
457f60fa | 654 | This function will not update the information, use |
37c4ffc2 AK |
655 | \"\\[revert-buffer]\" if you want the full update. |
656 | ||
657 | If BUFFER is nil, use the current buffer. For the meaning of the | |
658 | rest arguments, see `guix-set-buffer'." | |
dfeb0239 | 659 | (interactive) |
37c4ffc2 AK |
660 | (or buffer (setq buffer (current-buffer))) |
661 | (with-current-buffer buffer | |
662 | (or (derived-mode-p 'guix-info-mode 'guix-list-mode) | |
663 | (error "%S is not a Guix buffer" buffer)) | |
664 | (let* ((point (point)) | |
665 | (was-at-button (button-at point)) | |
666 | ;; For simplicity, ignore an unlikely case when multiple | |
667 | ;; windows display the same BUFFER. | |
668 | (window (car (get-buffer-window-list buffer nil t))) | |
669 | (window-start (and window (window-start window)))) | |
670 | (guix-set-buffer (or profile guix-profile) | |
671 | (or entries guix-entries) | |
672 | (or buffer-type guix-buffer-type) | |
673 | (or entry-type guix-entry-type) | |
674 | (or search-type guix-search-type) | |
675 | (or search-vals guix-search-vals) | |
676 | t t) | |
677 | (goto-char point) | |
678 | (and was-at-button | |
679 | (not (button-at (point))) | |
680 | (forward-button 1)) | |
681 | (when window | |
682 | (set-window-point window (point)) | |
683 | (set-window-start window window-start))))) | |
457f60fa AK |
684 | |
685 | \f | |
d38bd08c AK |
686 | ;;; Generations |
687 | ||
688 | (defcustom guix-generation-packages-buffer-name-function | |
689 | #'guix-generation-packages-buffer-name-default | |
690 | "Function used to define name of a buffer with generation packages. | |
691 | This function is called with 2 arguments: PROFILE (string) and | |
692 | GENERATION (number)." | |
693 | :type '(choice (function-item guix-generation-packages-buffer-name-default) | |
694 | (function-item guix-generation-packages-buffer-name-long) | |
695 | (function :tag "Other function")) | |
696 | :group 'guix) | |
697 | ||
698 | (defcustom guix-generation-packages-update-buffer t | |
699 | "If non-nil, always update list of packages during comparing generations. | |
700 | If nil, generation packages are received only once. So when you | |
701 | compare generation 1 and generation 2, the packages for both | |
702 | generations will be received. Then if you compare generation 1 | |
703 | and generation 3, only the packages for generation 3 will be | |
704 | received. Thus if you use comparing of different generations a | |
705 | lot, you may set this variable to nil to improve the | |
706 | performance." | |
707 | :type 'boolean | |
708 | :group 'guix) | |
709 | ||
710 | (defvar guix-output-name-width 30 | |
711 | "Width of an output name \"column\". | |
712 | This variable is used in auxiliary buffers for comparing generations.") | |
713 | ||
714 | (defun guix-generation-file (profile generation) | |
715 | "Return the file name of a PROFILE's GENERATION." | |
716 | (format "%s-%s-link" profile generation)) | |
717 | ||
718 | (defun guix-manifest-file (profile &optional generation) | |
719 | "Return the file name of a PROFILE's manifest. | |
720 | If GENERATION number is specified, return manifest file name for | |
721 | this generation." | |
722 | (expand-file-name "manifest" | |
723 | (if generation | |
724 | (guix-generation-file profile generation) | |
725 | profile))) | |
726 | ||
727 | (defun guix-generation-packages (profile generation) | |
728 | "Return a list of sorted packages installed in PROFILE's GENERATION. | |
729 | Each element of the list is a list of the package specification and its path." | |
730 | (let ((names+paths (guix-eval-read | |
731 | (guix-make-guile-expression | |
732 | 'generation-package-specifications+paths | |
733 | profile generation)))) | |
734 | (sort names+paths | |
735 | (lambda (a b) | |
736 | (string< (car a) (car b)))))) | |
737 | ||
738 | (defun guix-generation-packages-buffer-name-default (profile generation) | |
739 | "Return name of a buffer for displaying GENERATION's package outputs. | |
740 | Use base name of PROFILE path." | |
741 | (let ((profile-name (file-name-base (directory-file-name profile)))) | |
742 | (format "*Guix %s: generation %s*" | |
743 | profile-name generation))) | |
744 | ||
745 | (defun guix-generation-packages-buffer-name-long (profile generation) | |
746 | "Return name of a buffer for displaying GENERATION's package outputs. | |
747 | Use the full PROFILE path." | |
748 | (format "*Guix generation %s (%s)*" | |
749 | generation profile)) | |
750 | ||
751 | (defun guix-generation-packages-buffer-name (profile generation) | |
752 | "Return name of a buffer for displaying GENERATION's package outputs." | |
753 | (let ((fun (if (functionp guix-generation-packages-buffer-name-function) | |
754 | guix-generation-packages-buffer-name-function | |
755 | #'guix-generation-packages-buffer-name-default))) | |
756 | (funcall fun profile generation))) | |
757 | ||
758 | (defun guix-generation-insert-package (name path) | |
759 | "Insert package output NAME and PATH at point." | |
760 | (insert name) | |
761 | (indent-to guix-output-name-width 2) | |
762 | (insert path "\n")) | |
763 | ||
764 | (defun guix-generation-insert-packages (buffer profile generation) | |
765 | "Insert package outputs installed in PROFILE's GENERATION in BUFFER." | |
766 | (with-current-buffer buffer | |
767 | (setq buffer-read-only nil | |
768 | indent-tabs-mode nil) | |
769 | (erase-buffer) | |
770 | (mapc (lambda (name+path) | |
771 | (guix-generation-insert-package | |
772 | (car name+path) (cadr name+path))) | |
773 | (guix-generation-packages profile generation)))) | |
774 | ||
775 | (defun guix-generation-packages-buffer (profile generation) | |
776 | "Return buffer with package outputs installed in PROFILE's GENERATION. | |
777 | Create the buffer if needed." | |
778 | (let ((buf-name (guix-generation-packages-buffer-name | |
779 | profile generation))) | |
780 | (or (and (null guix-generation-packages-update-buffer) | |
781 | (get-buffer buf-name)) | |
782 | (let ((buf (get-buffer-create buf-name))) | |
783 | (guix-generation-insert-packages buf profile generation) | |
784 | buf)))) | |
785 | ||
786 | (defun guix-profile-generation-manifest-file (generation) | |
787 | "Return the file name of a GENERATION's manifest. | |
788 | GENERATION is a generation number of `guix-profile' profile." | |
789 | (guix-manifest-file guix-profile generation)) | |
790 | ||
791 | (defun guix-profile-generation-packages-buffer (generation) | |
792 | "Insert GENERATION's package outputs in a buffer and return it. | |
793 | GENERATION is a generation number of `guix-profile' profile." | |
794 | (guix-generation-packages-buffer guix-profile generation)) | |
795 | ||
796 | \f | |
457f60fa AK |
797 | ;;; Actions on packages and generations |
798 | ||
b497a85b AK |
799 | (defface guix-operation-option-key |
800 | '((t :inherit font-lock-warning-face)) | |
801 | "Face used for the keys of operation options." | |
46e17df6 | 802 | :group 'guix-faces) |
b497a85b | 803 | |
457f60fa AK |
804 | (defcustom guix-operation-confirm t |
805 | "If nil, do not prompt to confirm an operation." | |
806 | :type 'boolean | |
807 | :group 'guix) | |
808 | ||
809 | (defcustom guix-use-substitutes t | |
810 | "If non-nil, use substitutes for the Guix packages." | |
811 | :type 'boolean | |
812 | :group 'guix) | |
813 | ||
814 | (defvar guix-dry-run nil | |
815 | "If non-nil, do not perform the real actions, just simulate.") | |
816 | ||
817 | (defvar guix-temp-buffer-name " *Guix temp*" | |
818 | "Name of a buffer used for displaying info before executing operation.") | |
819 | ||
b497a85b AK |
820 | (defvar guix-operation-option-true-string "yes" |
821 | "String displayed in the mode-line when operation option is t.") | |
822 | ||
823 | (defvar guix-operation-option-false-string "no " | |
824 | "String displayed in the mode-line when operation option is nil.") | |
825 | ||
826 | (defvar guix-operation-option-separator " | " | |
827 | "String used in the mode-line to separate operation options.") | |
828 | ||
829 | (defvar guix-operation-options | |
830 | '((?s "substitutes" guix-use-substitutes) | |
831 | (?d "dry-run" guix-dry-run)) | |
832 | "List of available operation options. | |
833 | Each element of the list has a form: | |
834 | ||
835 | (KEY NAME VARIABLE) | |
836 | ||
837 | KEY is a character that may be pressed during confirmation to | |
838 | toggle the option. | |
839 | NAME is a string displayed in the mode-line. | |
840 | VARIABLE is a name of an option variable.") | |
841 | ||
842 | (defun guix-operation-option-by-key (key) | |
843 | "Return operation option by KEY (character)." | |
844 | (assq key guix-operation-options)) | |
845 | ||
846 | (defun guix-operation-option-key (option) | |
847 | "Return key (character) of the operation OPTION." | |
848 | (car option)) | |
849 | ||
850 | (defun guix-operation-option-name (option) | |
851 | "Return name of the operation OPTION." | |
852 | (nth 1 option)) | |
853 | ||
854 | (defun guix-operation-option-variable (option) | |
855 | "Return name of the variable of the operation OPTION." | |
856 | (nth 2 option)) | |
857 | ||
858 | (defun guix-operation-option-value (option) | |
859 | "Return boolean value of the operation OPTION." | |
860 | (symbol-value (guix-operation-option-variable option))) | |
861 | ||
862 | (defun guix-operation-option-string-value (option) | |
863 | "Convert boolean value of the operation OPTION to string and return it." | |
864 | (if (guix-operation-option-value option) | |
865 | guix-operation-option-true-string | |
866 | guix-operation-option-false-string)) | |
867 | ||
23459fa5 AK |
868 | (defun guix-process-package-actions (profile actions |
869 | &optional operation-buffer) | |
870 | "Process package ACTIONS on PROFILE. | |
457f60fa AK |
871 | Each action is a list of the form: |
872 | ||
873 | (ACTION-TYPE PACKAGE-SPEC ...) | |
874 | ||
875 | ACTION-TYPE is one of the following symbols: `install', | |
876 | `upgrade', `remove'/`delete'. | |
877 | PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)." | |
878 | (let (install upgrade remove) | |
879 | (mapc (lambda (action) | |
880 | (let ((action-type (car action)) | |
881 | (specs (cdr action))) | |
882 | (cl-case action-type | |
883 | (install (setq install (append install specs))) | |
884 | (upgrade (setq upgrade (append upgrade specs))) | |
885 | ((remove delete) (setq remove (append remove specs)))))) | |
886 | actions) | |
887 | (when (guix-continue-package-operation-p | |
23459fa5 | 888 | profile |
457f60fa AK |
889 | :install install :upgrade upgrade :remove remove) |
890 | (guix-eval-in-repl | |
891 | (guix-make-guile-expression | |
23459fa5 | 892 | 'process-package-actions profile |
457f60fa AK |
893 | :install install :upgrade upgrade :remove remove |
894 | :use-substitutes? (or guix-use-substitutes 'f) | |
49d758d2 AK |
895 | :dry-run? (or guix-dry-run 'f)) |
896 | (and (not guix-dry-run) operation-buffer))))) | |
457f60fa | 897 | |
23459fa5 AK |
898 | (cl-defun guix-continue-package-operation-p (profile |
899 | &key install upgrade remove) | |
457f60fa AK |
900 | "Return non-nil if a package operation should be continued. |
901 | Ask a user if needed (see `guix-operation-confirm'). | |
902 | INSTALL, UPGRADE, REMOVE are 'package action specifications'. | |
903 | See `guix-process-package-actions' for details." | |
904 | (or (null guix-operation-confirm) | |
905 | (let* ((entries (guix-get-entries | |
23459fa5 | 906 | profile 'package 'id |
81b339fe AK |
907 | (append (mapcar #'car install) |
908 | (mapcar #'car upgrade) | |
909 | (mapcar #'car remove)) | |
457f60fa AK |
910 | '(id name version location))) |
911 | (install-strings (guix-get-package-strings install entries)) | |
912 | (upgrade-strings (guix-get-package-strings upgrade entries)) | |
913 | (remove-strings (guix-get-package-strings remove entries))) | |
914 | (if (or install-strings upgrade-strings remove-strings) | |
915 | (let ((buf (get-buffer-create guix-temp-buffer-name))) | |
916 | (with-current-buffer buf | |
917 | (setq-local cursor-type nil) | |
918 | (setq buffer-read-only nil) | |
919 | (erase-buffer) | |
23459fa5 | 920 | (insert "Profile: " profile "\n\n") |
457f60fa AK |
921 | (guix-insert-package-strings install-strings "install") |
922 | (guix-insert-package-strings upgrade-strings "upgrade") | |
923 | (guix-insert-package-strings remove-strings "remove") | |
924 | (let ((win (temp-buffer-window-show | |
925 | buf | |
926 | '((display-buffer-reuse-window | |
927 | display-buffer-at-bottom) | |
928 | (window-height . fit-window-to-buffer))))) | |
b497a85b | 929 | (prog1 (guix-operation-prompt) |
457f60fa AK |
930 | (quit-window nil win))))) |
931 | (message "Nothing to be done. If the REPL was restarted, information is not up-to-date.") | |
932 | nil)))) | |
933 | ||
934 | (defun guix-get-package-strings (specs entries) | |
935 | "Return short package descriptions for performing package actions. | |
936 | See `guix-process-package-actions' for the meaning of SPECS. | |
937 | ENTRIES is a list of package entries to get info about packages." | |
938 | (delq nil | |
939 | (mapcar | |
940 | (lambda (spec) | |
941 | (let* ((id (car spec)) | |
942 | (outputs (cdr spec)) | |
943 | (entry (guix-get-entry-by-id id entries))) | |
944 | (when entry | |
51dac383 | 945 | (let ((location (guix-assq-value entry 'location))) |
457f60fa AK |
946 | (concat (guix-get-full-name entry) |
947 | (when outputs | |
948 | (concat ":" | |
1ce96dd9 | 949 | (guix-concat-strings outputs ","))) |
457f60fa AK |
950 | (when location |
951 | (concat "\t(" location ")"))))))) | |
952 | specs))) | |
953 | ||
954 | (defun guix-insert-package-strings (strings action) | |
955 | "Insert information STRINGS at point for performing package ACTION." | |
956 | (when strings | |
2e269860 | 957 | (insert "Package(s) to " (propertize action 'face 'bold) ":\n") |
457f60fa AK |
958 | (mapc (lambda (str) |
959 | (insert " " str "\n")) | |
960 | strings) | |
961 | (insert "\n"))) | |
962 | ||
0b0fbf0c | 963 | (defun guix-operation-prompt (&optional prompt) |
7be25d4a | 964 | "Prompt a user for continuing the current operation. |
0b0fbf0c AK |
965 | Return non-nil, if the operation should be continued; nil otherwise. |
966 | Ask a user with PROMPT for continuing an operation." | |
b497a85b AK |
967 | (let* ((option-keys (mapcar #'guix-operation-option-key |
968 | guix-operation-options)) | |
969 | (keys (append '(?y ?n) option-keys)) | |
0b0fbf0c | 970 | (prompt (concat (propertize (or prompt "Continue operation?") |
b497a85b AK |
971 | 'face 'minibuffer-prompt) |
972 | " (" | |
973 | (mapconcat | |
974 | (lambda (key) | |
975 | (propertize (string key) | |
976 | 'face 'guix-operation-option-key)) | |
977 | keys | |
978 | ", ") | |
979 | ") "))) | |
7be25d4a AK |
980 | (let ((mode-line mode-line-format)) |
981 | (prog1 (guix-operation-prompt-1 prompt keys) | |
982 | (setq mode-line-format mode-line) | |
983 | ;; Clear the minibuffer after prompting. | |
984 | (message ""))))) | |
b497a85b AK |
985 | |
986 | (defun guix-operation-prompt-1 (prompt keys) | |
987 | "This function is internal for `guix-operation-prompt'." | |
988 | (guix-operation-set-mode-line) | |
989 | (let ((key (read-char-choice prompt (cons ?\C-g keys) t))) | |
990 | (cl-case key | |
991 | (?y t) | |
992 | ((?n ?\C-g) nil) | |
993 | (t (let* ((option (guix-operation-option-by-key key)) | |
994 | (var (guix-operation-option-variable option))) | |
995 | (set var (not (symbol-value var))) | |
996 | (guix-operation-prompt-1 prompt keys)))))) | |
997 | ||
998 | (defun guix-operation-set-mode-line () | |
999 | "Display operation options in the mode-line of the current buffer." | |
1000 | (setq mode-line-format | |
1001 | (concat (propertize " Options: " | |
1002 | 'face 'mode-line-buffer-id) | |
1003 | (mapconcat | |
1004 | (lambda (option) | |
1005 | (let ((key (guix-operation-option-key option)) | |
1006 | (name (guix-operation-option-name option)) | |
1007 | (val (guix-operation-option-string-value option))) | |
1008 | (concat name | |
1009 | " (" | |
1010 | (propertize (string key) | |
1011 | 'face 'guix-operation-option-key) | |
1012 | "): " val))) | |
1013 | guix-operation-options | |
1014 | guix-operation-option-separator))) | |
1015 | (force-mode-line-update)) | |
1016 | ||
23459fa5 AK |
1017 | (defun guix-delete-generations (profile generations |
1018 | &optional operation-buffer) | |
1019 | "Delete GENERATIONS from PROFILE. | |
cb6a5c71 AK |
1020 | Each element from GENERATIONS is a generation number." |
1021 | (when (or (not guix-operation-confirm) | |
23459fa5 AK |
1022 | (y-or-n-p |
1023 | (let ((count (length generations))) | |
1024 | (if (> count 1) | |
1025 | (format "Delete %d generations from profile '%s'? " | |
1026 | count profile) | |
1027 | (format "Delete generation %d from profile '%s'? " | |
1028 | (car generations) profile))))) | |
cb6a5c71 AK |
1029 | (guix-eval-in-repl |
1030 | (guix-make-guile-expression | |
23459fa5 | 1031 | 'delete-generations* profile generations) |
49d758d2 | 1032 | operation-buffer))) |
cb6a5c71 | 1033 | |
23459fa5 AK |
1034 | (defun guix-switch-to-generation (profile generation |
1035 | &optional operation-buffer) | |
1036 | "Switch PROFILE to GENERATION." | |
af874238 | 1037 | (when (or (not guix-operation-confirm) |
23459fa5 AK |
1038 | (y-or-n-p (format "Switch profile '%s' to generation %d? " |
1039 | profile generation))) | |
af874238 AK |
1040 | (guix-eval-in-repl |
1041 | (guix-make-guile-expression | |
cfd56de3 | 1042 | 'switch-to-generation* profile generation) |
49d758d2 | 1043 | operation-buffer))) |
af874238 | 1044 | |
0b0fbf0c AK |
1045 | (defun guix-package-source-path (package-id) |
1046 | "Return a store file path to a source of a package PACKAGE-ID." | |
1047 | (message "Calculating the source derivation ...") | |
1048 | (guix-eval-read | |
1049 | (guix-make-guile-expression | |
1050 | 'package-source-path package-id))) | |
1051 | ||
1052 | (defvar guix-after-source-download-hook nil | |
1053 | "Hook run after successful performing a 'source-download' operation.") | |
1054 | ||
1055 | (defun guix-package-source-build-derivation (package-id &optional prompt) | |
1056 | "Build source derivation of a package PACKAGE-ID. | |
1057 | Ask a user with PROMPT for continuing an operation." | |
1058 | (when (or (not guix-operation-confirm) | |
1059 | (guix-operation-prompt (or prompt | |
1060 | "Build the source derivation?"))) | |
1061 | (guix-eval-in-repl | |
1062 | (guix-make-guile-expression | |
1063 | 'package-source-build-derivation | |
1064 | package-id | |
1065 | :use-substitutes? (or guix-use-substitutes 'f) | |
1066 | :dry-run? (or guix-dry-run 'f)) | |
1067 | nil 'source-download))) | |
1068 | ||
5a727cdf AK |
1069 | ;;;###autoload |
1070 | (defun guix-apply-manifest (profile file &optional operation-buffer) | |
1071 | "Apply manifest from FILE to PROFILE. | |
1072 | This function has the same meaning as 'guix package --manifest' command. | |
1073 | See Info node `(guix) Invoking guix package' for details. | |
1074 | ||
1075 | Interactively, use the current profile and prompt for manifest | |
1076 | FILE. With a prefix argument, also prompt for PROFILE." | |
1077 | (interactive | |
1078 | (let* ((default-profile (or guix-profile guix-current-profile)) | |
1079 | (profile (if current-prefix-arg | |
1080 | (guix-profile-prompt) | |
1081 | default-profile)) | |
1082 | (file (read-file-name "File with manifest: ")) | |
1083 | (buffer (and guix-profile (current-buffer)))) | |
1084 | (list profile file buffer))) | |
1085 | (when (or (not guix-operation-confirm) | |
1086 | (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? " | |
1087 | file profile))) | |
1088 | (guix-eval-in-repl | |
1089 | (guix-make-guile-expression | |
957b7338 AK |
1090 | 'guix-command |
1091 | "package" | |
1092 | (concat "--profile=" (expand-file-name profile)) | |
1093 | (concat "--manifest=" (expand-file-name file))) | |
5a727cdf AK |
1094 | operation-buffer))) |
1095 | ||
2d7bf949 | 1096 | \f |
5e53b0c5 AK |
1097 | ;;; Executing guix commands |
1098 | ||
7008dfff AK |
1099 | (defcustom guix-run-in-shell-function #'guix-run-in-shell |
1100 | "Function used to run guix command. | |
1101 | The function is called with a single argument - a command line string." | |
1102 | :type '(choice (function-item guix-run-in-shell) | |
1103 | (function-item guix-run-in-eshell) | |
1104 | (function :tag "Other function")) | |
1105 | :group 'guix) | |
1106 | ||
1107 | (defcustom guix-shell-buffer-name "*shell*" | |
1108 | "Default name of a shell buffer used for running guix commands." | |
1109 | :type 'string | |
1110 | :group 'guix) | |
1111 | ||
1112 | (declare-function comint-send-input "comint" t) | |
1113 | ||
1114 | (defun guix-run-in-shell (string) | |
1115 | "Run command line STRING in `guix-shell-buffer-name' buffer." | |
1116 | (shell guix-shell-buffer-name) | |
1117 | (goto-char (point-max)) | |
1118 | (insert string) | |
1119 | (comint-send-input)) | |
1120 | ||
1121 | (declare-function eshell-send-input "esh-mode" t) | |
1122 | ||
1123 | (defun guix-run-in-eshell (string) | |
1124 | "Run command line STRING in eshell buffer." | |
1125 | (eshell) | |
1126 | (goto-char (point-max)) | |
1127 | (insert string) | |
1128 | (eshell-send-input)) | |
1129 | ||
1130 | (defun guix-run-command-in-shell (args) | |
1131 | "Execute 'guix ARGS ...' command in a shell buffer." | |
1132 | (funcall guix-run-in-shell-function | |
1133 | (guix-command-string args))) | |
1134 | ||
5e53b0c5 AK |
1135 | (defun guix-run-command-in-repl (args) |
1136 | "Execute 'guix ARGS ...' command in Guix REPL." | |
1137 | (guix-eval-in-repl | |
1138 | (apply #'guix-make-guile-expression | |
1139 | 'guix-command args))) | |
1140 | ||
1141 | (defun guix-command-output (args) | |
1142 | "Return string with 'guix ARGS ...' output." | |
ea369ee1 AK |
1143 | (cl-multiple-value-bind (output error) |
1144 | (guix-eval (apply #'guix-make-guile-expression | |
1145 | 'guix-command-output args)) | |
1146 | ;; Remove trailing new space from the error string. | |
1147 | (message (replace-regexp-in-string "\n\\'" "" (read error))) | |
1148 | (read output))) | |
5e53b0c5 AK |
1149 | |
1150 | (defun guix-help-string (&optional commands) | |
1151 | "Return string with 'guix COMMANDS ... --help' output." | |
1152 | (guix-eval-read | |
1153 | (apply #'guix-make-guile-expression | |
1154 | 'help-string commands))) | |
1155 | ||
1156 | \f | |
2d7bf949 AK |
1157 | ;;; Pull |
1158 | ||
1159 | (defcustom guix-update-after-pull t | |
1160 | "If non-nil, update Guix buffers after performing \\[guix-pull]." | |
1161 | :type 'boolean | |
1162 | :group 'guix) | |
1163 | ||
1164 | (defvar guix-after-pull-hook | |
1165 | '(guix-restart-repl-after-pull guix-update-buffers-maybe-after-pull) | |
1166 | "Hook run after successful performing `guix-pull' operation.") | |
1167 | ||
1168 | (defun guix-restart-repl-after-pull () | |
1169 | "Restart Guix REPL after `guix-pull' operation." | |
1170 | (guix-repl-exit) | |
1171 | (guix-start-process-maybe | |
1172 | "Restarting Guix REPL after pull operation ...")) | |
1173 | ||
1174 | (defun guix-update-buffers-maybe-after-pull () | |
1175 | "Update buffers depending on `guix-update-after-pull'." | |
1176 | (when guix-update-after-pull | |
1177 | (mapc #'guix-update-buffer | |
1178 | ;; No need to update "generation" buffers. | |
1179 | (guix-buffers '(guix-package-list-mode | |
1180 | guix-package-info-mode | |
1181 | guix-output-list-mode | |
1182 | guix-output-info-mode))) | |
1183 | (message "Guix buffers have been updated."))) | |
1184 | ||
1185 | ;;;###autoload | |
1186 | (defun guix-pull (&optional verbose) | |
1187 | "Run Guix pull operation. | |
1188 | If VERBOSE is non-nil (with prefix argument), produce verbose output." | |
1189 | (interactive) | |
1190 | (let ((args (and verbose '("--verbose")))) | |
1191 | (guix-eval-in-repl | |
1192 | (apply #'guix-make-guile-expression 'guix-pull args) | |
1193 | nil 'pull))) | |
1194 | ||
457f60fa AK |
1195 | (provide 'guix-base) |
1196 | ||
1197 | ;;; guix-base.el ends here |