From ad8b83bda052a12077d5da4c3c9b3d3d0911025a Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Fri, 9 Oct 2015 16:45:24 +0300
Subject: [PATCH] emacs: Add 'guix-devel-build-package-source'.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Suggested by Ludovic Courtès <ludo@gnu.org>.

* guix/scripts.scm (build-package-source): New procedure.
* emacs/guix-devel.el (guix-devel-build-package-source): New command.
  (guix-devel-keys-map): Add key binding for it.
* doc/emacs.texi (Emacs Development): Document it.
---
 doc/emacs.texi      |  6 ++++++
 emacs/guix-devel.el | 16 ++++++++++++++++
 guix/scripts.scm    | 20 +++++++++++++++++++-
 3 files changed, 41 insertions(+), 1 deletion(-)

diff --git a/doc/emacs.texi b/doc/emacs.texi
index 325e14e2a4..ab69515972 100644
--- a/doc/emacs.texi
+++ b/doc/emacs.texi
@@ -667,6 +667,12 @@ this command---for example, with @kbd{C-M-x} (@pxref{To eval or not to
 eval,,, geiser, Geiser User Manual})
 (@code{guix-devel-build-package-definition}).
 
+@item C-c . s
+Build a source derivation of the package defined by the current variable
+definition.  This command has the same meaning as @code{guix build -S}
+shell command (@pxref{Invoking guix build})
+(@code{guix-devel-build-package-source}).
+
 @item C-c . l
 Lint (check) a package defined by the current variable definition
 (@pxref{Invoking guix lint}) (@code{guix-devel-lint-package}).
diff --git a/emacs/guix-devel.el b/emacs/guix-devel.el
index 547044f8af..b8330289c5 100644
--- a/emacs/guix-devel.el
+++ b/emacs/guix-devel.el
@@ -122,6 +122,21 @@ run BODY."
                                       guix-use-substitutes)
                 "#:dry-run?" (guix-guile-boolean guix-dry-run)))))))
 
+(defun guix-devel-build-package-source ()
+  "Build the source of the current package definition."
+  (interactive)
+  (guix-devel-with-definition def
+    (when (or (not guix-operation-confirm)
+              (guix-operation-prompt
+               (format "Build '%s' package source?" def)))
+      (guix-geiser-eval-in-repl
+       (concat ",run-in-store "
+               (guix-guile-make-call-expression
+                "build-package-source" def
+                "#:use-substitutes?" (guix-guile-boolean
+                                      guix-use-substitutes)
+                "#:dry-run?" (guix-guile-boolean guix-dry-run)))))))
+
 (defun guix-devel-lint-package ()
   "Check the current package.
 See Info node `(guix) Invoking guix lint' for details."
@@ -177,6 +192,7 @@ to find 'modify-phases' keywords."
 (defvar guix-devel-keys-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "b") 'guix-devel-build-package-definition)
+    (define-key map (kbd "s") 'guix-devel-build-package-source)
     (define-key map (kbd "l") 'guix-devel-lint-package)
     (define-key map (kbd "k") 'guix-devel-copy-module-as-kill)
     (define-key map (kbd "u") 'guix-devel-use-module)
diff --git a/guix/scripts.scm b/guix/scripts.scm
index e34d38904c..d84375f570 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -31,7 +31,8 @@
   #:export (args-fold*
             parse-command-line
             maybe-build
-            build-package))
+            build-package
+            build-package-source))
 
 ;;; Commentary:
 ;;;
@@ -115,4 +116,21 @@ Show what and how will/would be built."
                      #:dry-run? dry-run?)
         (return (show-derivation-outputs derivation))))))
 
+(define* (build-package-source package
+                               #:key dry-run? (use-substitutes? #t)
+                               #:allow-other-keys
+                               #:rest build-options)
+  "Build PACKAGE source using BUILD-OPTIONS."
+  (mbegin %store-monad
+    (apply set-build-options*
+           #:use-substitutes? use-substitutes?
+           (strip-keyword-arguments '(#:dry-run?) build-options))
+    (mlet %store-monad ((derivation (origin->derivation
+                                     (package-source package))))
+      (mbegin %store-monad
+        (maybe-build (list derivation)
+                     #:use-substitutes? use-substitutes?
+                     #:dry-run? dry-run?)
+        (return (show-derivation-outputs derivation))))))
+
 ;;; scripts.scm ends here