From 5d7a8584f5c6aeed720c1115b8d46aa5a8d3157b Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 8 Oct 2014 17:15:49 +0400
Subject: ui: Move 'show-manifest-transaction' from (guix profiles).
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* guix/profiles.scm: Do not use (guix ui) module.
  (right-arrow, manifest-show-transaction): Move and rename to...
* guix/ui.scm (right-arrow, show-manifest-transaction): ... here.
* tests/profiles.scm ("manifest-show-transaction"): Move to...
* tests/ui.scm ("show-manifest-transaction"): ... here.
  (guile-1.8.8, guile-2.0.9): New variables.
* emacs/guix-main.scm (process-package-actions): Rename
  'manifest-show-transaction' to 'show-manifest-transaction'.
* guix/scripts/package.scm (guix-package): Likewise.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 guix/profiles.scm | 93 -------------------------------------------------------
 1 file changed, 93 deletions(-)

(limited to 'guix/profiles.scm')

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 18733a6664..f2eb754bca 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -19,7 +19,6 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix profiles)
-  #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix records)
   #:use-module (guix derivations)
@@ -63,7 +62,6 @@
             manifest-transaction-remove
             manifest-perform-transaction
             manifest-transaction-effects
-            manifest-show-transaction
 
             profile-manifest
             package->manifest-entry
@@ -315,97 +313,6 @@ it."
     (manifest-add (manifest-remove manifest remove)
                   install)))
 
-(define (right-arrow port)
-  "Return either a string containing the 'RIGHT ARROW' character, or an ASCII
-replacement if PORT is not Unicode-capable."
-  (with-fluids ((%default-port-encoding (port-encoding port)))
-    (let ((arrow "→"))
-      (catch 'encoding-error
-        (lambda ()
-          (call-with-output-string
-            (lambda (port)
-              (set-port-conversion-strategy! port 'error)
-              (display arrow port))))
-        (lambda (key . args)
-          "->")))))
-
-(define* (manifest-show-transaction store manifest transaction
-                                    #:key dry-run?)
-  "Display what will/would be installed/removed from MANIFEST by TRANSACTION."
-  (define (package-strings name version output item)
-    (map (lambda (name version output item)
-           (format #f "   ~a~:[:~a~;~*~]\t~a\t~a"
-                   name
-                   (equal? output "out") output version
-                   (if (package? item)
-                       (package-output store item output)
-                       item)))
-         name version output item))
-
-  (define →                        ;an arrow that can be represented on stderr
-    (right-arrow (current-error-port)))
-
-  (define (upgrade-string name old-version new-version output item)
-    (format #f "   ~a~:[:~a~;~*~]\t~a ~a ~a\t~a"
-            name (equal? output "out") output
-            old-version → new-version
-            (if (package? item)
-                (package-output store item output)
-                item)))
-
-  (let-values (((remove install upgrade)
-                (manifest-transaction-effects manifest transaction)))
-    (match remove
-      ((($ <manifest-entry> name version output item) ..1)
-       (let ((len    (length name))
-             (remove (package-strings name version output item)))
-         (if dry-run?
-             (format (current-error-port)
-                     (N_ "The following package would be removed:~%~{~a~%~}~%"
-                         "The following packages would be removed:~%~{~a~%~}~%"
-                         len)
-                     remove)
-             (format (current-error-port)
-                     (N_ "The following package will be removed:~%~{~a~%~}~%"
-                         "The following packages will be removed:~%~{~a~%~}~%"
-                         len)
-                     remove))))
-      (_ #f))
-    (match upgrade
-      (((($ <manifest-entry> name old-version)
-         . ($ <manifest-entry> _ new-version output item)) ..1)
-       (let ((len     (length name))
-             (upgrade (map upgrade-string
-                           name old-version new-version output item)))
-         (if dry-run?
-             (format (current-error-port)
-                     (N_ "The following package would be upgraded:~%~{~a~%~}~%"
-                         "The following packages would be upgraded:~%~{~a~%~}~%"
-                         len)
-                     upgrade)
-             (format (current-error-port)
-                     (N_ "The following package will be upgraded:~%~{~a~%~}~%"
-                         "The following packages will be upgraded:~%~{~a~%~}~%"
-                         len)
-                     upgrade))))
-      (_ #f))
-    (match install
-      ((($ <manifest-entry> name version output item _) ..1)
-       (let ((len     (length name))
-             (install (package-strings name version output item)))
-         (if dry-run?
-             (format (current-error-port)
-                     (N_ "The following package would be installed:~%~{~a~%~}~%"
-                         "The following packages would be installed:~%~{~a~%~}~%"
-                         len)
-                     install)
-             (format (current-error-port)
-                     (N_ "The following package will be installed:~%~{~a~%~}~%"
-                         "The following packages will be installed:~%~{~a~%~}~%"
-                         len)
-                     install))))
-      (_ #f))))
-
 
 ;;;
 ;;; Profiles.
-- 
cgit v1.2.3