1 ;;; guix-devel.el --- Development tools -*- lexical-binding: t -*-
3 ;; Copyright © 2015 Alex Kost <alezost@gmail.com>
5 ;; This file is part of GNU Guix.
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.
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.
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/>.
22 ;; This file provides commands useful for developing Guix (or even
23 ;; arbitrary Guile code) with Geiser.
29 (require 'guix-geiser
)
33 (defgroup guix-devel nil
34 "Settings for Guix development utils."
37 (defgroup guix-devel-faces nil
38 "Faces for `guix-devel-mode'."
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
)
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
)
53 (defcustom guix-devel-activate-mode t
54 "If non-nil, then `guix-devel-mode' is automatically activated
59 (defun guix-devel-use-modules (&rest modules
)
61 (apply #'guix-geiser-call
"use-modules" modules
))
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
))
71 (defun guix-devel-copy-module-as-kill ()
72 "Put the name of the current guile module into `kill-ring'."
74 (guix-copy-as-kill (guix-guile-current-module)))
76 (defun guix-devel-setup-repl (&optional repl
)
77 "Setup REPL for using `guix-devel-...' commands."
78 (guix-devel-use-modules "(guix monad-repl)"
82 ;; Without this workaround, the warning/build output disappears. See
83 ;; <https://github.com/jaor/geiser/issues/83> for details.
84 (guix-geiser-eval-in-repl-synchronously
86 (guix-warning-port (current-warning-port))
87 (current-build-output-port (current-error-port)))"
88 repl
'no-history
'no-display
))
90 (defvar guix-devel-repl-processes nil
91 "List of REPL processes configured by `guix-devel-setup-repl'.")
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)))))
97 (not (memq process guix-devel-repl-processes
)))
98 (guix-devel-setup-repl repl
)
99 (push process guix-devel-repl-processes
))))
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
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))
112 (defun guix-devel-build-package-definition ()
113 "Build a package defined by the current top-level variable definition."
115 (guix-devel-with-definition def
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
122 "#:use-substitutes?" (guix-guile-boolean
123 guix-use-substitutes
)
124 "#:dry-run?" (guix-guile-boolean guix-dry-run
)))))))
126 (defun guix-devel-build-package-source ()
127 "Build the source of the current package definition."
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
)))))))
141 (defun guix-devel-lint-package ()
142 "Check the current package.
143 See Info node `(guix) Invoking guix lint' for details."
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
)))))
155 (defvar guix-devel-modify-phases-keyword-regexp
157 "Regexp for a 'modify-phases' keyword ('delete', 'replace', etc.).")
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'."
164 (or (re-search-forward guix-devel-modify-phases-keyword-regexp
166 (set-match-data nil
))
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."
174 (let ((in-comment?
(nth 4 (syntax-ppss))))
175 ;; If 'modify-phases' is commented, do not try to search for its
178 (ignore-errors (forward-sexp))
179 (save-excursion (up-list) (point)))))
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"
195 "define-record-type*"
196 "emacs-substitute-sexps"
197 "emacs-substitute-variables"
207 "substitute-keyword-arguments"
209 "use-package-modules"
210 "use-service-modules"
212 "with-atomic-file-output"
213 "with-atomic-file-replacement"
214 "with-derivation-narinfo"
215 "with-derivation-substitute"
216 "with-directory-excursion"
217 "with-error-handling"
222 (defvar guix-devel-font-lock-keywords
223 `((,(rx (or "#~" "#$" "#$@" "#+" "#+@")) .
224 'guix-devel-gexp-symbol
)
225 (,(guix-guile-keyword-regexp (regexp-opt guix-devel-keywords
))
226 (1 'font-lock-keyword-face
))
227 (,(guix-guile-keyword-regexp "modify-phases")
228 (1 'font-lock-keyword-face
)
229 (guix-devel-modify-phases-font-lock-matcher
230 (guix-devel-modify-phases-font-lock-pre)
232 (0 'guix-devel-modify-phases-keyword nil t
))))
233 "A list of `font-lock-keywords' for `guix-devel-mode'.")
238 (defmacro guix-devel-scheme-indent
(&rest rules
)
239 "Set `scheme-indent-function' according to RULES.
240 Each rule should have a form (SYMBOL VALUE). See `put' for details."
243 ,@(mapcar (lambda (rule)
244 `(put ',(car rule
) 'scheme-indent-function
,(cadr rule
)))
247 (defun guix-devel-indent-package (state indent-point normal-indent
)
248 "Indentation rule for 'package' form."
249 (let* ((package-eol (line-end-position))
250 (count (if (and (ignore-errors (down-list) t
)
251 (< (point) package-eol
)
252 (looking-at "inherit\\>"))
255 (lisp-indent-specform count state indent-point normal-indent
)))
257 (defun guix-devel-indent-modify-phases-keyword (count)
258 "Return indentation function for 'modify-phases' keywords."
259 (lambda (state indent-point normal-indent
)
261 (goto-char (nth 1 state
)) ; start of keyword sexp
263 (looking-at "(modify-phases\\>"))
264 (lisp-indent-specform count state indent-point normal-indent
))))
266 (defalias 'guix-devel-indent-modify-phases-keyword-1
267 (guix-devel-indent-modify-phases-keyword 1))
268 (defalias 'guix-devel-indent-modify-phases-keyword-2
269 (guix-devel-indent-modify-phases-keyword 2))
271 (guix-devel-scheme-indent
274 (call-with-compressed-output-port 2)
275 (call-with-container 1)
276 (call-with-decompressed-port 2)
277 (call-with-error-handling 0)
278 (container-excursion 1)
279 (emacs-batch-edit-file 1)
281 (emacs-substitute-sexps 1)
282 (emacs-substitute-variables 1)
295 (package 'guix-devel-indent-package
)
300 (substitute-keyword-arguments 1)
302 (with-atomic-file-output 1)
303 (with-derivation-narinfo 1)
304 (with-derivation-substitute 2)
305 (with-directory-excursion 1)
306 (with-error-handling 0)
312 ;; 'modify-phases' keywords:
313 (replace 'guix-devel-indent-modify-phases-keyword-1
)
314 (add-after 'guix-devel-indent-modify-phases-keyword-2
)
315 (add-before 'guix-devel-indent-modify-phases-keyword-2
))
318 (defvar guix-devel-keys-map
319 (let ((map (make-sparse-keymap)))
320 (define-key map
(kbd "b") 'guix-devel-build-package-definition
)
321 (define-key map
(kbd "s") 'guix-devel-build-package-source
)
322 (define-key map
(kbd "l") 'guix-devel-lint-package
)
323 (define-key map
(kbd "k") 'guix-devel-copy-module-as-kill
)
324 (define-key map
(kbd "u") 'guix-devel-use-module
)
326 "Keymap with subkeys for `guix-devel-mode-map'.")
328 (defvar guix-devel-mode-map
329 (let ((map (make-sparse-keymap)))
330 (define-key map
(kbd "C-c .") guix-devel-keys-map
)
332 "Keymap for `guix-devel-mode'.")
335 (define-minor-mode guix-devel-mode
336 "Minor mode for `scheme-mode' buffers.
338 With a prefix argument ARG, enable the mode if ARG is positive,
339 and disable it otherwise. If called from Lisp, enable the mode
340 if ARG is omitted or nil.
342 When Guix Devel mode is enabled, it provides the following key
345 \\{guix-devel-mode-map}"
348 :keymap guix-devel-mode-map
351 (setq-local font-lock-multiline t
)
352 (font-lock-add-keywords nil guix-devel-font-lock-keywords
))
353 (setq-local font-lock-multiline nil
)
354 (font-lock-remove-keywords nil guix-devel-font-lock-keywords
))
356 (font-lock-fontify-buffer)))
359 (defun guix-devel-activate-mode-maybe ()
360 "Activate `guix-devel-mode' depending on
361 `guix-devel-activate-mode' variable."
362 (when guix-devel-activate-mode
366 (defvar guix-devel-emacs-font-lock-keywords
368 `((,(rx "(" (group "guix-devel-with-definition") symbol-end
) .
1))))
370 (font-lock-add-keywords 'emacs-lisp-mode
371 guix-devel-emacs-font-lock-keywords
)
373 (provide 'guix-devel
)
375 ;;; guix-devel.el ends here