Commit | Line | Data |
---|---|---|
187f80c6 AK |
1 | ;;; guix-devel.el --- Development tools -*- lexical-binding: t -*- |
2 | ||
3 | ;; Copyright © 2015 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 commands useful for developing Guix (or even | |
23 | ;; arbitrary Guile code) with Geiser. | |
24 | ||
25 | ;;; Code: | |
26 | ||
17fa842b | 27 | (require 'lisp-mode) |
187f80c6 AK |
28 | (require 'guix-guile) |
29 | (require 'guix-geiser) | |
30 | (require 'guix-utils) | |
1a6c4c2f | 31 | (require 'guix-base) |
187f80c6 AK |
32 | |
33 | (defgroup guix-devel nil | |
34 | "Settings for Guix development utils." | |
35 | :group 'guix) | |
36 | ||
730bf808 AK |
37 | (defgroup guix-devel-faces nil |
38 | "Faces for `guix-devel-mode'." | |
39 | :group 'guix-devel | |
40 | :group 'guix-faces) | |
41 | ||
42 | (defface guix-devel-modify-phases-keyword | |
43 | '((t :inherit font-lock-preprocessor-face)) | |
44 | "Face for a `modify-phases' keyword ('delete', 'replace', etc.)." | |
45 | :group 'guix-devel-faces) | |
46 | ||
1af9815d AK |
47 | (defface guix-devel-gexp-symbol |
48 | '((t :inherit font-lock-keyword-face)) | |
49 | "Face for gexp symbols ('#~', '#$', etc.). | |
50 | See Info node `(guix) G-Expressions'." | |
51 | :group 'guix-devel-faces) | |
52 | ||
187f80c6 AK |
53 | (defcustom guix-devel-activate-mode t |
54 | "If non-nil, then `guix-devel-mode' is automatically activated | |
55 | in Scheme buffers." | |
56 | :type 'boolean | |
57 | :group 'guix-devel) | |
58 | ||
59 | (defun guix-devel-use-modules (&rest modules) | |
60 | "Use guile MODULES." | |
61 | (apply #'guix-geiser-call "use-modules" modules)) | |
62 | ||
63 | (defun guix-devel-use-module (&optional module) | |
64 | "Use guile MODULE in the current Geiser REPL. | |
65 | MODULE is a string with the module name - e.g., \"(ice-9 match)\". | |
66 | Interactively, use the module defined by the current scheme file." | |
67 | (interactive (list (guix-guile-current-module))) | |
68 | (guix-devel-use-modules module) | |
69 | (message "Using %s module." module)) | |
70 | ||
71 | (defun guix-devel-copy-module-as-kill () | |
72 | "Put the name of the current guile module into `kill-ring'." | |
73 | (interactive) | |
74 | (guix-copy-as-kill (guix-guile-current-module))) | |
75 | ||
1a6c4c2f AK |
76 | (defun guix-devel-setup-repl (&optional repl) |
77 | "Setup REPL for using `guix-devel-...' commands." | |
78 | (guix-devel-use-modules "(guix monad-repl)" | |
79 | "(guix scripts)" | |
b94ef11a AK |
80 | "(guix store)" |
81 | "(guix ui)") | |
82 | ;; Without this workaround, the warning/build output disappears. See | |
1a6c4c2f | 83 | ;; <https://github.com/jaor/geiser/issues/83> for details. |
5a60d569 | 84 | (guix-geiser-eval-in-repl-synchronously |
b94ef11a AK |
85 | "(begin |
86 | (guix-warning-port (current-warning-port)) | |
87 | (current-build-output-port (current-error-port)))" | |
1a6c4c2f AK |
88 | repl 'no-history 'no-display)) |
89 | ||
90 | (defvar guix-devel-repl-processes nil | |
91 | "List of REPL processes configured by `guix-devel-setup-repl'.") | |
92 | ||
93 | (defun guix-devel-setup-repl-maybe (&optional repl) | |
94 | "Setup (if needed) REPL for using `guix-devel-...' commands." | |
95 | (let ((process (get-buffer-process (or repl (guix-geiser-repl))))) | |
96 | (when (and process | |
97 | (not (memq process guix-devel-repl-processes))) | |
98 | (guix-devel-setup-repl repl) | |
99 | (push process guix-devel-repl-processes)))) | |
100 | ||
5952111c AK |
101 | (defmacro guix-devel-with-definition (def-var &rest body) |
102 | "Run BODY with the current guile definition bound to DEF-VAR. | |
103 | Bind DEF-VAR variable to the name of the current top-level | |
104 | definition, setup the current REPL, use the current module, and | |
105 | run BODY." | |
106 | (declare (indent 1) (debug (symbolp body))) | |
107 | `(let ((,def-var (guix-guile-current-definition))) | |
108 | (guix-devel-setup-repl-maybe) | |
109 | (guix-devel-use-modules (guix-guile-current-module)) | |
110 | ,@body)) | |
111 | ||
1a6c4c2f AK |
112 | (defun guix-devel-build-package-definition () |
113 | "Build a package defined by the current top-level variable definition." | |
114 | (interactive) | |
5952111c | 115 | (guix-devel-with-definition def |
1a6c4c2f AK |
116 | (when (or (not guix-operation-confirm) |
117 | (guix-operation-prompt (format "Build '%s'?" def))) | |
118 | (guix-geiser-eval-in-repl | |
119 | (concat ",run-in-store " | |
120 | (guix-guile-make-call-expression | |
121 | "build-package" def | |
122 | "#:use-substitutes?" (guix-guile-boolean | |
123 | guix-use-substitutes) | |
124 | "#:dry-run?" (guix-guile-boolean guix-dry-run))))))) | |
125 | ||
ad8b83bd AK |
126 | (defun guix-devel-build-package-source () |
127 | "Build the source of the current package definition." | |
128 | (interactive) | |
129 | (guix-devel-with-definition def | |
130 | (when (or (not guix-operation-confirm) | |
131 | (guix-operation-prompt | |
132 | (format "Build '%s' package source?" def))) | |
133 | (guix-geiser-eval-in-repl | |
134 | (concat ",run-in-store " | |
135 | (guix-guile-make-call-expression | |
136 | "build-package-source" def | |
137 | "#:use-substitutes?" (guix-guile-boolean | |
138 | guix-use-substitutes) | |
139 | "#:dry-run?" (guix-guile-boolean guix-dry-run))))))) | |
140 | ||
b94ef11a AK |
141 | (defun guix-devel-lint-package () |
142 | "Check the current package. | |
143 | See Info node `(guix) Invoking guix lint' for details." | |
144 | (interactive) | |
145 | (guix-devel-with-definition def | |
146 | (guix-devel-use-modules "(guix scripts lint)") | |
147 | (when (or (not guix-operation-confirm) | |
148 | (y-or-n-p (format "Lint '%s' package?" def))) | |
149 | (guix-geiser-eval-in-repl | |
150 | (format "(run-checkers %s)" def))))) | |
151 | ||
730bf808 AK |
152 | \f |
153 | ;;; Font-lock | |
154 | ||
155 | (defvar guix-devel-modify-phases-keyword-regexp | |
156 | (rx (+ word)) | |
157 | "Regexp for a 'modify-phases' keyword ('delete', 'replace', etc.).") | |
158 | ||
159 | (defun guix-devel-modify-phases-font-lock-matcher (limit) | |
160 | "Find a 'modify-phases' keyword. | |
161 | This function is used as a MATCHER for `font-lock-keywords'." | |
162 | (ignore-errors | |
163 | (down-list) | |
164 | (or (re-search-forward guix-devel-modify-phases-keyword-regexp | |
165 | limit t) | |
166 | (set-match-data nil)) | |
167 | (up-list) | |
168 | t)) | |
169 | ||
170 | (defun guix-devel-modify-phases-font-lock-pre () | |
171 | "Skip the next sexp, and return the end point of the current list. | |
172 | This function is used as a PRE-MATCH-FORM for `font-lock-keywords' | |
173 | to find 'modify-phases' keywords." | |
88908d55 AK |
174 | (let ((in-comment? (nth 4 (syntax-ppss)))) |
175 | ;; If 'modify-phases' is commented, do not try to search for its | |
176 | ;; keywords. | |
177 | (unless in-comment? | |
178 | (ignore-errors (forward-sexp)) | |
179 | (save-excursion (up-list) (point))))) | |
730bf808 | 180 | |
5d86684d AK |
181 | (defconst guix-devel-keywords |
182 | '("call-with-compressed-output-port" | |
183 | "call-with-container" | |
184 | "call-with-decompressed-port" | |
185 | "call-with-derivation-narinfo" | |
186 | "call-with-derivation-substitute" | |
187 | "call-with-error-handling" | |
188 | "call-with-temporary-directory" | |
189 | "call-with-temporary-output-file" | |
190 | "define-enumerate-type" | |
191 | "define-gexp-compiler" | |
192 | "define-lift" | |
193 | "define-monad" | |
194 | "define-operation" | |
195 | "define-record-type*" | |
196 | "emacs-substitute-sexps" | |
197 | "emacs-substitute-variables" | |
198 | "mbegin" | |
199 | "mlet" | |
200 | "mlet*" | |
cd6f6c22 | 201 | "modify-services" |
5d86684d AK |
202 | "munless" |
203 | "mwhen" | |
204 | "run-with-state" | |
205 | "run-with-store" | |
206 | "signature-case" | |
207 | "substitute*" | |
208 | "substitute-keyword-arguments" | |
209 | "test-assertm" | |
210 | "use-package-modules" | |
211 | "use-service-modules" | |
212 | "use-system-modules" | |
213 | "with-atomic-file-output" | |
214 | "with-atomic-file-replacement" | |
215 | "with-derivation-narinfo" | |
216 | "with-derivation-substitute" | |
217 | "with-directory-excursion" | |
218 | "with-error-handling" | |
0bb9929e | 219 | "with-imported-modules" |
5d86684d AK |
220 | "with-monad" |
221 | "with-mutex" | |
222 | "with-store")) | |
223 | ||
730bf808 | 224 | (defvar guix-devel-font-lock-keywords |
1af9815d AK |
225 | `((,(rx (or "#~" "#$" "#$@" "#+" "#+@")) . |
226 | 'guix-devel-gexp-symbol) | |
5d86684d AK |
227 | (,(guix-guile-keyword-regexp (regexp-opt guix-devel-keywords)) |
228 | (1 'font-lock-keyword-face)) | |
1af9815d | 229 | (,(guix-guile-keyword-regexp "modify-phases") |
730bf808 AK |
230 | (1 'font-lock-keyword-face) |
231 | (guix-devel-modify-phases-font-lock-matcher | |
232 | (guix-devel-modify-phases-font-lock-pre) | |
233 | nil | |
234 | (0 'guix-devel-modify-phases-keyword nil t)))) | |
235 | "A list of `font-lock-keywords' for `guix-devel-mode'.") | |
236 | ||
237 | \f | |
17fa842b AK |
238 | ;;; Indentation |
239 | ||
240 | (defmacro guix-devel-scheme-indent (&rest rules) | |
241 | "Set `scheme-indent-function' according to RULES. | |
242 | Each rule should have a form (SYMBOL VALUE). See `put' for details." | |
243 | (declare (indent 0)) | |
244 | `(progn | |
245 | ,@(mapcar (lambda (rule) | |
246 | `(put ',(car rule) 'scheme-indent-function ,(cadr rule))) | |
247 | rules))) | |
248 | ||
249 | (defun guix-devel-indent-package (state indent-point normal-indent) | |
250 | "Indentation rule for 'package' form." | |
251 | (let* ((package-eol (line-end-position)) | |
252 | (count (if (and (ignore-errors (down-list) t) | |
253 | (< (point) package-eol) | |
254 | (looking-at "inherit\\>")) | |
255 | 1 | |
256 | 0))) | |
257 | (lisp-indent-specform count state indent-point normal-indent))) | |
258 | ||
4ab70c5c AK |
259 | (defun guix-devel-indent-modify-phases-keyword (count) |
260 | "Return indentation function for 'modify-phases' keywords." | |
261 | (lambda (state indent-point normal-indent) | |
262 | (when (ignore-errors | |
263 | (goto-char (nth 1 state)) ; start of keyword sexp | |
264 | (backward-up-list) | |
265 | (looking-at "(modify-phases\\>")) | |
266 | (lisp-indent-specform count state indent-point normal-indent)))) | |
267 | ||
268 | (defalias 'guix-devel-indent-modify-phases-keyword-1 | |
269 | (guix-devel-indent-modify-phases-keyword 1)) | |
270 | (defalias 'guix-devel-indent-modify-phases-keyword-2 | |
271 | (guix-devel-indent-modify-phases-keyword 2)) | |
272 | ||
17fa842b AK |
273 | (guix-devel-scheme-indent |
274 | (bag 0) | |
275 | (build-system 0) | |
276 | (call-with-compressed-output-port 2) | |
277 | (call-with-container 1) | |
278 | (call-with-decompressed-port 2) | |
279 | (call-with-error-handling 0) | |
280 | (container-excursion 1) | |
281 | (emacs-batch-edit-file 1) | |
282 | (emacs-batch-eval 0) | |
283 | (emacs-substitute-sexps 1) | |
284 | (emacs-substitute-variables 1) | |
285 | (file-system 0) | |
286 | (graft 0) | |
287 | (manifest-entry 0) | |
288 | (manifest-pattern 0) | |
289 | (mbegin 1) | |
290 | (mlet 2) | |
291 | (mlet* 2) | |
292 | (modify-phases 1) | |
cd6f6c22 | 293 | (modify-services 1) |
17fa842b AK |
294 | (munless 1) |
295 | (mwhen 1) | |
296 | (operating-system 0) | |
297 | (origin 0) | |
298 | (package 'guix-devel-indent-package) | |
299 | (run-with-state 1) | |
300 | (run-with-store 1) | |
301 | (signature-case 1) | |
302 | (substitute* 1) | |
303 | (substitute-keyword-arguments 1) | |
304 | (test-assertm 1) | |
305 | (with-atomic-file-output 1) | |
306 | (with-derivation-narinfo 1) | |
307 | (with-derivation-substitute 2) | |
308 | (with-directory-excursion 1) | |
309 | (with-error-handling 0) | |
0bb9929e | 310 | (with-imported-modules 1) |
17fa842b AK |
311 | (with-monad 1) |
312 | (with-mutex 1) | |
313 | (with-store 1) | |
4ab70c5c AK |
314 | (wrap-program 1) |
315 | ||
316 | ;; 'modify-phases' keywords: | |
317 | (replace 'guix-devel-indent-modify-phases-keyword-1) | |
318 | (add-after 'guix-devel-indent-modify-phases-keyword-2) | |
319 | (add-before 'guix-devel-indent-modify-phases-keyword-2)) | |
17fa842b AK |
320 | |
321 | \f | |
187f80c6 AK |
322 | (defvar guix-devel-keys-map |
323 | (let ((map (make-sparse-keymap))) | |
1a6c4c2f | 324 | (define-key map (kbd "b") 'guix-devel-build-package-definition) |
ad8b83bd | 325 | (define-key map (kbd "s") 'guix-devel-build-package-source) |
b94ef11a | 326 | (define-key map (kbd "l") 'guix-devel-lint-package) |
187f80c6 AK |
327 | (define-key map (kbd "k") 'guix-devel-copy-module-as-kill) |
328 | (define-key map (kbd "u") 'guix-devel-use-module) | |
329 | map) | |
330 | "Keymap with subkeys for `guix-devel-mode-map'.") | |
331 | ||
332 | (defvar guix-devel-mode-map | |
333 | (let ((map (make-sparse-keymap))) | |
334 | (define-key map (kbd "C-c .") guix-devel-keys-map) | |
335 | map) | |
336 | "Keymap for `guix-devel-mode'.") | |
337 | ||
338 | ;;;###autoload | |
339 | (define-minor-mode guix-devel-mode | |
340 | "Minor mode for `scheme-mode' buffers. | |
341 | ||
342 | With a prefix argument ARG, enable the mode if ARG is positive, | |
343 | and disable it otherwise. If called from Lisp, enable the mode | |
344 | if ARG is omitted or nil. | |
345 | ||
346 | When Guix Devel mode is enabled, it provides the following key | |
347 | bindings: | |
348 | ||
349 | \\{guix-devel-mode-map}" | |
350 | :init-value nil | |
351 | :lighter " Guix" | |
730bf808 AK |
352 | :keymap guix-devel-mode-map |
353 | (if guix-devel-mode | |
354 | (progn | |
355 | (setq-local font-lock-multiline t) | |
356 | (font-lock-add-keywords nil guix-devel-font-lock-keywords)) | |
357 | (setq-local font-lock-multiline nil) | |
358 | (font-lock-remove-keywords nil guix-devel-font-lock-keywords)) | |
359 | (when font-lock-mode | |
360 | (font-lock-fontify-buffer))) | |
187f80c6 AK |
361 | |
362 | ;;;###autoload | |
363 | (defun guix-devel-activate-mode-maybe () | |
364 | "Activate `guix-devel-mode' depending on | |
365 | `guix-devel-activate-mode' variable." | |
366 | (when guix-devel-activate-mode | |
367 | (guix-devel-mode))) | |
368 | ||
19a9c6f4 AK |
369 | ;;;###autoload |
370 | (add-hook 'scheme-mode-hook 'guix-devel-activate-mode-maybe) | |
371 | ||
5952111c AK |
372 | \f |
373 | (defvar guix-devel-emacs-font-lock-keywords | |
374 | (eval-when-compile | |
375 | `((,(rx "(" (group "guix-devel-with-definition") symbol-end) . 1)))) | |
376 | ||
377 | (font-lock-add-keywords 'emacs-lisp-mode | |
378 | guix-devel-emacs-font-lock-keywords) | |
379 | ||
187f80c6 AK |
380 | (provide 'guix-devel) |
381 | ||
382 | ;;; guix-devel.el ends here |