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

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.915
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
Unified Diff Ignore Whitespace Patch
Changes to ask.tcl.
︙︙
11
12
13
14
15
16
17

18
19
20
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 description Commands to interact with the user in various
# Meta description simple ways, for a terminal.
# Meta subject {command line} tty interaction terminal
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require cmdr::color

# Meta require try
# Meta require linenoise
# Meta require struct::matrix
# 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 ensemble create

    namespace import ::cmdr::color

}

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

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








>











>















>








11
12
13
14
15
16
17
18
19
20
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
51
52
53

# Meta description Commands to interact with the user in various
# Meta description simple ways, for a terminal.
# Meta subject {command line} tty interaction terminal
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require cmdr::color
# Meta require cmdr::say
# Meta require try
# Meta require linenoise
# Meta require struct::matrix
# Meta require textutil::adjust
# @@ Meta End

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

package require Tcl 8.5
package require cmdr::color
package require cmdr::say
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 ensemble create

    namespace import ::cmdr::color
    namespace import ::cmdr::say
}

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

debug define cmdr/ask
debug level  cmdr/ask
debug prefix cmdr/ask {[debug caller] | }
︙︙
156
157
158
159
160
161
162



163



164
165
166
167
168
169
170

	    if {$e eq "aborted"} {
		error Interrupted error SIGTERM
	    }
	    return {*}${o} $e
	}
	if {$response eq {}} { set response $default }
	if {[::string is bool $response]} break



	puts stdout [Wrap "You must choose \"yes\" or \"no\""]



    }

    return $response
}

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








>
>
>
|
>
>
>








159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179

	    if {$e eq "aborted"} {
		error Interrupted error SIGTERM
	    }
	    return {*}${o} $e
	}
	if {$response eq {}} { set response $default }
	if {[::string is bool $response]} break

	# Show error for a second, then move back to the interaction
	# line and retry (which overwrites the old string).
	say add [color bad [Wrap "You must choose \"yes\" or \"no\""]]
	after 1000
	say rewind
	say up
    }

    return $response
}

proc ::cmdr::ask::choose {query choices {default {}}} {
    debug.cmdr/ask {}
︙︙
195
196
197
198
199
200
201



202



203
204
205
206
207
208
209

	    }
	    return {*}${o} $e
	}
	if {($response eq {}) && $hasdefault} {
	    set response $default
	}
	if {$response in $choices} break



	puts stdout [Wrap "You must choose one of $lc"]



    }

    return $response
}

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








>
>
>
|
>
>
>








204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224

	    }
	    return {*}${o} $e
	}
	if {($response eq {}) && $hasdefault} {
	    set response $default
	}
	if {$response in $choices} break

	# Show error for a second, then move back to the interaction
	# line and retry (which overwrites the old string).
	say add [color bad [Wrap "You must choose one of $lc"]]
	after 1000
	say rewind
	say up
    }

    return $response
}

proc ::cmdr::ask::menu {header prompt choices {default {}}} {
    debug.cmdr/ask {}
︙︙
233
234
235
236
237
238
239



240
241
242
243
244
245
246
247
248
249
250
251
252

	incr n
    }
    set Mstr [M format 2string]
    M destroy

    # Format the prompt
    lassign [Fit $prompt 5] pheader prompt




    # Interaction loop
    while {1} {
	if {$header ne {}} {puts stdout $header}
	puts stdout $Mstr

	try {
	    set response \
		[Interact $pheader $prompt \
		     -complete [namespace code [list Complete $fullchoices 0]]]
	} on error {e o} {
	    if {$e eq "aborted"} {
		error Interrupted error SIGTERM








>
>
>



<
<
<








248
249
250
251
252
253
254
255
256
257
258
259
260



261
262
263
264
265
266
267

	incr n
    }
    set Mstr [M format 2string]
    M destroy

    # Format the prompt
    lassign [Fit $prompt 5] pheader prompt

    if {$header ne {}} { say line $header }
    say line $Mstr

    # Interaction loop
    while {1} {



	try {
	    set response \
		[Interact $pheader $prompt \
		     -complete [namespace code [list Complete $fullchoices 0]]]
	} on error {e o} {
	    if {$e eq "aborted"} {
		error Interrupted error SIGTERM
︙︙
261
262
263
264
265
266
267


268



269
270
271
272
273
274
275


	if {[::string is int $response]} {
	    # Inserting a dummy to handle indexing from 1...
	    set response [lindex [linsert $choices 0 {}] $response]
	    if {$response in $choices} break
	}



	puts stdout [Wrap "You must choose one of the above"]



    }

    return $response
}

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









>
>
|
>
>
>








276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295


	if {[::string is int $response]} {
	    # Inserting a dummy to handle indexing from 1...
	    set response [lindex [linsert $choices 0 {}] $response]
	    if {$response in $choices} break
	}

	# Show error for a second, then move back to the interaction
	# line and retry (which overwrites the old string).
	say add [color bad [Wrap "You must choose one of the above"]]
	after 1000
	say rewind
	say up
    }

    return $response
}

# # ## ### ##### ######## ############# #####################
︙︙
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304

	lappend candidates $c
    }
    return $candidates
}

proc ::cmdr::ask::Interact {header prompt args} {
    debug.cmdr/ask {}
    if {$header ne {}} { puts $header }
    return [linenoise prompt {*}$args -prompt $prompt]
}

proc ::cmdr::ask::Wrap {text {down 0}} {
    debug.cmdr/ask {}
    global env
    if {[info exists env(CMDR_NO_WRAP)]} {








|








310
311
312
313
314
315
316
317
318
319
320
321
322
323
324

	lappend candidates $c
    }
    return $candidates
}

proc ::cmdr::ask::Interact {header prompt args} {
    debug.cmdr/ask {}
    if {$header ne {}} { say line $header }
    return [linenoise prompt {*}$args -prompt $prompt]
}

proc ::cmdr::ask::Wrap {text {down 0}} {
    debug.cmdr/ask {}
    global env
    if {[info exists env(CMDR_NO_WRAP)]} {
︙︙