Merge branch 'master' into core-updates

34 files changed, 372 insertions, 162 deletions

diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm
index 4daec5eb66..da06cb1358 100644
--- a/guix/build-system/r.scm
+++ b/guix/build-system/r.scm
@@ -28,7 +28,8 @@
   #:use-module (srfi srfi-26)
   #:export (%r-build-system-modules
             r-build
-            r-build-system))
+            r-build-system
+            cran-uri))
 
 ;; Commentary:
 ;;
@@ -36,6 +37,15 @@
 ;;
 ;; Code:
 
+(define (cran-uri name version)
+  "Return a list of URI strings for the R package archive on CRAN for the
+release corresponding to NAME and VERSION.  As only the most recent version is
+available via the first URI, the second URI points to the archived version."
+  (list (string-append "mirror://cran/src/contrib/"
+                       name "_" version ".tar.gz")
+        (string-append "mirror://cran/src/contrib/Archive/"
+                       name "/" name "_" version ".tar.gz")))
+
 (define %r-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build r-build-system)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 6e85174bc9..d362fc1f26 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -36,8 +36,10 @@
             resolve-uri-reference
             maybe-expand-mirrors
             url-fetch
+            byte-count->string
             progress-proc
-            uri-abbreviation))
+            uri-abbreviation
+            store-path-abbreviation))
 
 ;;; Commentary:
 ;;;
@@ -49,6 +51,11 @@
   ;; Size of the HTTP receive buffer.
   65536)
 
