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