From 0b0fbf0c16a280270c1ce4d716e958d07efbccbd Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Sun, 9 Nov 2014 11:03:39 +0300
Subject: emacs: Add "Source" field to 'guix-info' buffers.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Suggested by Ludovic Courtès.

* emacs/guix-info.el (guix-info-insert-methods, guix-info-displayed-params):
  Add 'source' parameter.
  (guix-package-info-source): New face.
  (guix-package-source): New button type.
  (guix-package-info-auto-find-source, guix-package-info-auto-download-source,
  guix-package-info-download-buffer): New variables.
  (guix-package-info-show-source, guix-package-info-insert-source-url,
  guix-package-info-insert-source, guix-package-info-download-source,
  guix-package-info-redisplay-after-download): New procedures.
* emacs/guix-base.el (guix-param-titles): Add 'source' parameter.
  (guix-operation-prompt): Add 'prompt' argument.
  (guix-after-source-download-hook): New variable.
  (guix-package-source-path, guix-package-source-build-derivation): New
  procedures.
* emacs/guix-main.scm (%package-param-alist): Add 'source' parameter.
  (package-source-names, package-source-derivation->store-path,
  package-source-path, package-source-build-derivation): New procedures.
---
 emacs/guix-main.scm | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)

(limited to 'emacs/guix-main.scm')

diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 62eeabba1e..8ad4dcbdd7 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -46,10 +46,12 @@
  (ice-9 vlist)
  (ice-9 match)
  (srfi srfi-1)
+ (srfi srfi-2)
  (srfi srfi-11)
  (srfi srfi-19)
  (srfi srfi-26)
  (guix)
+ (guix git-download)
  (guix packages)
  (guix profiles)
  (guix licenses)
@@ -252,6 +254,18 @@ (define (package-license-names package)
                      (license-name license)))
               (list-maybe (package-license package))))
 
+(define (package-source-names package)
+  "Return a list of source names (URLs) of the PACKAGE."
+  (let ((source (package-source package)))
+    (and (origin? source)
+         (filter-map (lambda (uri)
+                       (cond ((string? uri)
+                              uri)
+                             ((git-reference? uri)
+                              (git-reference-url uri))
+                             (else "Unknown source type")))
+                     (list-maybe (origin-uri source))))))
+
 (define (package-unique? package)
   "Return #t if PACKAGE is a single package with such name/version."
   (null? (cdr (packages-by-name (package-name package)
@@ -263,6 +277,7 @@ (define %package-param-alist
     (name              . ,package-name)
     (version           . ,package-version)
     (license           . ,package-license-names)
+    (source            . ,package-source-names)
     (synopsis          . ,package-synopsis)
     (description       . ,package-description)
     (home-url          . ,package-home-page)
@@ -867,3 +882,37 @@ (define (delete-generations* profile generations)
 GENERATIONS is a list of generation numbers."
   (with-store store
     (delete-generations store profile generations)))
+
+(define (package-source-derivation->store-path derivation)
+  "Return a store path of the package source DERIVATION."
+  (match (derivation-outputs derivation)
+    ;; Source derivation is always (("out" . derivation)).
+    (((_ . output-drv))
+     (derivation-output-path output-drv))
+    (_ #f)))
+
+(define (package-source-path package-id)
+  "Return a store file path to a source of a package PACKAGE-ID."
+  (and-let* ((package (package-by-id package-id))
+             (source  (package-source package)))
+    (with-store store
+      (package-source-derivation->store-path
+       (package-source-derivation store source)))))
+
+(define* (package-source-build-derivation package-id #:key dry-run?
+                                          (use-substitutes? #t))
+  "Build source derivation of a package PACKAGE-ID."
+  (and-let* ((package (package-by-id package-id))
+             (source  (package-source package)))
+    (with-store store
+      (let* ((derivation  (package-source-derivation store source))
+             (derivations (list derivation)))
+        (set-build-options store
+                           #:use-substitutes? use-substitutes?)
+        (show-what-to-build store derivations
+                            #:use-substitutes? use-substitutes?
+                            #:dry-run? dry-run?)
+        (unless dry-run?
+          (build-derivations store derivations))
+        (format #t "The source store path: ~a~%"
+                (package-source-derivation->store-path derivation))))))
-- 
cgit v1.2.3