+(define (nearest-exact-integer x)
+  "Given a real number X, return the nearest exact integer, with ties going to
+the nearest exact even integer."
+  (inexact->exact (round x)))
+
 (define (duration->seconds duration)
   "Return the number of seconds represented by DURATION, a 'time-duration'
 object, as an inexact number."
@@ -56,16 +63,17 @@ object, as an inexact number."
      (/ (time-nanosecond duration) 1e9)))
 
 (define (seconds->string duration)
-  "Given DURATION in seconds, return a string representing it in 'hh:mm:ss'
-format."
+  "Given DURATION in seconds, return a string representing it in 'mm:ss' or
+'hh:mm:ss' format, as needed."
   (if (not (number? duration))
-      "00:00:00"
-      (let* ((total-seconds (inexact->exact (round duration)))
+      "00:00"
+      (let* ((total-seconds (nearest-exact-integer duration))
              (extra-seconds (modulo total-seconds 3600))
-             (hours         (quotient total-seconds 3600))
+             (num-hours     (quotient total-seconds 3600))
+             (hours         (and (positive? num-hours) num-hours))
              (mins          (quotient extra-seconds 60))
              (secs          (modulo extra-seconds 60)))
-        (format #f "~2,'0d:~2,'0d:~2,'0d" hours mins secs))))
+        (format #f "~@[~2,'0d:~]~2,'0d:~2,'0d" hours mins secs))))
 
 (define (byte-count->string size)
   "Given SIZE in bytes, return a string representing it in a human-readable
@@ -75,8 +83,8 @@ way."
         (GiB (expt 1024. 3))
         (TiB (expt 1024. 4)))
     (cond
-     ((< size KiB) (format #f "~dB" (inexact->exact size)))
-     ((< size MiB) (format #f "~dKiB" (inexact->exact (round (/ size KiB)))))
+     ((< size KiB) (format #f "~dB"     (nearest-exact-integer size)))
+     ((< size MiB) (format #f "~dKiB"   (nearest-exact-integer (/ size KiB))))
      ((< size GiB) (format #f "~,1fMiB" (/ size MiB)))
      ((< size TiB) (format #f "~,2fGiB" (/ size GiB)))
      (else         (format #f "~,3fTiB" (/ size TiB))))))
@@ -91,10 +99,33 @@ width of the bar is BAR-WIDTH."
             (make-string filled #\#)
             (make-string empty #\space))))
 
-(define* (progress-proc file size #:optional (log-port (current-output-port)))
+(define (string-pad-middle left right len)
+  "Combine LEFT and RIGHT with enough padding in the middle so that the
+resulting string has length at least LEN.  This right justifies RIGHT."
+  (string-append left
+                 (string-pad right (max 0 (- len (string-length left))))))
+
+(define (store-url-abbreviation url)
+  "Return a friendlier version of URL for display."
+  (let ((store-path (string-append (%store-directory) "/" (basename url))))
+    ;; Take advantage of the implementation for store paths.
+    (store-path-abbreviation store-path)))
+
+(define* (store-path-abbreviation store-path #:optional (prefix-length 6))
+  "Return an abbreviation of STORE-PATH for display, showing PREFIX-LENGTH
+characters of the hash."
+  (let ((base (basename store-path)))
+    (string-append (string-take base prefix-length)
+                   "…"
+                   (string-drop base 32))))
+
+(define* (progress-proc file size
+                        #:optional (log-port (current-output-port))
+                        #:key (abbreviation identity))
   "Return a procedure to show the progress of FILE's download, which is SIZE
 bytes long.  The returned procedure is suitable for use as an argument to
-`dump-port'.  The progress report is written to LOG-PORT."
+`dump-port'.  The progress report is written to LOG-PORT, with ABBREVIATION
+used to shorten FILE for display."
   ;; XXX: Because of <http://bugs.gnu.org/19939> this procedure is often not
   ;; called as frequently as we'd like too; this is especially bad with Nginx
   ;; on hydra.gnu.org, which returns whole nars as a single chunk.
@@ -118,31 +149,31 @@ bytes long.  The returned procedure is suitable for use as an argument to
                                      (/ transferred elapsed)
                                      0))
                      (left       (format #f " ~a  ~a"
-                                         (basename file)
+                                         (abbreviation file)
                                          (byte-count->string size)))
                      (right      (format #f "~a/s ~a ~a~6,1f%"
                                          (byte-count->string throughput)
                                          (seconds->string elapsed)
-                                         (progress-bar %) %))
-                     ;; TODO: Make this adapt to the actual terminal width.
-                     (cols       80)
-                     (num-spaces (max 1 (- cols (+ (string-length left)
-                                                   (string-length right)))))
-                     (gap        (make-string num-spaces #\space)))
-                (format log-port "~a~a~a" left gap right)
+                                         (progress-bar %) %)))
+                ;; TODO: Make this adapt to the actual terminal width.
+                (display (string-pad-middle left right 80) log-port)
                 (display #\cr log-port)
                 (flush-output-port log-port)
                 (cont))))
           (lambda (transferred cont)
             (with-elapsed-time elapsed
-              (let ((throughput (if elapsed
-                                    (/ transferred elapsed)
-                                    0)))
+              (let* ((throughput (if elapsed
+                                     (/ transferred elapsed)
+                                     0))
+                     (left       (format #f " ~a"
+                                         (abbreviation file)))
+                     (right      (format #f "~a/s ~a | ~a transferred"
+                                         (byte-count->string throughput)
+                                         (seconds->string elapsed)
+                                         (byte-count->string transferred))))
+                ;; TODO: Make this adapt to the actual terminal width.
+                (display (string-pad-middle left right 80) log-port)
                 (display #\cr log-port)
-                (format log-port "~a\t~a transferred (~a/s)"
-                        file
-                        (byte-count->string transferred)
-                        (byte-count->string throughput))
                 (flush-output-port log-port)
                 (cont))))))))
 
diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm
index 4184ccc9ac..2685da1a72 100644
--- a/guix/build/ruby-build-system.scm
+++ b/guix/build/ruby-build-system.scm
@@ -41,53 +41,63 @@ directory."
     ((file-name . _) file-name)
     (() (error "No files matching pattern: " pattern))))
 
+(define gnu:unpack (assq-ref gnu:%standard-phases 'unpack))
+
+(define (gem-archive? file-name)
+  (string-match "^.*\\.gem$" file-name))
+
 (define* (unpack #:key source #:allow-other-keys)
   "Unpack the gem SOURCE and enter the resulting directory."
-  (and (zero? (system* "gem" "unpack" source))
-       ;; The unpacked gem directory is named the same as the archive, sans
-       ;; the ".gem" extension.  It is renamed to simply "gem" in an effort to
-       ;; keep file names shorter to avoid UNIX-domain socket file names and
-       ;; shebangs that exceed the system's fixed maximum length when running
-       ;; test suites.
-       (let ((dir (match:substring (string-match "^(.*)\\.gem$"
-                                                 (basename source))
-                                   1)))
-         (rename-file dir "gem")
-         (chdir "gem")
-         #t)))
+  (if (gem-archive? source)
+      (and (zero? (system* "gem" "unpack" source))
+           ;; The unpacked gem directory is named the same as the archive,
+           ;; sans the ".gem" extension.  It is renamed to simply "gem" in an
+           ;; effort to keep file names shorter to avoid UNIX-domain socket
+           ;; file names and shebangs that exceed the system's fixed maximum
+           ;; length when running test suites.
+           (let ((dir (match:substring (string-match "^(.*)\\.gem$"
+                                                     (basename source))
+                                       1)))
+             (rename-file dir "gem")
+             (chdir "gem")
+             #t))
+      ;; Use GNU unpack strategy for things that aren't gem archives.
+      (gnu:unpack #:source source)))
 
 (define* (build #:key source #:allow-other-keys)
   "Build a new gem using the gemspec from the SOURCE gem."
+  (define (first-gemspec)
+    (first-matching-file "\\.gemspec$"))
 
   ;; Remove the original gemspec, if present, and replace it with a new one.
   ;; This avoids issues with upstream gemspecs requiring tools such as git to
   ;; generate the files list.
-  (let ((gemspec (or (false-if-exception
-                      (first-matching-file "\\.gemspec$"))
-                     ;; Make new gemspec if one wasn't shipped.
-                     ".gemspec")))
-
-    (when (file-exists? gemspec) (delete-file gemspec))
-
-    ;; Extract gemspec from source gem.
-    (let ((pipe (open-pipe* OPEN_READ "gem" "spec" "--ruby" source)))
-      (dynamic-wind
-        (const #t)
-        (lambda ()
-          (call-with-output-file gemspec
-            (lambda (out)
-              ;; 'gem spec' writes to stdout, but 'gem build' only reads
-              ;; gemspecs from a file, so we redirect the output to a file.
-              (while (not (eof-object? (peek-char pipe)))
-                (write-char (read-char pipe) out))))
-          #t)
-        (lambda ()
-          (close-pipe pipe))))
-
-    ;; Build a new gem from the current working directory.  This also allows any
-    ;; dynamic patching done in previous phases to be present in the installed
-    ;; gem.
-    (zero? (system* "gem" "build" gemspec))))
+  (when (gem-archive? source)
+    (let ((gemspec (or (false-if-exception (first-gemspec))
+                       ;; Make new gemspec if one wasn't shipped.
+                       ".gemspec")))
+
+      (when (file-exists? gemspec) (delete-file gemspec))
+
+      ;; Extract gemspec from source gem.
+      (let ((pipe (open-pipe* OPEN_READ "gem" "spec" "--ruby" source)))
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (call-with-output-file gemspec
+              (lambda (out)
+                ;; 'gem spec' writes to stdout, but 'gem build' only reads
+                ;; gemspecs from a file, so we redirect the output to a file.
+                (while (not (eof-object? (peek-char pipe)))
+                  (write-char (read-char pipe) out))))
+            #t)
+          (lambda ()
+            (close-pipe pipe))))))
+
+  ;; Build a new gem from the current working directory.  This also allows any
+  ;; dynamic patching done in previous phases to be present in the installed
+  ;; gem.
+  (zero? (system* "gem" "build" (first-gemspec))))
 
 (define* (check #:key tests? test-target #:allow-other-keys)
   "Run the gem's test suite rake task TEST-TARGET.  Skip the tests if TESTS?
diff --git a/guix/download.scm b/guix/download.scm
index 42956772f5..204cfc0826 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -167,9 +167,9 @@
       (cran
        ;; Arbitrary mirrors from http://cran.r-project.org/mirrors.html
        ;; This one automatically redirects to servers worldwide
+       "http://cran.r-project.org/"
        "http://cran.rstudio.com/"
        "http://cran.univ-lyon1.fr/"
-       "http://cran.r-mirror.de/"
        "http://cran.ism.ac.jp/"
        "http://cran.stat.auckland.ac.nz/"
        "http://cran.mirror.ac.za/"
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 8ed5e5407f..585cb9fec2 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -165,7 +165,7 @@ representation of the package page."
         (version ,version)
         (source (origin
                   (method url-fetch)
-                  (uri (string-append ,@(factorize-uri source-url version)))
+                  (uri (cran-uri ,name version))
                   (sha256
                    (base32
                     ,(bytevector->nix-base32-string (file-sha256 tarball))))))
diff --git a/guix/licenses.scm b/guix/licenses.scm
index c3b76af9b9..7e05b32993 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -61,6 +61,7 @@
             sleepycat
             vim
             x11 x11-style
+            zpl2.1
             zlib
             fsf-free))
 
@@ -382,6 +383,11 @@ which may be a file:// URI pointing the package's tree."
             "Check the URI for details.  "
             comment)))
 
+(define zpl2.1
+  (license "Zope Public License 2.1"
+           "http://directory.fsf.org/wiki?title=License:ZopePLv2.1"
+           "https://www.gnu.org/licenses/license-list.html#Zope2.0"))
+
 (define zlib
   (license "Zlib"
            "http://www.gzip.org/zlib/zlib_license.html"
diff --git a/guix/packages.scm b/guix/packages.scm
index 49c6b44884..72822b8c97 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -37,6 +37,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (web uri)
   #:re-export (%current-system
                %current-target-system
                search-path-specification)         ;for convenience
@@ -46,6 +47,7 @@
             origin-method
             origin-sha256
             origin-file-name
+            origin-actual-file-name
             origin-patches
             origin-patch-flags
             origin-patch-inputs
@@ -189,6 +191,26 @@ representation."
       ((_ str)
        #'(nix-base32-string->bytevector str)))))
 
+(define (origin-actual-file-name origin)
+  "Return the file name of ORIGIN, either its 'file-name' field or the file
+name of its URI."
+  (define (uri->file-name uri)
+    ;; Return the 'base name' of URI or URI itself, where URI is a string.
+    (let ((path (and=> (string->uri uri) uri-path)))
+      (if path
+          (basename path)
+          uri)))
+
+  (or (origin-file-name origin)
+      (match (origin-uri origin)
+        ((head . tail)
+         (uri->file-name head))
+        ((? string? uri)
+         (uri->file-name uri))
+        (else
+         ;; git, svn, cvs, etc. reference
+         #f))))
+
 (define %supported-systems
   ;; This is the list of system types that are supported.  By default, we
   ;; expect all packages to build successfully here.
diff --git a/guix/scripts.scm b/guix/scripts.scm
new file mode 100644
index 0000000000..e34d38904c
--- /dev/null
+++ b/guix/scripts.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
+;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts)
+  #:use-module (guix utils)
+  #:use-module (guix ui)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:export (args-fold*
+            parse-command-line
+            maybe-build
+            build-package))
+
+;;; Commentary:
+;;;
+;;; General code for Guix scripts.
+;;;
+;;; Code:
+
+(define (args-fold* options unrecognized-option-proc operand-proc . seeds)
+  "A wrapper on top of `args-fold' that does proper user-facing error
+reporting."
+  (catch 'misc-error
+    (lambda ()
+      (apply args-fold options unrecognized-option-proc
+             operand-proc seeds))
+    (lambda (key proc msg args . rest)
+      ;; XXX: MSG is not i18n'd.
+      (leave (_ "invalid argument: ~a~%")
+             (apply format #f msg args)))))
+
+(define (environment-build-options)
+  "Return additional build options passed as environment variables."
+  (arguments-from-environment-variable "GUIX_BUILD_OPTIONS"))
+
+(define %default-argument-handler
+  ;; The default handler for non-option command-line arguments.
+  (lambda (arg result)
+    (alist-cons 'argument arg result)))
+
+(define* (parse-command-line args options seeds
+                             #:key
+                             (argument-handler %default-argument-handler))
+  "Parse the command-line arguments ARGS as well as arguments passed via the
+'GUIX_BUILD_OPTIONS' environment variable according to OPTIONS (a list of
+SRFI-37 options) and return the result, seeded by SEEDS.
+Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'.
+
+ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc'
+parameter of 'args-fold'."
+  (define (parse-options-from args seeds)
+    ;; Actual parsing takes place here.
+    (apply args-fold* args options
+           (lambda (opt name arg . rest)
+             (leave (_ "~A: unrecognized option~%") name))
+           argument-handler
+           seeds))
+
+  (call-with-values
+      (lambda ()
+        (parse-options-from (environment-build-options) seeds))
+    (lambda seeds
+      ;; ARGS take precedence over what the environment variable specifies.
+      (parse-options-from args seeds))))
+
+(define* (maybe-build drvs
+                      #:key dry-run? use-substitutes?)
+  "Show what will/would be built, and actually build DRVS, unless DRY-RUN? is
+true."
+  (with-monad %store-monad
+    (>>= (show-what-to-build* drvs
+                              #:dry-run? dry-run?
+                              #:use-substitutes? use-substitutes?)
+         (lambda (_)
+           (if dry-run?
+               (return #f)
+               (built-derivations drvs))))))
+
+(define* (build-package package
+                        #:key dry-run? (use-substitutes? #t)
+                        #:allow-other-keys
+                        #:rest build-options)
+  "Build PACKAGE using BUILD-OPTIONS acceptable by 'set-build-options'.
+Show what and how will/would be built."
+  (mbegin %store-monad
+    (apply set-build-options*
+           #:use-substitutes? use-substitutes?
+           (strip-keyword-arguments '(#:dry-run?) build-options))
+    (mlet %store-monad ((derivation (package->derivation 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
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index ab2fc46c31..b120c555e3 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -27,6 +27,7 @@
   #:use-module (guix ui)
   #:use-module (guix pki)
   #:use-module (guix pk-crypto)
+  #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index ab2a39b1f8..a357cf8aa4 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -19,6 +19,7 @@
 
 (define-module (guix scripts build)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix packages)
@@ -537,14 +538,7 @@ arguments with packages that use the specified source."
                          roots))
               ((not (assoc-ref opts 'dry-run?))
                (and (build-derivations store drv)
-                    (for-each (lambda (d)
-                                (format #t "~{~a~%~}"
-                                        (map (match-lambda
-                                              ((out-name . out)
-                                               (derivation->output-path
-                                                d out-name)))
-                                             (derivation-outputs d))))
-                              drv)
+                    (for-each show-derivation-outputs drv)
                     (for-each (cut register-root store <> <>)
                               (map (lambda (drv)
                                      (map cdr
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 87b420405c..533970ffbb 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts download)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (guix hash)
   #:use-module (guix utils)
diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm
index fc453ac38d..30146af10b 100644
--- a/guix/scripts/edit.scm
+++ b/guix/scripts/edit.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts edit)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix utils)
   #:use-module (guix packages)
   #:use-module (gnu packages)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index ecdbc7aa37..7aa52e8a8a 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -27,6 +27,7 @@
   #:use-module (guix utils)
   #:use-module (guix monads)
   #:use-module ((guix gexp) #:select (lower-inputs))
+  #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (gnu packages)
   #:use-module (ice-9 format)
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 6403893687..7e06c72ccb 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts gc)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 2b671be131..725ae42030 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts graph)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix utils)
   #:use-module (guix packages)
   #:use-module (guix monads)
@@ -33,7 +34,6 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
-  #:use-module (web uri)
   #:export (%package-node-type
             %bag-node-type
             %bag-emerged-node-type
@@ -78,25 +78,13 @@
 ;;; Package DAG.
 ;;;
 
-(define (uri->file-name uri)
-  "Return the 'base name' of URI or URI itself, where URI is a string."
-  (let ((path (and=> (string->uri uri) uri-path)))
-    (if path
-        (basename path)
-        uri)))
-
 (define (node-full-name thing)
   "Return a human-readable name to denote THING, a package, origin, or file
 name."
   (cond ((package? thing)
          (package-full-name thing))
         ((origin? thing)
-         (or (origin-file-name thing)
-             (match (origin-uri thing)
-               ((head . tail)
-                (uri->file-name head))
-               ((? string? uri)
-                (uri->file-name uri)))))
+         (origin-actual-file-name thing))
         ((string? thing)                          ;file name
          (or (basename thing)
              (error "basename" thing)))
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index e2305d73ee..d44095377b 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -22,6 +22,7 @@
   #:use-module (guix hash)
   #:use-module (guix serialization)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix utils)
   #:use-module (rnrs io ports)
   #:use-module (rnrs files)
diff --git a/guix/scripts/import/cpan.scm b/guix/scripts/import/cpan.scm
index 1f4dedf23f..3d470f684d 100644
--- a/guix/scripts/import/cpan.scm
+++ b/guix/scripts/import/cpan.scm
@@ -19,6 +19,7 @@
 (define-module (guix scripts import cpan)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix scripts)
   #:use-module (guix import cpan)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm
index f11fa1004f..8d001ac494 100644
--- a/guix/scripts/import/cran.scm
+++ b/guix/scripts/import/cran.scm
@@ -20,6 +20,7 @@
 (define-module (guix scripts import cran)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix scripts)
   #:use-module (guix import cran)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm
index c72aaf0760..b22a7c4c23 100644
--- a/guix/scripts/import/elpa.scm
+++ b/guix/scripts/import/elpa.scm
@@ -19,6 +19,7 @@
 (define-module (guix scripts import elpa)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix scripts)
   #:use-module (guix import elpa)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm
index 9f8094feac..a5dd2a7822 100644
--- a/guix/scripts/import/gem.scm
+++ b/guix/scripts/import/gem.scm
@@ -19,6 +19,7 @@
 (define-module (guix scripts import gem)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix scripts)
   #:use-module (guix import gem)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
diff --git a/guix/scripts/import/gnu.scm b/guix/scripts/import/gnu.scm
index 5fac6db516..92bd8305ea 100644
--- a/guix/scripts/import/gnu.scm
+++ b/guix/scripts/import/gnu.scm
@@ -19,6 +19,7 @@
 (define-module (guix scripts import gnu)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix scripts)
   #:use-module (guix import gnu)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm
index 1e33556481..8d31128c47 100644
--- a/guix/scripts/import/hackage.scm
+++ b/guix/scripts/import/hackage.scm
@@ -19,6 +19,7 @@
 (define-module (guix scripts import hackage)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix scripts)
   #:use-module (guix import hackage)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
@@ -47,7 +48,7 @@ package will be generated.  If no version suffix is pecified, then the
 generated package definition will correspond to the latest available
 version.\n"))
   (display (_ "
-  -e ALIST, --cabal-environment=ALIST   
+  -e ALIST, --cabal-environment=ALIST
                                specify environment for Cabal evaluation"))
   (display (_ "
   -h, --help                   display this help and exit"))
diff --git a/guix/scripts/import/nix.scm b/guix/scripts/import/nix.scm
index 2dc2677c54..dba053b313 100644
--- a/guix/scripts/import/nix.scm
+++ b/guix/scripts/import/nix.scm
@@ -20,6 +20,7 @@
 (define-module (guix scripts import nix)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix scripts)
   #:use-module (guix import snix)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm
index 1e03843840..7166b014eb 100644
--- a/guix/scripts/import/pypi.scm
+++ b/guix/scripts/import/pypi.scm
@@ -19,6 +19,7 @@
 (define-module (guix scripts import pypi)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix scripts)
   #:use-module (guix import pypi)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 2a618c9451..8224f540bb 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -1,7 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
-;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,7 @@
   #:use-module (guix records)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix scripts)
   #:use-module (guix gnu-maintenance)
   #:use-module (guix monads)
   #:use-module (gnu packages)
@@ -57,6 +59,7 @@
             check-derivation
             check-home-page
             check-source
+            check-source-file-name
             check-license
             check-formatting
 
@@ -140,6 +143,13 @@ monad."
                     (_ "description should not be empty")
                     'description)))
 
+  (define (check-texinfo-markup package)
+    "Check that PACKAGE description can be parsed as a Texinfo fragment."
+    (catch 'parser-error
+      (lambda () (package-description-string package))
+      (lambda (keys . args)
+        (emit-warning package (_ "Texinfo markup in description is invalid")))))
+
   (define (check-proper-start description)
     (unless (or (properly-starts-sentence? description)
                 (string-prefix-ci? (package-name package) description))
@@ -169,6 +179,7 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
   (let ((description (package-description package)))
     (when (string? description)
       (check-not-empty description)
+      (check-texinfo-markup package)
       (check-proper-start description)
       (check-end-of-sentence-space description))))
 
@@ -501,6 +512,26 @@ descriptions maintained upstream."
                           (display warning (guix-warning-port)))
                         (reverse warnings)))))))))
 
+(define (check-source-file-name package)
+  "Emit a warning if PACKAGE's origin has no meaningful file name."
+  (define (origin-file-name-valid? origin)
+    ;; Return #t if the source file name contains only a version or is #f;
+    ;; indicates that the origin needs a 'file-name' field.
+    (let ((file-name (origin-actual-file-name origin))
+          (version (package-version package)))
+      (and file-name
+           (not (or (string-prefix? version file-name)
+                    ;; Common in many projects is for the filename to start
+                    ;; with a "v" followed by the version,
+                    ;; e.g. "v3.2.0.tar.gz".
+                    (string-prefix? (string-append "v" version) file-name))))))
+
+  (let ((origin (package-source package)))
+    (unless (or (not origin) (origin-file-name-valid? origin))
+      (emit-warning package
+                    (_ "the source file name should contain the package name")
+                    'source))))
+
 (define (check-derivation package)
   "Emit a warning if we fail to compile PACKAGE to a derivation."
   (catch #t
@@ -563,12 +594,25 @@ descriptions maintained upstream."
                   (format #f (_ "line ~a is way too long (~a characters)")
                           line-number (string-length line)))))
 
+(define %hanging-paren-rx
+  (make-regexp "^[[:blank:]]*[()]+[[:blank:]]*$"))
+
+(define (report-lone-parentheses package line line-number)
+  "Emit a warning if LINE contains hanging parentheses."
+  (when (regexp-exec %hanging-paren-rx line)
+    (emit-warning package
+                  (format #f
+                          (_ "line ~a: parentheses feel lonely, \
+move to the previous or next line")
+                          line-number))))
+
 (define %formatting-reporters
   ;; List of procedures that report formatting issues.  These are not separate
   ;; checkers because they would need to re-read the file.
   (list report-tabulations
         report-trailing-white-space
-        report-long-line))
+        report-long-line
+        report-lone-parentheses))
 
 (define* (report-formatting-issues package file starting-line
                                    #:key (reporters %formatting-reporters))
@@ -643,6 +687,10 @@ or a list thereof")
      (description "Validate source URLs")
      (check       check-source))
    (lint-checker
+     (name        'source-file-name)
+     (description "Validate file names of sources")
+     (check       check-source-file-name))
+   (lint-checker
      (name        'derivation)
      (description "Report failure to compile a package to a derivation")
      (check       check-derivation))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 23f1597856..e0fe1ddb27 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -29,6 +29,7 @@
   #:use-module (guix monads)
   #:use-module (guix utils)
   #:use-module (guix config)
+  #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module ((guix build utils)
                 #:select (directory-exists? mkdir-p search-path-as-list))
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index cc96355947..e352090d2d 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -45,6 +45,7 @@
   #:use-module (guix store)
   #:use-module (guix serialization)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:export (guix-publish))
 
 (define (show-help)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index e8459e5ffb..56ee9acb18 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts pull)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (guix config)
   #:use-module (guix packages)
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index e7980a97b0..097059e372 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -21,6 +21,7 @@
 (define-module (guix scripts refresh)
   #:use-module (guix ui)
   #:use-module (guix hash)
+  #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix packages)
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index ee070f14b1..44ff92655b 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts size)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module (guix utils)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index e908bc997e..ec8e6244af 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -31,7 +31,8 @@
   #:use-module (guix pki)
   #:use-module ((guix build utils) #:select (mkdir-p dump-port))
   #:use-module ((guix build download)
-                #:select (progress-proc uri-abbreviation))
+                #:select (progress-proc uri-abbreviation
+                          store-path-abbreviation byte-count->string))
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
@@ -337,8 +338,9 @@ or is signed by an unauthorized key."
           (unless %allow-unauthenticated-substitutes?
             (assert-valid-signature narinfo signature hash acl)
             (when verbose?
+              ;; Visually separate substitutions with a newline.
               (format (current-error-port)
-                      "found valid signature for '~a', from '~a'~%"
+                      "~%Found valid signature for ~a~%From ~a~%"
                       (narinfo-path narinfo)
                       (uri->string (narinfo-uri narinfo)))))
           narinfo))))
@@ -753,13 +755,12 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
     ;; Tell the daemon what the expected hash of the Nar itself is.
     (format #t "~a~%" (narinfo-hash narinfo))
 
-    (format (current-error-port) "downloading `~a'~:[~*~; (~,1f MiB installed)~]...~%"
-            store-item
-
+    (format (current-error-port) "Downloading ~a~:[~*~; (~a installed)~]...~%"
+            (store-path-abbreviation store-item)
             ;; Use the Nar size as an estimate of the installed size.
             (narinfo-size narinfo)
             (and=> (narinfo-size narinfo)
-                   (cute / <> (expt 2. 20))))
+                   (cute byte-count->string <>)))
     (let*-values (((raw download-size)
                    ;; Note that Hydra currently generates Nars on the fly
                    ;; and doesn't specify a Content-Length, so
@@ -772,7 +773,9 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
                                              (narinfo-size narinfo))))
                           (progress (progress-proc (uri-abbreviation uri)
                                                    dl-size
-                                                   (current-error-port))))
+                                                   (current-error-port)
+                                                   #:abbreviation
+                                                   store-path-abbreviation)))
                      (progress-report-port progress raw)))
                   ((input pids)
                    (decompressed-port (and=> (narinfo-compression narinfo)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 45f598219d..5e2d226dfe 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -26,6 +26,7 @@
   #:use-module (guix utils)
   #:use-module (guix monads)
   #:use-module (guix profiles)
+  #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (guix build utils)
   #:use-module (gnu build install)
@@ -298,19 +299,6 @@ it atomically, and then run OS's activation script."
     ((disk-image)
      (system-disk-image os #:disk-image-size image-size))))
 
-(define* (maybe-build drvs
-                      #:key dry-run? use-substitutes?)
-  "Show what will/would be built, and actually build DRVS, unless DRY-RUN? is
-true."
-  (with-monad %store-monad
-    (>>= (show-what-to-build* drvs
-                              #:dry-run? dry-run?
-                              #:use-substitutes? use-substitutes?)
-         (lambda (_)
-           (if dry-run?
-               (return #f)
-               (built-derivations drvs))))))
-
 (define* (perform-action action os
                          #:key grub? dry-run?
                          use-substitutes? device target
@@ -514,6 +502,13 @@ Build the operating system declared in FILE according to ACTION.\n"))
         (leave (_ "wrong number of arguments for action '~a'~%")
                action))
 
+      (unless action
+        (format (current-error-port)
+                (_ "guix system: missing command name~%"))
+        (format (current-error-port)
+                (_ "Try 'guix system --help' for more information.~%"))
+        (exit 1))
+
       (case action
         ((build vm vm-image disk-image reconfigure)
          (unless (= count 1)
diff --git a/guix/store.scm b/guix/store.scm
index 132b8a3ac4..5f37e72589 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -58,6 +58,7 @@
             close-connection
             with-store
             set-build-options
+            set-build-options*
             valid-path?
             query-path-hash
             hash-part->path
@@ -986,6 +987,9 @@ permission bits are kept."
   ;; Monadic variant of 'build-things'.
   (store-lift build-things))
 
+(define set-build-options*
+  (store-lift set-build-options))
+
 (define %guile-for-build
   ;; The derivation of the Guile to be used within the build environment,
   ;; when using 'gexp->derivation' and co.
diff --git a/guix/ui.scm b/guix/ui.scm
index ca5b844a43..4a3630f242 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -2,9 +2,11 @@
 ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
+;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com>
 ;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
-;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +41,6 @@
   #:use-module (srfi srfi-31)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
-  #:use-module (srfi srfi-37)
   #:autoload   (ice-9 ftw)  (scandir)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
@@ -61,6 +62,7 @@
             show-bug-report-information
             string->number*
             size->number
+            show-derivation-outputs
             show-what-to-build
             show-what-to-build*
             show-manifest-transaction
@@ -79,8 +81,6 @@
             package-specification->name+version+output
             string->generations
             string->duration
-            args-fold*
-            parse-command-line
             run-guix-command
             run-guix
             program-name
@@ -503,6 +503,14 @@ error."
      (leave (_ "expression ~s does not evaluate to a package~%")
             str))))
 
+(define (show-derivation-outputs derivation)
+  "Show the output file names of DERIVATION."
+  (format #t "~{~a~%~}"
+          (map (match-lambda
+                 ((out-name . out)
+                  (derivation->output-path derivation out-name)))
+               (derivation-outputs derivation))))
+
 (define* (show-what-to-build store drv
                              #:key dry-run? (use-substitutes? #t))
   "Show what will or would (depending on DRY-RUN?) be built in realizing the
@@ -959,52 +967,6 @@ optionally contain a version number and an output name, as in these examples:
 ;;; Command-line option processing.
 ;;;
 
-(define (args-fold* options unrecognized-option-proc operand-proc . seeds)
-  "A wrapper on top of `args-fold' that does proper user-facing error
-reporting."
-  (catch 'misc-error
-    (lambda ()
-      (apply args-fold options unrecognized-option-proc
-             operand-proc seeds))
-    (lambda (key proc msg args . rest)
-      ;; XXX: MSG is not i18n'd.
-      (leave (_ "invalid argument: ~a~%")
-             (apply format #f msg args)))))
-
-(define (environment-build-options)
-  "Return additional build options passed as environment variables."
-  (arguments-from-environment-variable "GUIX_BUILD_OPTIONS"))
-
-(define %default-argument-handler
-  ;; The default handler for non-option command-line arguments.
-  (lambda (arg result)
-    (alist-cons 'argument arg result)))
-
-(define* (parse-command-line args options seeds
-                             #:key
-                             (argument-handler %default-argument-handler))
-  "Parse the command-line arguments ARGS as well as arguments passed via the
-'GUIX_BUILD_OPTIONS' environment variable according to OPTIONS (a list of
-SRFI-37 options) and return the result, seeded by SEEDS.
-Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'.
-
-ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc'
-parameter of 'args-fold'."
-  (define (parse-options-from args seeds)
-    ;; Actual parsing takes place here.
-    (apply args-fold* args options
-           (lambda (opt name arg . rest)
-             (leave (_ "~A: unrecognized option~%") name))
-           argument-handler
-           seeds))
-
-  (call-with-values
-      (lambda ()
-        (parse-options-from (environment-build-options) seeds))
-    (lambda seeds
-      ;; ARGS take precedence over what the environment variable specifies.
-      (parse-options-from args seeds))))
-
 (define (show-guix-usage)
   (format (current-error-port)
           (_ "Try `guix --help' for more information.~%"))