Re: [PATCH 3/3] emacs: Add "Source" field to 'guix-info' buffers.

[Alex Kost <alezost@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 3578 bytes --]

Ludovic Courtès (2014-11-10 01:43 +0300) wrote:

> Alex Kost <alezost@gmail.com> skribis:

[...]

>> Also what if I want to define whether there is a source in the store or
>> not?  (And I don't want to download it if it's not there.)
>
> I don’t think it’s natural for a user to think in terms of downloads.
> Personally, when I want to see the source of a package, I do:
>
>   tar xf $(guix build -S foo)

I think later we can provide some variable to choose if pushing a
"source file" button will open a tarball in a ‘tar-mode’ (a usual
'find-file' way) or will untar it in “/tmp” or something.

> and that’s it.  If it’s taking too long or something, I can still hit
> C-c.  But typically, I don’t ask myself “is this already in the store?”.

I typically ask myself this question :-)

>> With your variant of a single “View source” button it would not be
>> possible, as the source that doesn't exist in the store will be
>> downloaded unconditionally.
>
> Rather: the result of ‘package-source-derivation’ would be built
> unconditionally; that entails a download if and only if the source is
> not already in the store, otherwise nothing happens (which you probably
> already know, but I just want to be clear.)

Yes, I know, I meant that with your variant it's not possible to know if
you already have a source in the store or not: whenever you push “View
source” you will eventually have it there.

>>> With the interface you propose, things might be slightly confusing:
>>> sometimes clicking on “Download” will do nothing (because the source is
>>> already there), sometime “Show” will work without “Download”, sometimes
>>> not, etc.  Also it takes up quite a bit of space.
>>
>> Sorry, I didn't get it.  What space do you mean?
>
> I meant visual space in the user interface; visual clutter.

Is that "too much information is bad"?  Do you suggest to remove
something?

>> Pushing a “Download” button will always do something: it will run some
>> command in a REPL and will always display a store path in the end.  And
>> «Hey, USER, what did you expect from a “Download” button if the source
>> is already downloaded?»
>
> Right, but we don’t need the user’s mind to carry part of the store’s
> state: there’s already a database for that.  :-)

OK.

>> But if you find it confusing what about the following variant: initially
>> there will be only “Show” button and when you press it, “Download”
>> button appears only if the source does not exist in the store.  After
>> a successful downloading, it disappears again.
>
> That would work, yes.
>
> But note that derivation outputs not obtained by a ‘build-derivations’
> call with the current store connection may be garbage-collected anytime.
> That makes it more difficult to reliably determine whether the
> “Download” button should be displayed; to be safe, it would have to be
> displayed by default.  Then we’re very close to the current patch, I
> think, no?

I just check whether a final source file exists in the store and that's
all.  I think it's reliable, isn't it?

> If that’s fine with you, perhaps let’s just commit the patch as is, and
> see in another patch whether “Download” can be made to disappear in safe
> cases?

I modified the patch (attached) to display “Show” and “Download” buttons
only when needed.  WDYT?

The patch may be applied to the current head (I have pushed a couple of
auxiliary commits).


[-- Attachment #2: 0001-emacs-Add-Source-field-to-guix-info-buffers.patch --]
[-- Type: text/x-diff, Size: 13593 bytes --]

From 71f8210da8f6d8524fd1d89b5a0cde5fcce1a25e Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Sun, 9 Nov 2014 11:03:39 +0300
Subject: [PATCH] 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-find-source-p, guix-package-info-download-buffer): New
  variables.
  (guix-package-info-show-source, guix-package-info-insert-source,
  guix-package-info-insert-source-url,
  guix-package-info-redisplay-after-download): New procedures.
