[122840] branches/gsoc14-interactive/base/src/port/port.tcl

[shasha at macports.org]

Revision: 122840
          https://trac.macports.org/changeset/122840
Author:   shasha at macports.org
Date:     2014-07-31 10:04:52 -0700 (Thu, 31 Jul 2014)
Log Message:
-----------
fixed Ctrl-C issues

Modified Paths:
--------------
    branches/gsoc14-interactive/base/src/port/port.tcl

Modified: branches/gsoc14-interactive/base/src/port/port.tcl
===================================================================
--- branches/gsoc14-interactive/base/src/port/port.tcl	2014-07-31 16:41:42 UTC (rev 122839)
+++ branches/gsoc14-interactive/base/src/port/port.tcl	2014-07-31 17:04:52 UTC (rev 122840)
@@ -5236,6 +5236,7 @@
 # Create namespace for questions
 namespace eval portclient::questions {
 	
+	package require Tclx
 	##
 	# Function that handles printing of a timeout.
 	#
@@ -5244,23 +5245,25 @@
 	# @param def
 	#        The default action to be taken in the occurence of a timeout.
 	proc ui_timeout {def timeout} {
-		# Gap between printing of each dot
-		set sec 0
-		
-		# Prints time like 5...4...3...2...1...0
-		while {$timeout >= 0} { 
-			after $sec {puts -nonewline "\r"}
-			after $sec {puts -nonewline "Continuing in "}
-			incr sec 1000
-			after $sec puts -nonewline [format "%02d" $timeout]
-			after $sec flush stdout
-			after $sec {puts -nonewline ". Press Ctrl-C to exit: "}
-			after $sec flush stdout
+		fconfigure stdin -blocking 0
+
+		signal error {TERM INT}
+		while {$timeout >= 0} {
+			if {[catch {set inp [read stdin]} err]} {
+				return -code error "Ctrl-C"
+			}
+			if {$inp eq "\n"} {
+				return $def
+			}
+			puts -nonewline "\r"
+			puts -nonewline [format "Continuing in %02d s. Press Ctrl-C to exit: " $timeout]
+			flush stdout
+			after 1000
 			incr timeout -1
 		}
-		after $sec set result def
-		vwait result
 		puts ""
+		fconfigure stdin -blocking 1
+		signal -restart error {TERM INT}
 		return $def
 	}
 	
@@ -5339,7 +5342,11 @@
 		
 		# User input (probably requires some input error checking code) 
 		while 1 {
-			set input [gets stdin]
+			signal error {TERM INT}
+			if {[catch {set input [gets stdin]} err]} {
+				return -code error "Ctrl-C"
+			}
+			signal -restart error {TERM INT}
 			if {$input in {y Y}} {
 				return 0
 			} elseif {$input in {n N}} {
@@ -5362,14 +5369,18 @@
 	# @param ports
 	#        The port/list of ports for which the question is being asked.
 	proc ui_ask_singlechoice {msg name ports} {
-		
+		package require Tclx
 		ui_choice $msg $name $ports
 				
 		# User Input (single input restriction)
 		while 1 {
 			puts -nonewline "Enter a number to select an option: "
 			flush stdout
-			set input [gets stdin]
+			signal error {TERM INT}
+			if {[catch {set input [gets stdin]} err]} {
+				return -code error "Ctrl-C"
+			}
+			signal -restart error {TERM INT}
 			if {($input <= [llength $ports] && [string is integer -strict $input])} {
 				return $input
 			} else {
@@ -5395,7 +5406,11 @@
 		while 1 {
 			puts -nonewline "Enter the numbers to select the options: "
 			flush stdout
-			set input [gets stdin]
+			signal error {TERM INT}
+			if {[catch {set input [gets stdin]} err]} {
+				return -code error "Ctrl-C"
+			}
+			signal -restart error {TERM INT}
 			set count 0
 			# check if input is non-empty and otherwise fine
 			if {$input == ""} {
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.macosforge.org/pipermail/macports-changes/attachments/20140731/3d17bd55/attachment.html>