cmdr
Check-in [0c33d13e6e]
Not logged in
Myself Home DocumentationDownloads Tickets | Timeline Branches Tags Wiki Login

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.344
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
Unified Diff Ignore Whitespace Patch
Changes to ask.tcl.
︙︙
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42


43
44
45
46
47
48
49

# Meta require textutil::adjust
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
#package require cmdr::color
package require debug
package require debug::caller
package require linenoise
package require try
package require struct::matrix
package require textutil::adjust

namespace eval ::cmdr {
    namespace export ask
}
namespace eval ::cmdr::ask {
    #namespace import ::stackato::color
    namespace export string string/extended string* yn choose menu
    namespace create ensemble


}

# # ## ### ##### ######## ############# #####################

debug define cmdr/ask
debug level  cmdr/ask
debug prefix cmdr/ask {[debug caller] | }








|











<


>
>








21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
48
49
50

# Meta require textutil::adjust
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require cmdr::color
package require debug
package require debug::caller
package require linenoise
package require try
package require struct::matrix
package require textutil::adjust

namespace eval ::cmdr {
    namespace export ask
}
namespace eval ::cmdr::ask {

    namespace export string string/extended string* yn choose menu
    namespace create ensemble

    namespace import ::cmdr::color
}

# # ## ### ##### ######## ############# #####################

debug define cmdr/ask
debug level  cmdr/ask
debug prefix cmdr/ask {[debug caller] | }
︙︙
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138

	return {*}${o} $e
    }
    return $response
}

proc ::cmdr::ask::yn {query {default yes}} {
    debug.cmdr/ask {}
    set dinfo [expr {$default
		     ? " \[Yn\]: "
		     : " \[yN\]: "}]
    # Reactivate with color support.
    if 0 {set dinfo [expr {$default
			   ? " \[[color green Y]n\]: "
			   : " \[y[color green N]\]: "}]}
    append query $dinfo

    lassign [Fit $query 5] header prompt
    while {1} {
	try {
	    set response \
		[Interact $header $prompt \
		     -complete [namespace code {Complete {yes no false true on off 0 1} 1}]]








|
<
<
<
<
|
|
<








118
119
120
121
122
123
124
125




126
127

128
129
130
131
132
133
134

	return {*}${o} $e
    }
    return $response
}

proc ::cmdr::ask::yn {query {default yes}} {
    debug.cmdr/ask {}
    append query [expr {$default




			? " \[[color yes Y]n\]: "
			: " \[y[color no N]\]: "}]


    lassign [Fit $query 5] header prompt
    while {1} {
	try {
	    set response \
		[Interact $header $prompt \
		     -complete [namespace code {Complete {yes no false true on off 0 1} 1}]]
︙︙
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170

proc ::cmdr::ask::choose {query choices {default {}}} {
    debug.cmdr/ask {}

    set hasdefault [expr {$default in $choices}]

    set lc [linsert [join $choices {, }] end-1 or]
    if {$hasdefault} {
	# when we have color support, reactivate
	#lappend map $default [color green $default]
	#set lc [string map $map $lc]
    }

    append query " ($lc): "

    lassign [Fit $query 5] header prompt

    while {1} {








<
|
|








150
151
152
153
154
155
156

157
158
159
160
161
162
163
164
165

proc ::cmdr::ask::choose {query choices {default {}}} {
    debug.cmdr/ask {}

    set hasdefault [expr {$default in $choices}]

    set lc [linsert [join $choices {, }] end-1 or]
    if {$hasdefault} {

	lappend map $default [color good $default]
	set lc [string map $map $lc]
    }

    append query " ($lc): "

    lassign [Fit $query 5] header prompt

    while {1} {
︙︙
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210

211
212
213
214
215
216
217

}

proc ::cmdr::ask::menu {header prompt choices {default {}}} {
    debug.cmdr/ask {}

    set hasdefault [expr {$default in $choices}]

    # Full list of choices is the choices themselves, plus the numeric
    # indices we can address them by. This is for the prompt
    # completion callback below.
    set fullchoices $choices

    # Build table (2-column matrix)
    struct::matrix [self namespace]::M
    M add columns 2
    set n 1
    foreach c $choices {
	if 0 {if {$default eq $c} {
	    M add row [list ${n}. [color green $c]]
	} else {
	    M add row [list ${n}. $c]
	}}


	M add row [list ${n}. $c]
	lappend fullchoices $n
	incr n
    }
    set Mstr [M format 2string]
    M destroy








|









|
|
<
<
<
>








184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202



203
204
205
206
207
208
209
210

}

proc ::cmdr::ask::menu {header prompt choices {default {}}} {
    debug.cmdr/ask {}

    set hasdefault [expr {$default in $choices}]

    # Full list of choices is the choicces themselves, plus the numeric
    # indices we can address them by. This is for the prompt
    # completion callback below.
    set fullchoices $choices

    # Build table (2-column matrix)
    struct::matrix [self namespace]::M
    M add columns 2
    set n 1
    foreach c $choices {
	if {$default eq $c} {
	    set c [color good $c]



	}

	M add row [list ${n}. $c]
	lappend fullchoices $n
	incr n
    }
    set Mstr [M format 2string]
    M destroy
︙︙
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320

	return [list {} $prompt]
    }

    set prompt [textutil::adjust::adjust $prompt -length $w -strictlength 1]
    set prompt [split $prompt \n]
    set header [join [lrange $prompt 0 end-1] \n]
    set prompt [lindex $prompt end]
    # alt code for the same.
    #set header [join [lreverse [lassign [lreverse [split $prompt \n]] prompt]] \n]
    append prompt { }

    return [list $header $prompt]
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::ask 0








|
|









297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313

	return [list {} $prompt]
    }

    set prompt [textutil::adjust::adjust $prompt -length $w -strictlength 1]
    set prompt [split $prompt \n]
    set header [join [lrange $prompt 0 end-1] \n]
    set prompt [lindex $prompt end]
    # Alternate code for the last 3 lines, more cryptic.
    # set header [join [lreverse [lassign [lreverse [split $prompt \n]] prompt]] \n]
    append prompt { }

    return [list $header $prompt]
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::ask 0