* emacs/guix-base.el (guix-param-titles): Add 'source' parameter.
  (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-base.el  |  24 +++++++++++
 emacs/guix-info.el  | 115 +++++++++++++++++++++++++++++++++++++++++++++++++---
 emacs/guix-main.scm |  49 ++++++++++++++++++++++
 3 files changed, 183 insertions(+), 5 deletions(-)

diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index a6e56dc..10d6909 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -82,6 +82,7 @@ Interactively, prompt for PATH.  With prefix, use
      (id                . "ID")
      (name              . "Name")
      (version           . "Version")
+     (source            . "Source")
      (license           . "License")
      (synopsis          . "Synopsis")
      (description       . "Description")
@@ -100,6 +101,7 @@ Interactively, prompt for PATH.  With prefix, use
      (id                . "ID")
      (name              . "Name")
      (version           . "Version")
+     (source            . "Source")
      (license           . "License")
      (synopsis          . "Synopsis")
      (description       . "Description")
@@ -1035,6 +1037,28 @@ Each element from GENERATIONS is a generation number."
       'switch-to-generation profile generation)
      operation-buffer)))
 
+(defun guix-package-source-path (package-id)
+  "Return a store file path to a source of a package PACKAGE-ID."
+  (message "Calculating the source derivation ...")
+  (guix-eval-read
+   (guix-make-guile-expression
+    'package-source-path package-id)))
+
+(defvar guix-after-source-download-hook nil
+  "Hook run after successful performing a 'source-download' operation.")
+
+(defun guix-package-source-build-derivation (package-id)
+  "Build source derivation of a package PACKAGE-ID."
+  (when (or (not guix-operation-confirm)
+            (guix-operation-prompt))
+    (guix-eval-in-repl
+     (guix-make-guile-expression
+      'package-source-build-derivation
+      package-id
+      :use-substitutes? (or guix-use-substitutes 'f)
+      :dry-run? (or guix-dry-run 'f))
+     nil 'source-download)))
+
 \f
 ;;; Pull
 
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index 70ae39c..9583b5e 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -1,4 +1,4 @@
-;;; guix-info.el --- Info buffers for displaying entries
+;;; guix-info.el --- Info buffers for displaying entries   -*- lexical-binding: t -*-
 
 ;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 
@@ -24,7 +24,6 @@
 
 ;;; Code:
 
-(require 'guix-history)
 (require 'guix-base)
 (require 'guix-utils)
 
@@ -107,6 +106,8 @@ number of characters, it will be split into several lines.")
                         guix-info-insert-title-simple)
      (outputs           guix-package-info-insert-outputs
                         guix-info-insert-title-simple)
+     (source            guix-package-info-insert-source
+                        guix-info-insert-title-simple)
      (home-url          guix-info-insert-url)
      (inputs            guix-package-info-insert-inputs)
      (native-inputs     guix-package-info-insert-native-inputs)
@@ -121,6 +122,8 @@ number of characters, it will be split into several lines.")
      (name              guix-package-info-name)
      (version           guix-output-info-insert-version)
      (output            guix-output-info-insert-output)
+     (source            guix-package-info-insert-source
+                        guix-info-insert-title-simple)
      (path              guix-package-info-insert-output-path
                         guix-info-insert-title-simple)
      (dependencies      guix-package-info-insert-output-dependencies
@@ -157,10 +160,11 @@ is a function, this function is called with parameter title as
 argument.")
 
 (defvar guix-info-displayed-params
-  '((package name version synopsis outputs location home-url
+  '((package name version synopsis outputs source location home-url
              license inputs native-inputs propagated-inputs description)
-    (output name version output synopsis path dependencies location home-url
-            license inputs native-inputs propagated-inputs description)
+    (output name version output synopsis source path dependencies location
+            home-url license inputs native-inputs propagated-inputs
+            description)
     (installed path dependencies)
     (generation number prev-number current time path))
   "List of displayed entry parameters.
@@ -652,6 +656,107 @@ ENTRY is an alist with package info."
   'guix-package-info-insert-output-path)
 
 \f
+;;; Inserting a source
+
+(defface guix-package-info-source
+  '((t :inherit link :underline nil))
+  "Face used for a source URL of a package."
+  :group 'guix-package-info)
+
+(defcustom guix-package-info-find-source-p nil
+  "If non-nil, find a source file after pressing \"Show\" button.
+If nil, just display the source file path without finding."
+  :type 'boolean
+  :group 'guix-package-info)
+
+(defvar guix-package-info-download-buffer nil
+  "Buffer from which a current download operation was performed.")
+
+(define-button-type 'guix-package-source
+  :supertype 'guix
+  'face 'guix-package-info-source
+  'help-echo ""
+  'action (lambda (_)
+            ;; As a source may not be a real URL (e.g., "mirror://..."),
+            ;; no action is bound to a source button.
+            (message "Yes, this is the source URL.  What did you expect?")))
+
+(defun guix-package-info-insert-source-url (url &optional _)
+  "Make button from source URL and insert it at point."
+  (guix-insert-button url 'guix-package-source))
+
+(defun guix-package-info-show-source (entry-id package-id)
+  "Show file name of a package source in the current info buffer.
+Find the file if needed (see `guix-package-info-find-source-p').
+ENTRY-ID is an ID of the current entry (package or output).
+PACKAGE-ID is an ID of the package which source to show."
+  (let* ((entry (guix-get-entry-by-id entry-id guix-entries))
+         (file  (guix-get-key-val entry 'source-file)))
+    ;; Do not request a source file name if it has already been received.
+    (unless file
+      (setq file (guix-package-source-path package-id))
+      (or file
+          (error "Couldn't define file path of the package source"))
+      (let* ((new-entry (cons (cons 'source-file file)
+                              entry))
+             (entries (cl-substitute-if
+                       new-entry
+                       (lambda (entry)
+                         (equal (guix-get-key-val entry 'id)
+                                entry-id))
+                       guix-entries
+                       :count 1)))
+        (guix-redisplay-buffer :entries entries)))
+    (if (file-exists-p file)
+        (if guix-package-info-find-source-p
+            (guix-find-file file)
+          (message "The source store path is displayed."))
+      (message "The source does not exist in the store."))))
+
+(defun guix-package-info-insert-source (source entry)
+  "Insert SOURCE from package ENTRY at point.
+SOURCE is a list of URLs."
+  (guix-info-insert-indent)
+  (if (null source)
+      (guix-format-insert nil)
+    (let* ((source-file (guix-get-key-val entry 'source-file))
+           (entry-id    (guix-get-key-val entry 'id))
+           (package-id  (or (guix-get-key-val entry 'package-id)
+                            entry-id)))
+      (if (null source-file)
+          (guix-info-insert-action-button
+           "Show"
+           (lambda (btn)
+             (guix-package-info-show-source (button-get btn 'entry-id)
+                                            (button-get btn 'package-id)))
+           "Show the source store path of the current package"
+           'entry-id entry-id
+           'package-id package-id)
+        (unless (file-exists-p source-file)
+          (guix-info-insert-action-button
+           "Download"
+           (lambda (btn)
+             (setq guix-package-info-download-buffer (current-buffer))
+             (guix-package-source-build-derivation
+              (button-get btn 'package-id)))
+           "Download the source into the store"
+           'package-id package-id))
+        (guix-info-insert-val-simple source-file
+                                     #'guix-info-insert-file-path))
+      (guix-info-insert-val-simple source
+                                   #'guix-package-info-insert-source-url))))
+
+(defun guix-package-info-redisplay-after-download ()
+  "Redisplay an 'info' buffer after downloading the package source.
+This function is used to hide a \"Download\" button if needed."
+  (when (buffer-live-p guix-package-info-download-buffer)
+    (guix-redisplay-buffer :buffer guix-package-info-download-buffer)
+    (setq guix-package-info-download-buffer nil)))
+
+(add-hook 'guix-after-source-download-hook
+          'guix-package-info-redisplay-after-download)
+
+\f
 ;;; Displaying outputs
 
 (guix-define-buffer-type info output
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 62eeabb..e0bdccb 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 @@ Example:
                      (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 #f)))
+                     (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 @@ Example:
     (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 @@ OUTPUTS is a list of package outputs (may be an empty list)."
 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))))))
-- 
2.1.2