Commit | Line | Data |
---|---|---|
dfeb0239 | 1 | ;;; guix-base.el --- Common definitions -*- lexical-binding: t -*- |
457f60fa AK |
2 | |
3 | ;; Copyright © 2014 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 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) | |
31 | (require 'guix-backend) | |
32 | (require 'guix-utils) | |
33 | ||
34 | \f | |
35 | ;;; Profiles | |
36 | ||
37 | (defvar guix-user-profile | |
38 | (expand-file-name "~/.guix-profile") | |
39 | "User profile.") | |
40 | ||
41 | (defvar guix-default-profile | |
42 | (concat (or (getenv "NIX_STATE_DIR") "/var/guix") | |
43 | "/profiles/per-user/" | |
44 | (getenv "USER") | |
45 | "/guix-profile") | |
46 | "Default Guix profile.") | |
47 | ||
48 | (defvar guix-current-profile guix-default-profile | |
49 | "Current profile.") | |
50 | ||
51 | (defun guix-set-current-profile (path) | |
52 | "Set `guix-current-profile' to PATH. | |
53 | Interactively, prompt for PATH. With prefix, use | |
54 | `guix-default-profile'." | |
55 | (interactive | |
56 | (list (if current-prefix-arg | |
57 | guix-default-profile | |
58 | (read-file-name "Set profile: " | |
59 | (file-name-directory guix-current-profile))))) | |
60 | (let ((path (directory-file-name (expand-file-name path)))) | |
61 | (setq guix-current-profile | |
62 | (if (string= path guix-user-profile) | |
63 | guix-default-profile | |
64 | path)) | |
65 | (message "Current profile has been set to '%s'." | |
66 | guix-current-profile))) | |
67 | ||
68 | \f | |
69 | ;;; Parameters of the entries | |
70 | ||
71 | (defvar guix-param-titles | |
72 | '((package | |
73 | (id . "ID") | |
74 | (name . "Name") | |
75 | (version . "Version") | |
76 | (license . "License") | |
77 | (synopsis . "Synopsis") | |
78 | (description . "Description") | |
79 | (home-url . "Home page") | |
80 | (outputs . "Outputs") | |
81 | (inputs . "Inputs") | |
82 | (native-inputs . "Native inputs") | |
83 | (propagated-inputs . "Propagated inputs") | |
84 | (location . "Location") | |
85 | (installed . "Installed")) | |
86 | (installed | |
87 | (path . "Installed path") | |
88 | (dependencies . "Dependencies") | |
89 | (output . "Output")) | |
a54a237b AK |
90 | (output |
91 | (id . "ID") | |
92 | (name . "Name") | |
93 | (version . "Version") | |
94 | (license . "License") | |
95 | (synopsis . "Synopsis") | |
96 | (description . "Description") | |
97 | (home-url . "Home page") | |
98 | (output . "Output") | |
99 | (inputs . "Inputs") | |
100 | (native-inputs . "Native inputs") | |
101 | (propagated-inputs . "Propagated inputs") | |
102 | (location . "Location") | |
103 | (installed . "Installed") | |
104 | (path . "Installed path") | |
105 | (dependencies . "Dependencies")) | |
457f60fa AK |
106 | (generation |
107 | (id . "ID") | |
108 | (number . "Number") | |
109 | (prev-number . "Previous number") | |
c2379b3c | 110 | (current . "Current") |
457f60fa AK |
111 | (path . "Path") |
112 | (time . "Time"))) | |
113 | "List for defining titles of entry parameters. | |
114 | Titles are used for displaying information about entries. | |
115 | Each element of the list has a form: | |
116 | ||
117 | (ENTRY-TYPE . ((PARAM . TITLE) ...))") | |
118 | ||
119 | (defun guix-get-param-title (entry-type param) | |
120 | "Return title of an ENTRY-TYPE entry parameter PARAM." | |
121 | (or (guix-get-key-val guix-param-titles | |
122 | entry-type param) | |
123 | (prog1 (symbol-name param) | |
124 | (message "Couldn't find title for '%S %S'." | |
125 | entry-type param)))) | |
126 | ||
127 | (defun guix-get-name-spec (name version &optional output) | |
128 | "Return Guix package specification by its NAME, VERSION and OUTPUT." | |
129 | (concat name "-" version | |
130 | (when output (concat ":" output)))) | |
131 | ||
132 | (defun guix-get-full-name (entry &optional output) | |
133 | "Return name specification of the package ENTRY and OUTPUT." | |
134 | (guix-get-name-spec (guix-get-key-val entry 'name) | |
135 | (guix-get-key-val entry 'version) | |
136 | output)) | |
137 | ||
138 | (defun guix-get-installed-outputs (entry) | |
139 | "Return list of installed outputs for the package ENTRY." | |
140 | (mapcar (lambda (installed-entry) | |
141 | (guix-get-key-val installed-entry 'output)) | |
142 | (guix-get-key-val entry 'installed))) | |
143 | ||
144 | (defun guix-get-entry-by-id (id entries) | |
145 | "Return entry from ENTRIES by entry ID." | |
146 | (cl-find-if (lambda (entry) | |
147 | (equal id (guix-get-key-val entry 'id))) | |
148 | entries)) | |
149 | ||
a54a237b AK |
150 | (defun guix-get-package-id-and-output-by-output-id (oid) |
151 | "Return list (PACKAGE-ID OUTPUT) by output id OID." | |
152 | (cl-multiple-value-bind (pid-str output) | |
153 | (split-string oid ":") | |
154 | (let ((pid (string-to-number pid-str))) | |
155 | (list (if (= 0 pid) pid-str pid) | |
156 | output)))) | |
157 | ||
457f60fa AK |
158 | \f |
159 | ;;; Location of the packages | |
160 | ||
161 | (defvar guix-directory nil | |
162 | "Default Guix directory. | |
163 | If it is not set by a user, it is set after starting Guile REPL. | |
164 | This directory is used to define location of the packages.") | |
165 | ||
166 | (defun guix-set-directory () | |
167 | "Set `guix-directory' if needed." | |
168 | (or guix-directory | |
169 | (setq guix-directory | |
170 | (guix-eval-read "%guix-dir")))) | |
171 | ||
172 | (add-hook 'guix-after-start-repl-hook 'guix-set-directory) | |
173 | ||
174 | (defun guix-find-location (location) | |
175 | "Go to LOCATION of a package. | |
176 | LOCATION is a string of the form: | |
177 | ||
178 | \"PATH:LINE:COLUMN\" | |
179 | ||
180 | If PATH is relative, it is considered to be relative to | |
181 | `guix-directory'." | |
182 | (cl-multiple-value-bind (path line col) | |
183 | (split-string location ":") | |
184 | (let ((file (expand-file-name path guix-directory)) | |
185 | (line (string-to-number line)) | |
186 | (col (string-to-number col))) | |
187 | (find-file file) | |
188 | (goto-char (point-min)) | |
189 | (forward-line (- line 1)) | |
190 | (move-to-column col) | |
191 | (recenter 1)))) | |
192 | ||
193 | \f | |
49d758d2 AK |
194 | ;;; Buffers and auto updating. |
195 | ||
196 | (defcustom guix-update-after-operation 'current | |
197 | "Define what information to update after executing an operation. | |
198 | ||
199 | After successful executing an operation in the Guix REPL (for | |
200 | example after installing a package), information in Guix buffers | |
201 | will or will not be automatically updated depending on a value of | |
202 | this variable. | |
203 | ||
204 | If nil, update nothing (do not revert any buffer). | |
205 | If `current', update the buffer from which an operation was performed. | |
206 | If `all', update all Guix buffers (not recommended)." | |
207 | :type '(choice (const :tag "Do nothing" nil) | |
208 | (const :tag "Update operation buffer" current) | |
209 | (const :tag "Update all Guix buffers" all)) | |
210 | :group 'guix) | |
211 | ||
212 | (defun guix-switch-to-buffer (buffer) | |
213 | "Switch to a 'list' or 'info' BUFFER." | |
214 | (pop-to-buffer buffer | |
215 | '((display-buffer-reuse-window | |
216 | display-buffer-same-window)))) | |
217 | ||
218 | (defun guix-list-or-info-buffer-p (&optional buffer) | |
219 | "Return non-nil if BUFFER is a Guix 'list' or 'info' buffer. | |
220 | If BUFFER is nil, check current buffer." | |
221 | (with-current-buffer (or buffer (current-buffer)) | |
222 | (derived-mode-p 'guix-list-mode 'guix-info-mode))) | |
223 | ||
224 | (defun guix-buffers () | |
225 | "Return list of all Guix 'list' and 'info' buffers." | |
226 | (cl-remove-if-not #'guix-list-or-info-buffer-p | |
227 | (buffer-list))) | |
228 | ||
229 | (defun guix-update-buffers-maybe () | |
230 | "Update buffers after Guix operation if needed. | |
231 | See `guix-update-after-operation' for details." | |
232 | (let ((to-update (and guix-operation-buffer | |
233 | (cl-case guix-update-after-operation | |
234 | (current (list guix-operation-buffer)) | |
235 | (all (guix-buffers)))))) | |
236 | (setq guix-operation-buffer nil) | |
237 | (mapc (lambda (buf) | |
238 | (and (buffer-live-p buf) | |
239 | (guix-list-or-info-buffer-p buf) | |
240 | (with-current-buffer buf | |
241 | (guix-revert-buffer nil t)))) | |
242 | to-update))) | |
243 | ||
244 | (add-hook 'guix-after-repl-operation-hook 'guix-update-buffers-maybe) | |
245 | ||
246 | \f | |
457f60fa AK |
247 | ;;; Common definitions for buffer types |
248 | ||
249 | (defvar-local guix-entries nil | |
250 | "List of the currently displayed entries. | |
251 | Each element of the list is alist with entry info of the | |
252 | following form: | |
253 | ||
254 | ((PARAM . VAL) ...) | |
255 | ||
256 | PARAM is a name of the entry parameter. | |
257 | VAL is a value of this parameter.") | |
258 | (put 'guix-entries 'permanent-local t) | |
259 | ||
dfeb0239 AK |
260 | (defvar-local guix-buffer-type nil |
261 | "Type of the current buffer.") | |
262 | (put 'guix-buffer-type 'permanent-local t) | |
263 | ||
264 | (defvar-local guix-entry-type nil | |
265 | "Type of the current entry.") | |
266 | (put 'guix-entry-type 'permanent-local t) | |
267 | ||
457f60fa AK |
268 | (defvar-local guix-search-type nil |
269 | "Type of the current search.") | |
270 | (put 'guix-search-type 'permanent-local t) | |
271 | ||
272 | (defvar-local guix-search-vals nil | |
273 | "Values of the current search.") | |
274 | (put 'guix-search-vals 'permanent-local t) | |
275 | ||
dfeb0239 AK |
276 | (defsubst guix-set-vars (entries buffer-type entry-type |
277 | search-type search-vals) | |
278 | (setq guix-entries entries | |
279 | guix-buffer-type buffer-type | |
280 | guix-entry-type entry-type | |
457f60fa AK |
281 | guix-search-type search-type |
282 | guix-search-vals search-vals)) | |
283 | ||
dfeb0239 AK |
284 | (defun guix-get-symbol (postfix buffer-type &optional entry-type) |
285 | (intern (concat "guix-" | |
286 | (when entry-type | |
287 | (concat (symbol-name entry-type) "-")) | |
288 | (symbol-name buffer-type) "-" postfix))) | |
457f60fa | 289 | |
dfeb0239 AK |
290 | (defmacro guix-define-buffer-type (buf-type entry-type &rest args) |
291 | "Define common for BUF-TYPE buffers for displaying ENTRY-TYPE entries. | |
457f60fa AK |
292 | |
293 | In the text below TYPE means ENTRY-TYPE-BUF-TYPE. | |
294 | ||
dfeb0239 AK |
295 | This macro defines `guix-TYPE-mode', a custom group and several |
296 | user variables. | |
457f60fa AK |
297 | |
298 | The following stuff should be defined outside this macro: | |
299 | ||
300 | - `guix-BUF-TYPE-mode' - parent mode for the defined mode. | |
301 | ||
457f60fa AK |
302 | - `guix-TYPE-mode-initialize' (optional) - function for |
303 | additional mode settings; it is called without arguments. | |
304 | ||
305 | Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The | |
306 | following keywords are available: | |
307 | ||
a54a237b AK |
308 | - `:buffer-name' - default value for the defined |
309 | `guix-TYPE-buffer-name' variable. | |
310 | ||
457f60fa AK |
311 | - `:required' - default value for the defined |
312 | `guix-TYPE-required-params' variable. | |
313 | ||
314 | - `:history-size' - default value for the defined | |
315 | `guix-TYPE-history-size' variable. | |
316 | ||
317 | - `:revert' - default value for the defined | |
318 | `guix-TYPE-revert-no-confirm' variable." | |
319 | (let* ((entry-type-str (symbol-name entry-type)) | |
320 | (buf-type-str (symbol-name buf-type)) | |
321 | (Entry-type-str (capitalize entry-type-str)) | |
322 | (Buf-type-str (capitalize buf-type-str)) | |
323 | (entry-str (concat entry-type-str " entries")) | |
324 | (buf-str (concat buf-type-str " buffer")) | |
325 | (prefix (concat "guix-" entry-type-str "-" buf-type-str)) | |
326 | (group (intern prefix)) | |
327 | (mode-map-str (concat prefix "-mode-map")) | |
328 | (mode-map (intern mode-map-str)) | |
329 | (parent-mode (intern (concat "guix-" buf-type-str "-mode"))) | |
330 | (mode (intern (concat prefix "-mode"))) | |
331 | (mode-init-fun (intern (concat prefix "-mode-initialize"))) | |
332 | (buf-name-var (intern (concat prefix "-buffer-name"))) | |
333 | (revert-var (intern (concat prefix "-revert-no-confirm"))) | |
457f60fa | 334 | (history-var (intern (concat prefix "-history-size"))) |
457f60fa | 335 | (params-var (intern (concat prefix "-required-params"))) |
a54a237b | 336 | (buf-name-val (format "*Guix %s %s*" Entry-type-str Buf-type-str)) |
457f60fa AK |
337 | (revert-val nil) |
338 | (history-val 20) | |
339 | (params-val '(id))) | |
340 | ||
341 | ;; Process the keyword args. | |
342 | (while (keywordp (car args)) | |
343 | (pcase (pop args) | |
344 | (`:required (setq params-val (pop args))) | |
345 | (`:history-size (setq history-val (pop args))) | |
346 | (`:revert (setq revert-val (pop args))) | |
a54a237b | 347 | (`:buffer-name (setq buf-name-val (pop args))) |
457f60fa AK |
348 | (_ (pop args)))) |
349 | ||
350 | `(progn | |
351 | (defgroup ,group nil | |
352 | ,(concat Buf-type-str " buffer with " entry-str ".") | |
353 | :prefix ,(concat prefix "-") | |
354 | :group ',(intern (concat "guix-" buf-type-str))) | |
355 | ||
a54a237b | 356 | (defcustom ,buf-name-var ,buf-name-val |
457f60fa AK |
357 | ,(concat "Default name of the " buf-str " for displaying " entry-str ".") |
358 | :type 'string | |
359 | :group ',group) | |
360 | ||
361 | (defcustom ,history-var ,history-val | |
362 | ,(concat "Maximum number of items saved in the history of the " buf-str ".\n" | |
363 | "If 0, the history is disabled.") | |
364 | :type 'integer | |
365 | :group ',group) | |
366 | ||
367 | (defcustom ,revert-var ,revert-val | |
368 | ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".") | |
369 | :type 'boolean | |
370 | :group ',group) | |
371 | ||
372 | (defvar ,params-var ',params-val | |
373 | ,(concat "List of required " entry-type-str " parameters.\n\n" | |
374 | "Displayed parameters and parameters from this list are received\n" | |
375 | "for each " entry-type-str ".\n\n" | |
376 | "May be a special value `all', in which case all supported\n" | |
377 | "parameters are received (this may be very slow for a big number\n" | |
378 | "of entries).\n\n" | |
379 | "Do not remove `id' from this list as it is required for\n" | |
380 | "identifying an entry.")) | |
381 | ||
382 | (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str) | |
383 | ,(concat "Major mode for displaying information about " entry-str ".\n\n" | |
384 | "\\{" mode-map-str "}") | |
dfeb0239 | 385 | (setq-local revert-buffer-function 'guix-revert-buffer) |
457f60fa AK |
386 | (setq-local guix-history-size ,history-var) |
387 | (and (fboundp ',mode-init-fun) (,mode-init-fun))) | |
388 | ||
389 | (let ((map ,mode-map)) | |
390 | (define-key map (kbd "l") 'guix-history-back) | |
391 | (define-key map (kbd "r") 'guix-history-forward) | |
392 | (define-key map (kbd "g") 'revert-buffer) | |
dfeb0239 AK |
393 | (define-key map (kbd "R") 'guix-redisplay-buffer) |
394 | (define-key map (kbd "C-c C-z") 'guix-switch-to-repl))))) | |
395 | ||
396 | (put 'guix-define-buffer-type 'lisp-indent-function 'defun) | |
397 | ||
398 | \f | |
3472bb20 AK |
399 | ;;; Getting and displaying info about packages and generations |
400 | ||
401 | (defcustom guix-package-list-type 'output | |
402 | "Define how to display packages in a list buffer. | |
403 | May be a symbol `package' or `output' (if `output', display each | |
404 | output on a separate line; if `package', display each package on | |
405 | a separate line)." | |
406 | :type '(choice (const :tag "List of packages" package) | |
407 | (const :tag "List of outputs" output)) | |
408 | :group 'guix) | |
409 | ||
410 | (defcustom guix-package-info-type 'package | |
411 | "Define how to display packages in an info buffer. | |
412 | May be a symbol `package' or `output' (if `output', display each | |
413 | output separately; if `package', display outputs inside a package | |
414 | information)." | |
415 | :type '(choice (const :tag "Display packages" package) | |
416 | (const :tag "Display outputs" output)) | |
417 | :group 'guix) | |
dfeb0239 AK |
418 | |
419 | (defun guix-get-entries (entry-type search-type search-vals | |
420 | &optional params) | |
421 | "Search for entries of ENTRY-TYPE. | |
422 | ||
423 | Call an appropriate scheme function and return a list of the | |
424 | form of `guix-entries'. | |
425 | ||
81b339fe AK |
426 | ENTRY-TYPE should be one of the following symbols: `package', |
427 | `output' or `generation'. | |
dfeb0239 AK |
428 | |
429 | SEARCH-TYPE may be one of the following symbols: | |
430 | ||
431 | - If ENTRY-TYPE is `package' or `output': `id', `name', `regexp', | |
432 | `all-available', `newest-available', `installed', `obsolete', | |
433 | `generation'. | |
434 | ||
435 | - If ENTRY-TYPE is `generation': `id', `last', `all'. | |
436 | ||
437 | PARAMS is a list of parameters for receiving. If nil, get | |
438 | information with all available parameters." | |
439 | (guix-eval-read (guix-make-guile-expression | |
81b339fe | 440 | 'entries |
dfeb0239 AK |
441 | guix-current-profile params |
442 | entry-type search-type search-vals))) | |
443 | ||
444 | (defun guix-get-show-entries (buffer-type entry-type search-type | |
445 | &rest search-vals) | |
446 | "Search for ENTRY-TYPE entries and show results in BUFFER-TYPE buffer. | |
447 | See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS." | |
448 | (let ((entries (guix-get-entries entry-type search-type search-vals | |
449 | (guix-get-params-for-receiving | |
450 | buffer-type entry-type)))) | |
451 | (guix-set-buffer entries buffer-type entry-type | |
452 | search-type search-vals))) | |
453 | ||
454 | (defun guix-set-buffer (entries buffer-type entry-type search-type | |
49d758d2 | 455 | search-vals &optional history-replace no-display) |
dfeb0239 AK |
456 | "Set up BUFFER-TYPE buffer for displaying ENTRY-TYPE ENTRIES. |
457 | ||
49d758d2 | 458 | Insert ENTRIES in buffer, set variables and make history item. |
dfeb0239 AK |
459 | ENTRIES should have a form of `guix-entries'. |
460 | ||
461 | See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS. | |
462 | ||
463 | If HISTORY-REPLACE is non-nil, replace current history item, | |
49d758d2 AK |
464 | otherwise add the new one. |
465 | ||
466 | If NO-DISPLAY is non-nil, do not switch to the buffer." | |
dfeb0239 AK |
467 | (when entries |
468 | (let ((buf (if (eq major-mode (guix-get-symbol | |
469 | "mode" buffer-type entry-type)) | |
470 | (current-buffer) | |
471 | (get-buffer-create | |
472 | (symbol-value | |
473 | (guix-get-symbol "buffer-name" | |
474 | buffer-type entry-type)))))) | |
475 | (with-current-buffer buf | |
476 | (guix-show-entries entries buffer-type entry-type) | |
477 | (guix-set-vars entries buffer-type entry-type | |
478 | search-type search-vals) | |
479 | (funcall (if history-replace | |
480 | #'guix-history-replace | |
481 | #'guix-history-add) | |
482 | (guix-make-history-item))) | |
49d758d2 AK |
483 | (or no-display |
484 | (guix-switch-to-buffer buf)))) | |
dfeb0239 AK |
485 | (guix-result-message entries entry-type search-type search-vals)) |
486 | ||
487 | (defun guix-show-entries (entries buffer-type entry-type) | |
488 | "Display ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." | |
489 | (let ((inhibit-read-only t)) | |
490 | (erase-buffer) | |
491 | (funcall (symbol-function (guix-get-symbol | |
492 | "mode" buffer-type entry-type))) | |
493 | (funcall (guix-get-symbol "insert-entries" buffer-type) | |
494 | entries entry-type) | |
495 | (goto-char (point-min)))) | |
496 | ||
497 | (defun guix-history-call (entries buffer-type entry-type | |
498 | search-type search-vals) | |
499 | "Function called for moving by history." | |
500 | (guix-show-entries entries buffer-type entry-type) | |
501 | (guix-set-vars entries buffer-type entry-type | |
502 | search-type search-vals) | |
503 | (guix-result-message entries entry-type search-type search-vals)) | |
504 | ||
505 | (defun guix-make-history-item () | |
506 | "Make and return a history item for the current buffer." | |
507 | (list #'guix-history-call | |
508 | guix-entries guix-buffer-type guix-entry-type | |
509 | guix-search-type guix-search-vals)) | |
510 | ||
511 | (defun guix-get-params-for-receiving (buffer-type entry-type) | |
512 | "Return parameters that should be received for BUFFER-TYPE, ENTRY-TYPE." | |
513 | (let* ((required-var (guix-get-symbol "required-params" | |
514 | buffer-type entry-type)) | |
515 | (required (symbol-value required-var))) | |
516 | (unless (equal required 'all) | |
517 | (cl-union required | |
518 | (funcall (guix-get-symbol "get-displayed-params" | |
519 | buffer-type) | |
520 | entry-type))))) | |
521 | ||
522 | (defun guix-revert-buffer (_ignore-auto noconfirm) | |
523 | "Update information in the current buffer. | |
457f60fa AK |
524 | The function is suitable for `revert-buffer-function'. |
525 | See `revert-buffer' for the meaning of NOCONFIRM." | |
dfeb0239 AK |
526 | (when (or noconfirm |
527 | (symbol-value | |
528 | (guix-get-symbol "revert-no-confirm" | |
529 | guix-buffer-type guix-entry-type)) | |
530 | (y-or-n-p "Update current information? ")) | |
531 | (let ((entries (guix-get-entries | |
532 | guix-entry-type guix-search-type guix-search-vals | |
533 | (guix-get-params-for-receiving guix-buffer-type | |
534 | guix-entry-type)))) | |
535 | (guix-set-buffer entries guix-buffer-type guix-entry-type | |
49d758d2 | 536 | guix-search-type guix-search-vals t t)))) |
dfeb0239 AK |
537 | |
538 | (defun guix-redisplay-buffer () | |
539 | "Redisplay current information. | |
457f60fa AK |
540 | This function will not update the information, use |
541 | \"\\[revert-buffer]\" if you want the full update." | |
dfeb0239 AK |
542 | (interactive) |
543 | (guix-show-entries guix-entries guix-buffer-type guix-entry-type) | |
544 | (guix-result-message guix-entries guix-entry-type | |
545 | guix-search-type guix-search-vals)) | |
457f60fa AK |
546 | |
547 | \f | |
548 | ;;; Messages | |
549 | ||
550 | (defvar guix-messages | |
551 | '((package | |
552 | (id | |
553 | (0 "Packages not found.") | |
554 | (1 "") | |
555 | (many "%d packages." count)) | |
556 | (name | |
557 | (0 "The package '%s' not found." val) | |
558 | (1 "A single package with name '%s'." val) | |
559 | (many "%d packages with '%s' name." count val)) | |
560 | (regexp | |
561 | (0 "No packages matching '%s'." val) | |
562 | (1 "A single package matching '%s'." val) | |
563 | (many "%d packages matching '%s'." count val)) | |
564 | (all-available | |
565 | (0 "No packages are available for some reason.") | |
566 | (1 "A single available package (that's strange).") | |
567 | (many "%d available packages." count)) | |
568 | (newest-available | |
569 | (0 "No packages are available for some reason.") | |
570 | (1 "A single newest available package (that's strange).") | |
571 | (many "%d newest available packages." count)) | |
572 | (installed | |
573 | (0 "No installed packages.") | |
a54a237b AK |
574 | (1 "A single package installed.") |
575 | (many "%d packages installed." count)) | |
457f60fa AK |
576 | (obsolete |
577 | (0 "No obsolete packages.") | |
578 | (1 "A single obsolete package.") | |
579 | (many "%d obsolete packages." count)) | |
580 | (generation | |
581 | (0 "No packages installed in generation %d." val) | |
582 | (1 "A single package installed in generation %d." val) | |
583 | (many "%d packages installed in generation %d." count val))) | |
a54a237b AK |
584 | (output |
585 | (id | |
586 | (0 "Package outputs not found.") | |
587 | (1 "") | |
588 | (many "%d package outputs." count)) | |
589 | (name | |
590 | (0 "The package output '%s' not found." val) | |
591 | (1 "A single package output with name '%s'." val) | |
592 | (many "%d package outputs with '%s' name." count val)) | |
593 | (regexp | |
594 | (0 "No package outputs matching '%s'." val) | |
595 | (1 "A single package output matching '%s'." val) | |
596 | (many "%d package outputs matching '%s'." count val)) | |
597 | (all-available | |
598 | (0 "No package outputs are available for some reason.") | |
599 | (1 "A single available package output (that's strange).") | |
600 | (many "%d available package outputs." count)) | |
601 | (newest-available | |
602 | (0 "No package outputs are available for some reason.") | |
603 | (1 "A single newest available package output (that's strange).") | |
604 | (many "%d newest available package outputs." count)) | |
605 | (installed | |
606 | (0 "No installed package outputs.") | |
607 | (1 "A single package output installed.") | |
608 | (many "%d package outputs installed." count)) | |
609 | (obsolete | |
610 | (0 "No obsolete package outputs.") | |
611 | (1 "A single obsolete package output.") | |
612 | (many "%d obsolete package outputs." count)) | |
613 | (generation | |
614 | (0 "No package outputs installed in generation %d." val) | |
615 | (1 "A single package output installed in generation %d." val) | |
616 | (many "%d package outputs installed in generation %d." count val))) | |
457f60fa AK |
617 | (generation |
618 | (id | |
619 | (0 "Generations not found.") | |
620 | (1 "") | |
621 | (many "%d generations." count)) | |
622 | (last | |
623 | (0 "No available generations.") | |
624 | (1 "The last generation.") | |
625 | (many "%d last generations." count)) | |
626 | (all | |
627 | (0 "No available generations.") | |
628 | (1 "A single available generation.") | |
629 | (many "%d available generations." count))))) | |
630 | ||
631 | (defun guix-result-message (entries entry-type search-type search-vals) | |
632 | "Display an appropriate message after displaying ENTRIES." | |
633 | (let* ((val (car search-vals)) | |
634 | (count (length entries)) | |
635 | (count-key (if (> count 1) 'many count)) | |
636 | (msg-spec (guix-get-key-val guix-messages | |
637 | entry-type search-type count-key)) | |
638 | (format (car msg-spec)) | |
639 | (args (cdr msg-spec))) | |
640 | (mapc (lambda (subst) | |
641 | (setq args (cl-substitute (car subst) (cdr subst) args))) | |
642 | (list (cons count 'count) | |
643 | (cons val 'val))) | |
644 | (apply #'message format args))) | |
645 | ||
646 | \f | |
457f60fa AK |
647 | ;;; Actions on packages and generations |
648 | ||
b497a85b AK |
649 | (defface guix-operation-option-key |
650 | '((t :inherit font-lock-warning-face)) | |
651 | "Face used for the keys of operation options." | |
652 | :group 'guix) | |
653 | ||
457f60fa AK |
654 | (defcustom guix-operation-confirm t |
655 | "If nil, do not prompt to confirm an operation." | |
656 | :type 'boolean | |
657 | :group 'guix) | |
658 | ||
659 | (defcustom guix-use-substitutes t | |
660 | "If non-nil, use substitutes for the Guix packages." | |
661 | :type 'boolean | |
662 | :group 'guix) | |
663 | ||
664 | (defvar guix-dry-run nil | |
665 | "If non-nil, do not perform the real actions, just simulate.") | |
666 | ||
667 | (defvar guix-temp-buffer-name " *Guix temp*" | |
668 | "Name of a buffer used for displaying info before executing operation.") | |
669 | ||
b497a85b AK |
670 | (defvar guix-operation-option-true-string "yes" |
671 | "String displayed in the mode-line when operation option is t.") | |
672 | ||
673 | (defvar guix-operation-option-false-string "no " | |
674 | "String displayed in the mode-line when operation option is nil.") | |
675 | ||
676 | (defvar guix-operation-option-separator " | " | |
677 | "String used in the mode-line to separate operation options.") | |
678 | ||
679 | (defvar guix-operation-options | |
680 | '((?s "substitutes" guix-use-substitutes) | |
681 | (?d "dry-run" guix-dry-run)) | |
682 | "List of available operation options. | |
683 | Each element of the list has a form: | |
684 | ||
685 | (KEY NAME VARIABLE) | |
686 | ||
687 | KEY is a character that may be pressed during confirmation to | |
688 | toggle the option. | |
689 | NAME is a string displayed in the mode-line. | |
690 | VARIABLE is a name of an option variable.") | |
691 | ||
692 | (defun guix-operation-option-by-key (key) | |
693 | "Return operation option by KEY (character)." | |
694 | (assq key guix-operation-options)) | |
695 | ||
696 | (defun guix-operation-option-key (option) | |
697 | "Return key (character) of the operation OPTION." | |
698 | (car option)) | |
699 | ||
700 | (defun guix-operation-option-name (option) | |
701 | "Return name of the operation OPTION." | |
702 | (nth 1 option)) | |
703 | ||
704 | (defun guix-operation-option-variable (option) | |
705 | "Return name of the variable of the operation OPTION." | |
706 | (nth 2 option)) | |
707 | ||
708 | (defun guix-operation-option-value (option) | |
709 | "Return boolean value of the operation OPTION." | |
710 | (symbol-value (guix-operation-option-variable option))) | |
711 | ||
712 | (defun guix-operation-option-string-value (option) | |
713 | "Convert boolean value of the operation OPTION to string and return it." | |
714 | (if (guix-operation-option-value option) | |
715 | guix-operation-option-true-string | |
716 | guix-operation-option-false-string)) | |
717 | ||
49d758d2 | 718 | (defun guix-process-package-actions (actions &optional operation-buffer) |
457f60fa AK |
719 | "Process package ACTIONS. |
720 | Each action is a list of the form: | |
721 | ||
722 | (ACTION-TYPE PACKAGE-SPEC ...) | |
723 | ||
724 | ACTION-TYPE is one of the following symbols: `install', | |
725 | `upgrade', `remove'/`delete'. | |
726 | PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)." | |
727 | (let (install upgrade remove) | |
728 | (mapc (lambda (action) | |
729 | (let ((action-type (car action)) | |
730 | (specs (cdr action))) | |
731 | (cl-case action-type | |
732 | (install (setq install (append install specs))) | |
733 | (upgrade (setq upgrade (append upgrade specs))) | |
734 | ((remove delete) (setq remove (append remove specs)))))) | |
735 | actions) | |
736 | (when (guix-continue-package-operation-p | |
737 | :install install :upgrade upgrade :remove remove) | |
738 | (guix-eval-in-repl | |
739 | (guix-make-guile-expression | |
740 | 'process-package-actions guix-current-profile | |
741 | :install install :upgrade upgrade :remove remove | |
742 | :use-substitutes? (or guix-use-substitutes 'f) | |
49d758d2 AK |
743 | :dry-run? (or guix-dry-run 'f)) |
744 | (and (not guix-dry-run) operation-buffer))))) | |
457f60fa AK |
745 | |
746 | (cl-defun guix-continue-package-operation-p (&key install upgrade remove) | |
747 | "Return non-nil if a package operation should be continued. | |
748 | Ask a user if needed (see `guix-operation-confirm'). | |
749 | INSTALL, UPGRADE, REMOVE are 'package action specifications'. | |
750 | See `guix-process-package-actions' for details." | |
751 | (or (null guix-operation-confirm) | |
752 | (let* ((entries (guix-get-entries | |
753 | 'package 'id | |
81b339fe AK |
754 | (append (mapcar #'car install) |
755 | (mapcar #'car upgrade) | |
756 | (mapcar #'car remove)) | |
457f60fa AK |
757 | '(id name version location))) |
758 | (install-strings (guix-get-package-strings install entries)) | |
759 | (upgrade-strings (guix-get-package-strings upgrade entries)) | |
760 | (remove-strings (guix-get-package-strings remove entries))) | |
761 | (if (or install-strings upgrade-strings remove-strings) | |
762 | (let ((buf (get-buffer-create guix-temp-buffer-name))) | |
763 | (with-current-buffer buf | |
764 | (setq-local cursor-type nil) | |
765 | (setq buffer-read-only nil) | |
766 | (erase-buffer) | |
767 | (guix-insert-package-strings install-strings "install") | |
768 | (guix-insert-package-strings upgrade-strings "upgrade") | |
769 | (guix-insert-package-strings remove-strings "remove") | |
770 | (let ((win (temp-buffer-window-show | |
771 | buf | |
772 | '((display-buffer-reuse-window | |
773 | display-buffer-at-bottom) | |
774 | (window-height . fit-window-to-buffer))))) | |
b497a85b | 775 | (prog1 (guix-operation-prompt) |
457f60fa AK |
776 | (quit-window nil win))))) |
777 | (message "Nothing to be done. If the REPL was restarted, information is not up-to-date.") | |
778 | nil)))) | |
779 | ||
780 | (defun guix-get-package-strings (specs entries) | |
781 | "Return short package descriptions for performing package actions. | |
782 | See `guix-process-package-actions' for the meaning of SPECS. | |
783 | ENTRIES is a list of package entries to get info about packages." | |
784 | (delq nil | |
785 | (mapcar | |
786 | (lambda (spec) | |
787 | (let* ((id (car spec)) | |
788 | (outputs (cdr spec)) | |
789 | (entry (guix-get-entry-by-id id entries))) | |
790 | (when entry | |
791 | (let ((location (guix-get-key-val entry 'location))) | |
792 | (concat (guix-get-full-name entry) | |
793 | (when outputs | |
794 | (concat ":" | |
795 | (mapconcat #'identity outputs ","))) | |
796 | (when location | |
797 | (concat "\t(" location ")"))))))) | |
798 | specs))) | |
799 | ||
800 | (defun guix-insert-package-strings (strings action) | |
801 | "Insert information STRINGS at point for performing package ACTION." | |
802 | (when strings | |
2e269860 | 803 | (insert "Package(s) to " (propertize action 'face 'bold) ":\n") |
457f60fa AK |
804 | (mapc (lambda (str) |
805 | (insert " " str "\n")) | |
806 | strings) | |
807 | (insert "\n"))) | |
808 | ||
b497a85b AK |
809 | (defun guix-operation-prompt () |
810 | "Prompt a user for continuing the current package operation. | |
811 | Return non-nil, if the operation should be continued; nil otherwise." | |
812 | (let* ((option-keys (mapcar #'guix-operation-option-key | |
813 | guix-operation-options)) | |
814 | (keys (append '(?y ?n) option-keys)) | |
815 | (prompt (concat (propertize "Continue operation?" | |
816 | 'face 'minibuffer-prompt) | |
817 | " (" | |
818 | (mapconcat | |
819 | (lambda (key) | |
820 | (propertize (string key) | |
821 | 'face 'guix-operation-option-key)) | |
822 | keys | |
823 | ", ") | |
824 | ") "))) | |
825 | (prog1 (guix-operation-prompt-1 prompt keys) | |
826 | ;; Clear the minibuffer after prompting. | |
827 | (message "")))) | |
828 | ||
829 | (defun guix-operation-prompt-1 (prompt keys) | |
830 | "This function is internal for `guix-operation-prompt'." | |
831 | (guix-operation-set-mode-line) | |
832 | (let ((key (read-char-choice prompt (cons ?\C-g keys) t))) | |
833 | (cl-case key | |
834 | (?y t) | |
835 | ((?n ?\C-g) nil) | |
836 | (t (let* ((option (guix-operation-option-by-key key)) | |
837 | (var (guix-operation-option-variable option))) | |
838 | (set var (not (symbol-value var))) | |
839 | (guix-operation-prompt-1 prompt keys)))))) | |
840 | ||
841 | (defun guix-operation-set-mode-line () | |
842 | "Display operation options in the mode-line of the current buffer." | |
843 | (setq mode-line-format | |
844 | (concat (propertize " Options: " | |
845 | 'face 'mode-line-buffer-id) | |
846 | (mapconcat | |
847 | (lambda (option) | |
848 | (let ((key (guix-operation-option-key option)) | |
849 | (name (guix-operation-option-name option)) | |
850 | (val (guix-operation-option-string-value option))) | |
851 | (concat name | |
852 | " (" | |
853 | (propertize (string key) | |
854 | 'face 'guix-operation-option-key) | |
855 | "): " val))) | |
856 | guix-operation-options | |
857 | guix-operation-option-separator))) | |
858 | (force-mode-line-update)) | |
859 | ||
49d758d2 | 860 | (defun guix-delete-generations (generations &optional operation-buffer) |
cb6a5c71 AK |
861 | "Delete GENERATIONS. |
862 | Each element from GENERATIONS is a generation number." | |
863 | (when (or (not guix-operation-confirm) | |
864 | (y-or-n-p | |
865 | (let ((count (length generations))) | |
866 | (if (> count 1) | |
867 | (format "Delete %d generations? " count) | |
868 | (format "Delete generation number %d? " | |
869 | (car generations)))))) | |
870 | (guix-eval-in-repl | |
871 | (guix-make-guile-expression | |
49d758d2 AK |
872 | 'delete-generations* guix-current-profile generations) |
873 | operation-buffer))) | |
cb6a5c71 | 874 | |
49d758d2 | 875 | (defun guix-switch-to-generation (generation &optional operation-buffer) |
af874238 AK |
876 | "Switch `guix-current-profile' to GENERATION number." |
877 | (when (or (not guix-operation-confirm) | |
878 | (y-or-n-p (format "Switch current profile to generation %d? " | |
879 | generation))) | |
880 | (guix-eval-in-repl | |
881 | (guix-make-guile-expression | |
49d758d2 AK |
882 | 'switch-to-generation guix-current-profile generation) |
883 | operation-buffer))) | |
af874238 | 884 | |
457f60fa AK |
885 | (provide 'guix-base) |
886 | ||
887 | ;;; guix-base.el ends here |