cmdr
Check-in [4f4b8b9a82]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Worked the low-level output into the ask package as demo of use. Especially made the retry loops visually tighter (temp display of error on bad input, plus reuse of existing line for re-input, no redraw of fixed parts (headers, menu listings)).
Timelines: family | ancestors | descendants | both | say-more
Files: files | file ages | folders
SHA1: 4f4b8b9a8236bcc77de840cc5f6aba69edc3c30f
User & Date: andreask 2015-04-22 20:13:33
Context
2015-04-22
20:19
Fix small issue, clear header in a multi-line prompt, this is a fixed part we must not redraw on retry under this new scheme. check-in: defa6f6ead user: andreask tags: say-more
20:13
Worked the low-level output into the ask package as demo of use. Especially made the retry loops visually tighter (temp display of error on bad input, plus reuse of existing line for re-input, no redraw of fixed parts (headers, menu listings)). check-in: 4f4b8b9a82 user: andreask tags: say-more
2015-04-21
18:11
Draft work on an output package for basic terminal control, and animations (like progress-bars, barber-poles, counters, etc.) check-in: faf4b58f8c user: andreask tags: say-more
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to ask.tcl.

    11     11   # Meta description Commands to interact with the user in various
    12     12   # Meta description simple ways, for a terminal.
    13     13   # Meta subject {command line} tty interaction terminal
    14     14   # Meta require {Tcl 8.5-}
    15     15   # Meta require debug
    16     16   # Meta require debug::caller
    17     17   # Meta require cmdr::color
           18  +# Meta require cmdr::say
    18     19   # Meta require try
    19     20   # Meta require linenoise
    20     21   # Meta require struct::matrix
    21     22   # Meta require textutil::adjust
    22     23   # @@ Meta End
    23     24   
    24     25   # # ## ### ##### ######## ############# #####################
    25     26   ## Requisites
    26     27   
    27     28   package require Tcl 8.5
    28     29   package require cmdr::color
           30  +package require cmdr::say
    29     31   package require debug
    30     32   package require debug::caller
    31     33   package require linenoise
    32     34   package require try
    33     35   package require struct::matrix
    34     36   package require textutil::adjust
    35     37   
................................................................................
    37     39       namespace export ask
    38     40   }
    39     41   namespace eval ::cmdr::ask {
    40     42       namespace export string string/extended string* yn choose menu
    41     43       namespace ensemble create
    42     44   
    43     45       namespace import ::cmdr::color
           46  +    namespace import ::cmdr::say
    44     47   }
    45     48   
    46     49   # # ## ### ##### ######## ############# #####################
    47     50   
    48     51   debug define cmdr/ask
    49     52   debug level  cmdr/ask
    50     53   debug prefix cmdr/ask {[debug caller] | }
................................................................................
   156    159   	    if {$e eq "aborted"} {
   157    160   		error Interrupted error SIGTERM
   158    161   	    }
   159    162   	    return {*}${o} $e
   160    163   	}
   161    164   	if {$response eq {}} { set response $default }
   162    165   	if {[::string is bool $response]} break
   163         -	puts stdout [Wrap "You must choose \"yes\" or \"no\""]
          166  +
          167  +	# Show error for a second, then move back to the interaction
          168  +	# line and retry (which overwrites the old string).
          169  +	say add [color bad [Wrap "You must choose \"yes\" or \"no\""]]
          170  +	after 1000
          171  +	say rewind
          172  +	say up
   164    173       }
   165    174   
   166    175       return $response
   167    176   }
   168    177   
   169    178   proc ::cmdr::ask::choose {query choices {default {}}} {
   170    179       debug.cmdr/ask {}
................................................................................
   195    204   	    }
   196    205   	    return {*}${o} $e
   197    206   	}
   198    207   	if {($response eq {}) && $hasdefault} {
   199    208   	    set response $default
   200    209   	}
   201    210   	if {$response in $choices} break
   202         -	puts stdout [Wrap "You must choose one of $lc"]
          211  +
          212  +	# Show error for a second, then move back to the interaction
          213  +	# line and retry (which overwrites the old string).
          214  +	say add [color bad [Wrap "You must choose one of $lc"]]
          215  +	after 1000
          216  +	say rewind
          217  +	say up
   203    218       }
   204    219   
   205    220       return $response
   206    221   }
   207    222   
   208    223   proc ::cmdr::ask::menu {header prompt choices {default {}}} {
   209    224       debug.cmdr/ask {}
................................................................................
   233    248   	incr n
   234    249       }
   235    250       set Mstr [M format 2string]
   236    251       M destroy
   237    252   
   238    253       # Format the prompt
   239    254       lassign [Fit $prompt 5] pheader prompt
          255  +
          256  +    if {$header ne {}} { say line $header }
          257  +    say line $Mstr
   240    258   
   241    259       # Interaction loop
   242    260       while {1} {
   243         -	if {$header ne {}} {puts stdout $header}
   244         -	puts stdout $Mstr
   245         -
   246    261   	try {
   247    262   	    set response \
   248    263   		[Interact $pheader $prompt \
   249    264   		     -complete [namespace code [list Complete $fullchoices 0]]]
   250    265   	} on error {e o} {
   251    266   	    if {$e eq "aborted"} {
   252    267   		error Interrupted error SIGTERM
................................................................................
   261    276   
   262    277   	if {[::string is int $response]} {
   263    278   	    # Inserting a dummy to handle indexing from 1...
   264    279   	    set response [lindex [linsert $choices 0 {}] $response]
   265    280   	    if {$response in $choices} break
   266    281   	}
   267    282   
   268         -	puts stdout [Wrap "You must choose one of the above"]
          283  +	# Show error for a second, then move back to the interaction
          284  +	# line and retry (which overwrites the old string).
          285  +	say add [color bad [Wrap "You must choose one of the above"]]
          286  +	after 1000
          287  +	say rewind
          288  +	say up
   269    289       }
   270    290   
   271    291       return $response
   272    292   }
   273    293   
   274    294   # # ## ### ##### ######## ############# #####################
   275    295   
................................................................................
   290    310   	lappend candidates $c
   291    311       }
   292    312       return $candidates
   293    313   }
   294    314   
   295    315   proc ::cmdr::ask::Interact {header prompt args} {
   296    316       debug.cmdr/ask {}
   297         -    if {$header ne {}} { puts $header }
          317  +    if {$header ne {}} { say line $header }
   298    318       return [linenoise prompt {*}$args -prompt $prompt]
   299    319   }
   300    320   
   301    321   proc ::cmdr::ask::Wrap {text {down 0}} {
   302    322       debug.cmdr/ask {}
   303    323       global env
   304    324       if {[info exists env(CMDR_NO_WRAP)]} {