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