Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch say-more
Excluding Merge-Ins
This is equivalent to a diff from
860ef7cfb3
to 4c80a42e4d
2015-05-08
| | |
20:27 |
|
check-in: 00a6db24bb user: aku tags: trunk
|
00:17 |
|
check-in: a09daa498b user: andreask tags: neg-aliases
|
2015-05-01
| | |
23:30 |
|
Leaf
check-in: 4c80a42e4d user: andreask tags: say-more
|
22:55 |
|
check-in: 64bb90174f user: andreask tags: say-more
|
2015-04-21
| | |
18:11 |
|
check-in: faf4b58f8c user: andreask tags: say-more
|
2015-04-17
| | |
23:24 |
|
check-in: 860ef7cfb3 user: andreask tags: trunk
|
22:18 |
|
check-in: c8ea7fb2f9 user: andreask tags: trunk
|
| | |
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
|
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
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
+
+
+
-
+
+
+
+
+
+
+
+
|
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).
puts stdout [Wrap "You must choose \"yes\" or \"no\""]
say add [color bad [Wrap "You must choose \"yes\" or \"no\""]]
after 1000
say rewind
say up
# Clear header to prevent redisplay, this part is fixed above
# the actual input line.
set header {}
}
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
|
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
+
+
+
-
+
+
+
+
+
+
+
+
|
}
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).
puts stdout [Wrap "You must choose one of $lc"]
say add [color bad [Wrap "You must choose one of $lc"]]
after 1000
say rewind
say up
# Clear header to prevent redisplay, this part is fixed above
# the actual input line.
set header {}
}
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
|
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
|
+
+
+
-
-
-
|
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} {
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
|
︙ | | |
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
|
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
|
+
+
-
+
+
+
+
+
+
+
+
|
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).
puts stdout [Wrap "You must choose one of the above"]
say add [color bad [Wrap "You must choose one of the above"]]
after 1000
say rewind
say up
# Clear header to prevent redisplay, this part is fixed above
# the actual input line.
set pheader {}
}
return $response
}
# # ## ### ##### ######## ############# #####################
|
︙ | | |
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
|
-
+
|
lappend candidates $c
}
return $candidates
}
proc ::cmdr::ask::Interact {header prompt args} {
debug.cmdr/ask {}
if {$header ne {}} { puts $header }
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)]} {
|
︙ | | |
Added examples/local.
|
1
2
3
4
5
6
7
8
9
|
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
#lappend auto_path [file dirname [file dirname [file normalize [info script]]]]
#puts "= [join $auto_path "\n= "]"
source [file dirname [file dirname [file normalize [info script]]]]/say.tcl
source [lindex $argv 0]
exit
|
| | | | | | | |
Added examples/say-barber-phases.
|
1
2
3
4
5
6
7
8
|
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
puts |[join [cmdr say barber-phases 16 {** }] |\n|]|
exit
|
| | | | | | |
Added examples/say-barberpole-1.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# infinite barberpole
set B [cmdr say barberpole -width 30]
while {1} {
after 100
cmdr say rewind
$B step
}
exit
|
| | | | | | | | | | | | |
Added examples/say-barberpole-2.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# infinite barberpole with a prefix
set B [cmdr say barberpole -width 30]
cmdr say add "download ... "
cmdr say lock-prefix
while {1} {
#
# fake download, unknown size, sync ... actual use:
# - fcopy callback,
# - http progress-callback
# - tcllib transfer callback
after 100
#
cmdr say rewind
$B step
}
exit
|
| | | | | | | | | | | | | | | | | | | | |
Added examples/say-counter.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# progress counter.
set B [cmdr say progress-counter 100]
set i 0
cmdr say add "upload ... "
cmdr say lock-prefix
while {$i < 100} {
#
# fake upload, sync ... actual use:
# - fcopy callback,
# - http progress-callback
# - tcllib transfer callback
after 100
#
cmdr say rewind
incr i
$B step $i
}
exit
|
| | | | | | | | | | | | | | | | | | | | | | |
Added examples/say-general-1.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# scanner
set B [cmdr say animate -phases {
{[*** ]}
{[** * ]}
{[ ** * ]}
{[ ** * ]}
{[ ** * ]}
{[ ** * ]}
{[ ** *]}
{[ ***]}
{[ * **]}
{[ * ** ]}
{[ * ** ]}
{[ * ** ]}
{[ * ** ]}
{[* ** ]}
}]
while {1} {
after 100
cmdr say rewind
$B step
# NOTE: putting the rewind after the step means that we will
# see the animation output only for a split second and the
# erased/empty line for the 100 milli delay => the terminal
# will look empty, with nothing happening.
}
exit
|
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
Added examples/say-general-2.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# infinite slider - semi-barberpole
set B [cmdr say animate -phases {
{[ ]}
{[* ]}
{[** ]}
{[*** ]}
{[* ** ]}
{[ * ** ]}
{[ * ** ]}
{[ * ** ]}
{[ * ** ]}
{[ * **]}
{[ * *]}
{[ * ]}
{[ *]}
}]
while {1} {
after 100
cmdr say rewind
$B step
}
exit
|
| | | | | | | | | | | | | | | | | | | | | | | | | | |
Added examples/say-larson.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# larson scanner
set B [cmdr say animate -phases [cmdr say larson-phases 9 ***]]
while {1} {
after 100
cmdr say rewind
$B step
# NOTE: putting the rewind after the step means that we will
# see the animation output only for a split second and the
# erased/empty line for the 100 milli delay => the terminal
# will look empty, with nothing happening.
}
exit
|
| | | | | | | | | | | | | | | | | |
Added examples/say-larson-phases.
|
1
2
3
4
5
6
7
8
|
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
puts |[join [cmdr say larson-phases 23 ***] |\n|]|
exit
|
| | | | | | |
Added examples/say-operation-barber.
|
1
2
3
4
5
6
7
8
9
10
11
|
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
cmdr say operation {Upload ... } {
after 5000 {set ::done ok}
vwait ::done
} -play {cmdr say barberpole -width -11}
exit
|
| | | | | | | | | |
Added examples/say-operation-ping.
|
1
2
3
4
5
6
7
8
9
10
11
|
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
cmdr say operation {Upload } {
after 5000 {set ::done ok}
vwait ::done
} -play {cmdr say ping -width 31 -wrap 1}
exit
|
| | | | | | | | | |
Added examples/say-operation-pulse.
|
1
2
3
4
5
6
7
8
9
10
11
|
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
cmdr say operation {Upload } {
after 5000 {set ::done ok}
vwait ::done
} -every 50 -play {cmdr say pulse -width 7}
exit
|
| | | | | | | | | |
Added examples/say-operation-turn.
|
1
2
3
4
5
6
7
8
9
10
11
|
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
cmdr say operation {Upload } {
after 5000 {set ::done ok}
vwait ::done
} -every 50 -play {cmdr say turn}
exit
|
| | | | | | | | | |
Added examples/say-percent.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# percent progress counter
set B [cmdr say percent -max 10000 -digits 2]
set i 0
cmdr say add "upload ... "
cmdr say lock-prefix
while {$i < 10000} {
#
# fake upload, sync ... actual use:
# - fcopy callback,
# - http progress-callback
# - tcllib transfer callback
after 10
#
cmdr say rewind
incr i
$B step $i
}
exit
|
| | | | | | | | | | | | | | | | | | | | | | |
Added examples/say-ping.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# ping bar
#set B [cmdr say ping -width 17]
#set B [cmdr say ping -width 17 -wrap 1]
set B [cmdr say ping -width 41 -wrap 1 -head {} -map { 100000 @
10000 \#
1000 %
100 |
10 *
1 {}
}]
#set B [cmdr say ping -width -8 -wrap 1]
#set B [cmdr say ping -width -8]
#set B [cmdr say ping -width Inf]
cmdr say add "upload "
cmdr say lock-prefix
while {1} {
#
# fake upload, sync ... actual use:
# - fcopy callback,
# - http progress-callback
# - tcllib transfer callback
after 10
#
cmdr say rewind
$B step
}
exit
|
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
Added examples/say-progress-1.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# percent progress bar
set B [cmdr say progress -max 1000 -width 50]
set C [cmdr say percent -max 1000]
set i 0
cmdr say add "upload ... "
cmdr say lock-prefix
while {$i < 1000} {
#
# fake upload, sync ... actual use:
# - fcopy callback,
# - http progress-callback
# - tcllib transfer callback
after 10
#
cmdr say rewind
incr i
cmdr say add \[
$B step $i
cmdr say add \]
cmdr say add { }
$C step $i
}
#after 10
#cmdr say rewind
cmdr say line { OK}
exit
|
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
Added examples/say-progress-2.
|
1
2
3
4
5
6
7
8
9
10
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
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# percent progress bar, full width
set C [cmdr say percent -max 1000]
set n [string length "upload ... \[\] "]
incr n [$C width]
set B [cmdr say progress -max 1000 -width -$n]
set i 0
cmdr say add "upload ... "
cmdr say lock-prefix
while {$i < 1000} {
#
# fake upload, sync ... actual use:
# - fcopy callback,
# - http progress-callback
# - tcllib transfer callback
after 10
#
cmdr say rewind
incr i
$C step $i
cmdr say add { }
cmdr say add \[
$B step $i
cmdr say add \]
}
after 1000
cmdr say rewind
cmdr say line { OK}
exit
|
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
Added examples/say-progress-phases.
|
1
2
3
4
5
6
7
8
|
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
puts |[join [cmdr say progress-phases 6 * ^] |\n|]|
exit
|
| | | | | | |
Added examples/say-pulse.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# infinite pulse - semi-barberpole
set B [cmdr say animate \
-phases [cmdr say pulse-phases 3 [cmdr color {bg-blue white} *]]]
while {1} {
after 100
cmdr say rewind
$B step
}
exit
|
| | | | | | | | | | | | | |
Added examples/say-pulse-phases-1.
|
1
2
3
4
5
6
7
8
|
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
puts |[join [cmdr say pulse-phases 6 *] |\n|]|
exit
|
| | | | | | |
Added examples/say-pulse-phases-2.
|
1
2
3
4
5
6
7
8
|
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
puts |[join [cmdr say pulse-phases 3 [cmdr color red .]] |\n|]|
exit
|
| | | | | | |
Added examples/say-slider.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# infinite slider - semi-barberpole
set B [cmdr say animate -phases [cmdr say slider-phases 9 ***]]
while {1} {
after 100
cmdr say rewind
$B step
}
exit
|
| | | | | | | | | | | | |
Added examples/say-slider-phases.
|
1
2
3
4
5
6
7
8
|
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
puts |[join [cmdr say slider-phases 9 ***] |\n|]|
exit
|
| | | | | | |
Added examples/say-turn.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
# turn
set B [cmdr say animate -phases [cmdr say turn-phases]]
while {1} {
after 100
cmdr say rewind
cmdr say add (
$B step
cmdr say add )
# NOTE: putting the rewind after the step means that we will
# see the animation output only for a split second and the
# erased/empty line for the 100 milli delay => the terminal
# will look empty, with nothing happening.
}
exit
|
| | | | | | | | | | | | | | | | | | | |
Added examples/say-turn-phases.
|
1
2
3
4
5
6
7
8
|
+
+
+
+
+
+
+
+
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::say
puts ([join [cmdr say turn-phases] )\n(])
exit
|
| | | | | | |
Added say.tcl.