Commit | Line | Data |
---|---|---|
dfeb0239 | 1 | ;;; guix-base.el --- Common definitions -*- lexical-binding: t -*- |
457f60fa | 2 | |
2df17bd0 | 3 | ;; Copyright © 2014, 2015, 2016 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 | ||
457f60fa AK |
25 | ;;; Code: |
26 | ||
27 | (require 'cl-lib) | |
28 | (require 'guix-backend) | |
c74cd6cc | 29 | (require 'guix-guile) |
c80ce104 | 30 | (require 'guix-read) |
457f60fa | 31 | (require 'guix-utils) |
8bff0c79 | 32 | (require 'guix-ui) |
e20f051e | 33 | (require 'guix-profiles) |
457f60fa | 34 | |
c80ce104 AK |
35 | (defgroup guix nil |
36 | "Settings for Guix package manager and friends." | |
37 | :prefix "guix-" | |
38 | :group 'external) | |
39 | ||
40 | (defgroup guix-faces nil | |
41 | "Guix faces." | |
42 | :group 'guix | |
43 | :group 'faces) | |
457f60fa | 44 | |
0b9cd320 | 45 | (defun guix-package-name-specification (name version &optional output) |
457f60fa | 46 | "Return Guix package specification by its NAME, VERSION and OUTPUT." |
db0c709b | 47 | (concat name "@" version |
457f60fa AK |
48 | (when output (concat ":" output)))) |
49 | ||
457f60fa | 50 | \f |
79c7a8f2 | 51 | ;;; Location of profiles and manifests |
6248e326 | 52 | |
d38bd08c AK |
53 | (defun guix-generation-file (profile generation) |
54 | "Return the file name of a PROFILE's GENERATION." | |
55 | (format "%s-%s-link" profile generation)) | |
56 | ||
2df17bd0 AK |
57 | (defun guix-packages-profile (profile &optional generation system?) |
58 | "Return a directory where packages are installed for the | |
59 | PROFILE's GENERATION. | |
60 | ||
61 | If SYSTEM? is non-nil, then PROFILE is considered to be a system | |
62 | profile. Unlike usual profiles, for a system profile, packages | |
63 | are placed in 'profile' subdirectory." | |
64 | (let ((profile (if generation | |
65 | (guix-generation-file profile generation) | |
66 | profile))) | |
67 | (if system? | |
68 | (expand-file-name "profile" profile) | |
69 | profile))) | |
70 | ||
71 | (defun guix-manifest-file (profile &optional generation system?) | |
d38bd08c | 72 | "Return the file name of a PROFILE's manifest. |
2df17bd0 | 73 | See `guix-packages-profile'." |
d38bd08c | 74 | (expand-file-name "manifest" |
2df17bd0 | 75 | (guix-packages-profile profile generation system?))) |
d38bd08c | 76 | |
d38bd08c | 77 | \f |
457f60fa AK |
78 | ;;; Actions on packages and generations |
79 | ||
b497a85b AK |
80 | (defface guix-operation-option-key |
81 | '((t :inherit font-lock-warning-face)) | |
82 | "Face used for the keys of operation options." | |
46e17df6 | 83 | :group 'guix-faces) |
b497a85b | 84 | |
457f60fa AK |
85 | (defcustom guix-operation-confirm t |
86 | "If nil, do not prompt to confirm an operation." | |
87 | :type 'boolean | |
88 | :group 'guix) | |
89 | ||
90 | (defcustom guix-use-substitutes t | |
91 | "If non-nil, use substitutes for the Guix packages." | |
92 | :type 'boolean | |
93 | :group 'guix) | |
94 | ||
95 | (defvar guix-dry-run nil | |
96 | "If non-nil, do not perform the real actions, just simulate.") | |
97 | ||
98 | (defvar guix-temp-buffer-name " *Guix temp*" | |
99 | "Name of a buffer used for displaying info before executing operation.") | |
100 | ||
b497a85b AK |
101 | (defvar guix-operation-option-true-string "yes" |
102 | "String displayed in the mode-line when operation option is t.") | |
103 | ||
104 | (defvar guix-operation-option-false-string "no " | |
105 | "String displayed in the mode-line when operation option is nil.") | |
106 | ||
107 | (defvar guix-operation-option-separator " | " | |
108 | "String used in the mode-line to separate operation options.") | |
109 | ||
110 | (defvar guix-operation-options | |
111 | '((?s "substitutes" guix-use-substitutes) | |
112 | (?d "dry-run" guix-dry-run)) | |
113 | "List of available operation options. | |
114 | Each element of the list has a form: | |
115 | ||
116 | (KEY NAME VARIABLE) | |
117 | ||
118 | KEY is a character that may be pressed during confirmation to | |
119 | toggle the option. | |
120 | NAME is a string displayed in the mode-line. | |
121 | VARIABLE is a name of an option variable.") | |
122 | ||
123 | (defun guix-operation-option-by-key (key) | |
124 | "Return operation option by KEY (character)." | |
125 | (assq key guix-operation-options)) | |
126 | ||
127 | (defun guix-operation-option-key (option) | |
128 | "Return key (character) of the operation OPTION." | |
129 | (car option)) | |
130 | ||
131 | (defun guix-operation-option-name (option) | |
132 | "Return name of the operation OPTION." | |
133 | (nth 1 option)) | |
134 | ||
135 | (defun guix-operation-option-variable (option) | |
136 | "Return name of the variable of the operation OPTION." | |
137 | (nth 2 option)) | |
138 | ||
139 | (defun guix-operation-option-value (option) | |
140 | "Return boolean value of the operation OPTION." | |
141 | (symbol-value (guix-operation-option-variable option))) | |
142 | ||
143 | (defun guix-operation-option-string-value (option) | |
144 | "Convert boolean value of the operation OPTION to string and return it." | |
145 | (if (guix-operation-option-value option) | |
146 | guix-operation-option-true-string | |
147 | guix-operation-option-false-string)) | |
148 | ||
0b0fbf0c | 149 | (defun guix-operation-prompt (&optional prompt) |
7be25d4a | 150 | "Prompt a user for continuing the current operation. |
0b0fbf0c AK |
151 | Return non-nil, if the operation should be continued; nil otherwise. |
152 | Ask a user with PROMPT for continuing an operation." | |
b497a85b AK |
153 | (let* ((option-keys (mapcar #'guix-operation-option-key |
154 | guix-operation-options)) | |
155 | (keys (append '(?y ?n) option-keys)) | |
0b0fbf0c | 156 | (prompt (concat (propertize (or prompt "Continue operation?") |
b497a85b AK |
157 | 'face 'minibuffer-prompt) |
158 | " (" | |
159 | (mapconcat | |
160 | (lambda (key) | |
161 | (propertize (string key) | |
162 | 'face 'guix-operation-option-key)) | |
163 | keys | |
164 | ", ") | |
165 | ") "))) | |
7be25d4a AK |
166 | (let ((mode-line mode-line-format)) |
167 | (prog1 (guix-operation-prompt-1 prompt keys) | |
168 | (setq mode-line-format mode-line) | |
169 | ;; Clear the minibuffer after prompting. | |
170 | (message ""))))) | |
b497a85b AK |
171 | |
172 | (defun guix-operation-prompt-1 (prompt keys) | |
173 | "This function is internal for `guix-operation-prompt'." | |
174 | (guix-operation-set-mode-line) | |
175 | (let ((key (read-char-choice prompt (cons ?\C-g keys) t))) | |
176 | (cl-case key | |
177 | (?y t) | |
178 | ((?n ?\C-g) nil) | |
179 | (t (let* ((option (guix-operation-option-by-key key)) | |
180 | (var (guix-operation-option-variable option))) | |
181 | (set var (not (symbol-value var))) | |
182 | (guix-operation-prompt-1 prompt keys)))))) | |
183 | ||
184 | (defun guix-operation-set-mode-line () | |
185 | "Display operation options in the mode-line of the current buffer." | |
186 | (setq mode-line-format | |
187 | (concat (propertize " Options: " | |
188 | 'face 'mode-line-buffer-id) | |
189 | (mapconcat | |
190 | (lambda (option) | |
191 | (let ((key (guix-operation-option-key option)) | |
192 | (name (guix-operation-option-name option)) | |
193 | (val (guix-operation-option-string-value option))) | |
194 | (concat name | |
195 | " (" | |
196 | (propertize (string key) | |
197 | 'face 'guix-operation-option-key) | |
198 | "): " val))) | |
199 | guix-operation-options | |
200 | guix-operation-option-separator))) | |
201 | (force-mode-line-update)) | |
202 | ||
0b0fbf0c AK |
203 | (defun guix-package-source-path (package-id) |
204 | "Return a store file path to a source of a package PACKAGE-ID." | |
205 | (message "Calculating the source derivation ...") | |
206 | (guix-eval-read | |
207 | (guix-make-guile-expression | |
208 | 'package-source-path package-id))) | |
d01ebd05 AK |
209 | |
210 | (defun guix-package-store-path (package-id) | |
211 | "Return a list of store directories of outputs of package PACKAGE-ID." | |
212 | (message "Calculating the package derivation ...") | |
213 | (guix-eval-read | |
214 | (guix-make-guile-expression | |
215 | 'package-store-path package-id))) | |
0b0fbf0c AK |
216 | |
217 | (defvar guix-after-source-download-hook nil | |
218 | "Hook run after successful performing a 'source-download' operation.") | |
219 | ||
220 | (defun guix-package-source-build-derivation (package-id &optional prompt) | |
221 | "Build source derivation of a package PACKAGE-ID. | |
222 | Ask a user with PROMPT for continuing an operation." | |
223 | (when (or (not guix-operation-confirm) | |
224 | (guix-operation-prompt (or prompt | |
225 | "Build the source derivation?"))) | |
226 | (guix-eval-in-repl | |
227 | (guix-make-guile-expression | |
228 | 'package-source-build-derivation | |
229 | package-id | |
230 | :use-substitutes? (or guix-use-substitutes 'f) | |
231 | :dry-run? (or guix-dry-run 'f)) | |
232 | nil 'source-download))) | |
233 | ||
e98316e6 AK |
234 | (defun guix-build-package (package-id &optional prompt) |
235 | "Build package with PACKAGE-ID. | |
236 | Ask a user with PROMPT for continuing the build operation." | |
237 | (when (or (not guix-operation-confirm) | |
238 | (guix-operation-prompt (or prompt "Build package?"))) | |
239 | (guix-eval-in-repl | |
240 | (format (concat ",run-in-store " | |
241 | "(build-package (package-by-id %d)" | |
242 | " #:use-substitutes? %s" | |
243 | " #:dry-run? %s)") | |
244 | package-id | |
245 | (guix-guile-boolean guix-use-substitutes) | |
246 | (guix-guile-boolean guix-dry-run))))) | |
247 | ||
5a727cdf AK |
248 | ;;;###autoload |
249 | (defun guix-apply-manifest (profile file &optional operation-buffer) | |
250 | "Apply manifest from FILE to PROFILE. | |
251 | This function has the same meaning as 'guix package --manifest' command. | |
252 | See Info node `(guix) Invoking guix package' for details. | |
253 | ||
254 | Interactively, use the current profile and prompt for manifest | |
255 | FILE. With a prefix argument, also prompt for PROFILE." | |
256 | (interactive | |
6c40b7b7 | 257 | (let* ((current-profile (guix-ui-current-profile)) |
5a727cdf AK |
258 | (profile (if current-prefix-arg |
259 | (guix-profile-prompt) | |
6c40b7b7 | 260 | (or current-profile guix-current-profile))) |
5a727cdf | 261 | (file (read-file-name "File with manifest: ")) |
6c40b7b7 | 262 | (buffer (and current-profile (current-buffer)))) |
5a727cdf AK |
263 | (list profile file buffer))) |
264 | (when (or (not guix-operation-confirm) | |
265 | (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? " | |
266 | file profile))) | |
267 | (guix-eval-in-repl | |
268 | (guix-make-guile-expression | |
957b7338 AK |
269 | 'guix-command |
270 | "package" | |
271 | (concat "--profile=" (expand-file-name profile)) | |
272 | (concat "--manifest=" (expand-file-name file))) | |
5a727cdf AK |
273 | operation-buffer))) |
274 | ||
2d7bf949 | 275 | \f |
5e53b0c5 AK |
276 | ;;; Executing guix commands |
277 | ||
7008dfff AK |
278 | (defcustom guix-run-in-shell-function #'guix-run-in-shell |
279 | "Function used to run guix command. | |
280 | The function is called with a single argument - a command line string." | |
281 | :type '(choice (function-item guix-run-in-shell) | |
282 | (function-item guix-run-in-eshell) | |
283 | (function :tag "Other function")) | |
284 | :group 'guix) | |
285 | ||
286 | (defcustom guix-shell-buffer-name "*shell*" | |
287 | "Default name of a shell buffer used for running guix commands." | |
288 | :type 'string | |
289 | :group 'guix) | |
290 | ||
291 | (declare-function comint-send-input "comint" t) | |
292 | ||
293 | (defun guix-run-in-shell (string) | |
294 | "Run command line STRING in `guix-shell-buffer-name' buffer." | |
295 | (shell guix-shell-buffer-name) | |
296 | (goto-char (point-max)) | |
297 | (insert string) | |
298 | (comint-send-input)) | |
299 | ||
300 | (declare-function eshell-send-input "esh-mode" t) | |
301 | ||
302 | (defun guix-run-in-eshell (string) | |
303 | "Run command line STRING in eshell buffer." | |
304 | (eshell) | |
305 | (goto-char (point-max)) | |
306 | (insert string) | |
307 | (eshell-send-input)) | |
308 | ||
309 | (defun guix-run-command-in-shell (args) | |
310 | "Execute 'guix ARGS ...' command in a shell buffer." | |
311 | (funcall guix-run-in-shell-function | |
312 | (guix-command-string args))) | |
313 | ||
5e53b0c5 AK |
314 | (defun guix-run-command-in-repl (args) |
315 | "Execute 'guix ARGS ...' command in Guix REPL." | |
316 | (guix-eval-in-repl | |
317 | (apply #'guix-make-guile-expression | |
318 | 'guix-command args))) | |
319 | ||
320 | (defun guix-command-output (args) | |
321 | "Return string with 'guix ARGS ...' output." | |
ea369ee1 AK |
322 | (cl-multiple-value-bind (output error) |
323 | (guix-eval (apply #'guix-make-guile-expression | |
324 | 'guix-command-output args)) | |
325 | ;; Remove trailing new space from the error string. | |
326 | (message (replace-regexp-in-string "\n\\'" "" (read error))) | |
327 | (read output))) | |
5e53b0c5 AK |
328 | |
329 | (defun guix-help-string (&optional commands) | |
330 | "Return string with 'guix COMMANDS ... --help' output." | |
331 | (guix-eval-read | |
332 | (apply #'guix-make-guile-expression | |
333 | 'help-string commands))) | |
334 | ||
335 | \f | |
2d7bf949 AK |
336 | ;;; Pull |
337 | ||
338 | (defcustom guix-update-after-pull t | |
339 | "If non-nil, update Guix buffers after performing \\[guix-pull]." | |
340 | :type 'boolean | |
341 | :group 'guix) | |
342 | ||
343 | (defvar guix-after-pull-hook | |
344 | '(guix-restart-repl-after-pull guix-update-buffers-maybe-after-pull) | |
345 | "Hook run after successful performing `guix-pull' operation.") | |
346 | ||
347 | (defun guix-restart-repl-after-pull () | |
348 | "Restart Guix REPL after `guix-pull' operation." | |
349 | (guix-repl-exit) | |
350 | (guix-start-process-maybe | |
351 | "Restarting Guix REPL after pull operation ...")) | |
352 | ||
353 | (defun guix-update-buffers-maybe-after-pull () | |
354 | "Update buffers depending on `guix-update-after-pull'." | |
355 | (when guix-update-after-pull | |
8bff0c79 | 356 | (mapc #'guix-ui-update-buffer |
2d7bf949 | 357 | ;; No need to update "generation" buffers. |
8bff0c79 AK |
358 | (guix-ui-buffers '(guix-package-list-mode |
359 | guix-package-info-mode | |
360 | guix-output-list-mode | |
361 | guix-output-info-mode))) | |
2d7bf949 AK |
362 | (message "Guix buffers have been updated."))) |
363 | ||
364 | ;;;###autoload | |
365 | (defun guix-pull (&optional verbose) | |
366 | "Run Guix pull operation. | |
367 | If VERBOSE is non-nil (with prefix argument), produce verbose output." | |
c67e344f | 368 | (interactive "P") |
2d7bf949 AK |
369 | (let ((args (and verbose '("--verbose")))) |
370 | (guix-eval-in-repl | |
c67e344f AK |
371 | (apply #'guix-make-guile-expression |
372 | 'guix-command "pull" args) | |
2d7bf949 AK |
373 | nil 'pull))) |
374 | ||
457f60fa AK |
375 | (provide 'guix-base) |
376 | ||
377 | ;;; guix-base.el ends here |