From b52cb20d434d36ede63e6b20599c5d50a664e79c Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 17 Apr 2013 22:43:14 +0200
Subject: guix package: Allow the search of the latest release to be
 interrupted.

* guix/scripts/package.scm (%sigint-prompt): New variable.
  (call-with-sigint-handler): New procedure.
  (waiting): Use it.
---
 guix/scripts/package.scm | 37 ++++++++++++++++++++++++++++++-------
 1 file changed, 30 insertions(+), 7 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index f83c0573e7..4295abaf57 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -266,19 +266,42 @@ matching packages."
                        (assoc-ref (derivation-outputs drv) sub-drv))))
          `(,name ,out))))))
 
+(define %sigint-prompt
+  ;; The prompt to jump to upon SIGINT.
+  (make-prompt-tag "interruptible"))
+
+(define (call-with-sigint-handler thunk handler)
+  "Call THUNK and return its value.  Upon SIGINT, call HANDLER with the signal
+number in the context of the continuation of the call to this function, and
+return its return value."
+  (call-with-prompt %sigint-prompt
+                    (lambda ()
+                      (sigaction SIGINT
+                        (lambda (signum)
+                          (sigaction SIGINT SIG_DFL)
+                          (abort-to-prompt %sigint-prompt signum)))
+                      (thunk))
+                    (lambda (k signum)
+                      (handler signum))))
+
 (define-syntax-rule (waiting exp fmt rest ...)
   "Display the given message while EXP is being evaluated."
   (let* ((message (format #f fmt rest ...))
          (blank   (make-string (string-length message) #\space)))
     (display message (current-error-port))
     (force-output (current-error-port))
-    (let ((result exp))
-      ;; Clear the line.
-      (display #\cr (current-error-port))
-      (display blank (current-error-port))
-      (display #\cr (current-error-port))
-      (force-output (current-error-port))
-      exp)))
+    (call-with-sigint-handler
+     (lambda ()
+       (let ((result exp))
+         ;; Clear the line.
+         (display #\cr (current-error-port))
+         (display blank (current-error-port))
+         (display #\cr (current-error-port))
+         (force-output (current-error-port))
+         exp))
+     (lambda (signum)
+       (format (current-error-port) "  interrupted by signal ~a~%" SIGINT)
+       #f))))
 
 (define (check-package-freshness package)
   "Check whether PACKAGE has a newer version available upstream, and report
-- 
cgit v1.2.3