cmdr
Check-in [0c33d13e6e]
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:cmdr::ask - Reactivated color support. No tests yet.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0c33d13e6ee5856ee76b4bc8a25200292ca0eb2d
User & Date: andreask 2014-05-23 20:42:54
References
2014-05-23
22:19 Closed ticket [a80ac87036]: Add facilities for user interaction plus 4 other changes artifact: 7ab7393038 user: aku
Context
2014-05-23
21:51
cmdr::ask - Fixed a syntax problem. Fixed scope issue (string command). Tweaked the prompt setup. Plus example apps (also for interactive testing). check-in: 1eeef53431 user: andreask tags: trunk
20:42
cmdr::ask - Reactivated color support. No tests yet. check-in: 0c33d13e6e user: andreask tags: trunk
07:13
cmdr::color - Fixed issues, expanded functionality, better checking. Plus testsuite. check-in: ddd5e520dd user: aku tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to ask.tcl.

    21     21   # Meta require textutil::adjust
    22     22   # @@ Meta End
    23     23   
    24     24   # # ## ### ##### ######## ############# #####################
    25     25   ## Requisites
    26     26   
    27     27   package require Tcl 8.5
    28         -#package require cmdr::color
           28  +package require cmdr::color
    29     29   package require debug
    30     30   package require debug::caller
    31     31   package require linenoise
    32     32   package require try
    33     33   package require struct::matrix
    34     34   package require textutil::adjust
    35     35   
    36     36   namespace eval ::cmdr {
    37     37       namespace export ask
    38     38   }
    39     39   namespace eval ::cmdr::ask {
    40         -    #namespace import ::stackato::color
    41     40       namespace export string string/extended string* yn choose menu
    42     41       namespace create ensemble
           42  +
           43  +    namespace import ::cmdr::color
    43     44   }
    44     45   
    45     46   # # ## ### ##### ######## ############# #####################
    46     47   
    47     48   debug define cmdr/ask
    48     49   debug level  cmdr/ask
    49     50   debug prefix cmdr/ask {[debug caller] | }
................................................................................
   117    118   	return {*}${o} $e
   118    119       }
   119    120       return $response
   120    121   }
   121    122   
   122    123   proc ::cmdr::ask::yn {query {default yes}} {
   123    124       debug.cmdr/ask {}
   124         -    set dinfo [expr {$default
   125         -		     ? " \[Yn\]: "
   126         -		     : " \[yN\]: "}]
   127         -    # Reactivate with color support.
   128         -    if 0 {set dinfo [expr {$default
   129         -			   ? " \[[color green Y]n\]: "
   130         -			   : " \[y[color green N]\]: "}]}
   131         -    append query $dinfo
          125  +    append query [expr {$default
          126  +			? " \[[color yes Y]n\]: "
          127  +			: " \[y[color no N]\]: "}]
   132    128   
   133    129       lassign [Fit $query 5] header prompt
   134    130       while {1} {
   135    131   	try {
   136    132   	    set response \
   137    133   		[Interact $header $prompt \
   138    134   		     -complete [namespace code {Complete {yes no false true on off 0 1} 1}]]
................................................................................
   154    150   proc ::cmdr::ask::choose {query choices {default {}}} {
   155    151       debug.cmdr/ask {}
   156    152   
   157    153       set hasdefault [expr {$default in $choices}]
   158    154   
   159    155       set lc [linsert [join $choices {, }] end-1 or]
   160    156       if {$hasdefault} {
   161         -	# when we have color support, reactivate
   162         -	#lappend map $default [color green $default]
   163         -	#set lc [string map $map $lc]
          157  +	lappend map $default [color good $default]
          158  +	set lc [string map $map $lc]
   164    159       }
   165    160   
   166    161       append query " ($lc): "
   167    162   
   168    163       lassign [Fit $query 5] header prompt
   169    164   
   170    165       while {1} {
................................................................................
   189    184   }
   190    185   
   191    186   proc ::cmdr::ask::menu {header prompt choices {default {}}} {
   192    187       debug.cmdr/ask {}
   193    188   
   194    189       set hasdefault [expr {$default in $choices}]
   195    190   
   196         -    # Full list of choices is the choices themselves, plus the numeric
          191  +    # Full list of choices is the choicces themselves, plus the numeric
   197    192       # indices we can address them by. This is for the prompt
   198    193       # completion callback below.
   199    194       set fullchoices $choices
   200    195   
   201    196       # Build table (2-column matrix)
   202    197       struct::matrix [self namespace]::M
   203    198       M add columns 2
   204    199       set n 1
   205    200       foreach c $choices {
   206         -	if 0 {if {$default eq $c} {
   207         -	    M add row [list ${n}. [color green $c]]
   208         -	} else {
   209         -	    M add row [list ${n}. $c]
   210         -	}}
          201  +	if {$default eq $c} {
          202  +	    set c [color good $c]
          203  +	}
   211    204   
   212    205   	M add row [list ${n}. $c]
   213    206   	lappend fullchoices $n
   214    207   	incr n
   215    208       }
   216    209       set Mstr [M format 2string]
   217    210       M destroy
................................................................................
   304    297   	return [list {} $prompt]
   305    298       }
   306    299   
   307    300       set prompt [textutil::adjust::adjust $prompt -length $w -strictlength 1]
   308    301       set prompt [split $prompt \n]
   309    302       set header [join [lrange $prompt 0 end-1] \n]
   310    303       set prompt [lindex $prompt end]
   311         -    # alt code for the same.
   312         -    #set header [join [lreverse [lassign [lreverse [split $prompt \n]] prompt]] \n]
          304  +    # Alternate code for the last 3 lines, more cryptic.
          305  +    # set header [join [lreverse [lassign [lreverse [split $prompt \n]] prompt]] \n]
   313    306       append prompt { }
   314    307   
   315    308       return [list $header $prompt]
   316    309   }
   317    310   
   318    311   # # ## ### ##### ######## ############# #####################
   319    312   ## Ready
   320    313   package provide cmdr::ask 0