cmdr
Check-in [1eeef53431]
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 - Fixed a syntax problem. Fixed scope issue (string command). Tweaked the prompt setup. Plus example apps (also for interactive testing).
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1eeef534319c4756420d5a091a4dd0674080ed0c
User & Date: andreask 2014-05-23 21:51:43.157
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
22:08
cmdr::ask - Added basic testsuite. More requires a linenoise mockup to prevent actual interaction while exercising the command implementation. check-in: 2fa5347d94 user: andreask tags: trunk
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
Changes
Unified Diff Ignore Whitespace Patch
Changes to ask.tcl.
︙︙
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55








56
57
58
59
60
61
62

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] | }

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

proc ::cmdr::ask::string {query {default {}}} {
    debug.cmdr/ask {}








    try {
	set response [Interact {*}[Fit $query 10]]
    } on error {e o} {
	if {$e eq "aborted"} {
	    error Interrupted error SIGTERM
	}
	return {*}${o} $e








|














>
>
>
>
>
>
>
>








34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

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] | }

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

proc ::cmdr::ask::string {query {default {}}} {
    debug.cmdr/ask {}

    Chop query {: }
    if {$default ne {}} {
	append query " \[[color good $default]\]"
    }
    # TODO: allow customization (string prompt string)
    append query {: }

    try {
	set response [Interact {*}[Fit $query 10]]
    } on error {e o} {
	if {$e eq "aborted"} {
	    error Interrupted error SIGTERM
	}
	return {*}${o} $e
︙︙
71
72
73
74
75
76
77



78
79
80
81
82
83
84

    debug.cmdr/ask {}
    # accept  -history, -hidden, -complete
    # plus    -default
    # but not -prompt

    # for history ... integrate history load/save from file here?
    # -history is then not boolean, but path to history file.




    set default {}
    set config {}
    foreach {o v} $args {
	switch -exact -- $o {
	    -history -
	    -hidden -








>
>
>








79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

    debug.cmdr/ask {}
    # accept  -history, -hidden, -complete
    # plus    -default
    # but not -prompt

    # for history ... integrate history load/save from file here?
    # -history is then not boolean, but path to history file.

    Ensure query :   ;# TODO: allow customization (string prompt string)
    append query { }

    set default {}
    set config {}
    foreach {o v} $args {
	switch -exact -- $o {
	    -history -
	    -hidden -
︙︙
105
106
107
108
109
110
111




112
113
114
115
116
117
118
119
120
121
122
123
124


125
126
127


128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160

161


162
163
164
165
166
167
168

	set response $default
    }
    return $response
}

proc ::cmdr::ask::string* {query} {
    debug.cmdr/ask {}




    try {
	set response [Interact {*}[Fit $query 10] -hidden 1]
    } on error {e o} {
	if {$e eq "aborted"} {
	    error Interrupted error SIGTERM
	}
	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}]]
		     
	} on error {e o} {
	    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 {}

    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} {
	try {
	    set response \
		[Interact $header $prompt \








>
>
>
>













>
>

|
|
>
>















|














|


>
|
>
>








116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
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
184
185
186
187
188
189
190

	set response $default
    }
    return $response
}

proc ::cmdr::ask::string* {query} {
    debug.cmdr/ask {}

    Ensure query :   ;# TODO: allow customization (string prompt string)
    append query { }

    try {
	set response [Interact {*}[Fit $query 10] -hidden 1]
    } on error {e o} {
	if {$e eq "aborted"} {
	    error Interrupted error SIGTERM
	}
	return {*}${o} $e
    }
    return $response
}

proc ::cmdr::ask::yn {query {default yes}} {
    debug.cmdr/ask {}

    Chop query {: }
    append query [expr {$default
			? " \[[color yes Y]n\]"
			: " \[y[color no N]\]"}]
    # TODO: allow customization (bool prompt string)
    append query {: }

    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}]]
		     
	} on error {e o} {
	    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 {}

    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]
    }

    Chop   query {: }
    append query " ($lc)"
    # TODO: allow customization (choose prompt string)
    append query {: }

    lassign [Fit $query 5] header prompt

    while {1} {
	try {
	    set response \
		[Interact $header $prompt \
︙︙
181
182
183
184
185
186
187




188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204

    }

    return $response
}

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]
	}









>
>
>
>









|








203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230

    }

    return $response
}

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

    Chop   prompt {? }
    # TODO: allow customization (menu prompt string)
    append prompt {? }

    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 [namespace current]::M
    M add columns 2
    set n 1
    foreach c $choices {
	if {$default eq $c} {
	    set c [color good $c]
	}
︙︙
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243

	}
	if {($response eq {}) && $hasdefault} {
	    set response $default
	}

	if {$response in $choices} break

	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"]
    }








|








255
256
257
258
259
260
261
262
263
264
265
266
267
268
269

	}
	if {($response eq {}) && $hasdefault} {
	    set response $default
	}

	if {$response in $choices} break

	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"]
    }
︙︙
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270

    debug.cmdr/ask {}

    if {$buffer eq {}} {
	return $choices
    }

    if {$nocase} {
	set buffer [string tolower $buffer]
    }

    set candidates {}
    foreach c $choices {
	if {![string match ${buffer}* $c]} continue
	lappend candidates $c
    }
    return $candidates
}

proc ::cmdr::ask::Interact {header prompt args} {
    debug.cmdr/ask {}








|




|








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

    debug.cmdr/ask {}

    if {$buffer eq {}} {
	return $choices
    }

    if {$nocase} {
	set buffer [::string tolower $buffer]
    }

    set candidates {}
    foreach c $choices {
	if {![::string match ${buffer}* $c]} continue
	lappend candidates $c
    }
    return $candidates
}

proc ::cmdr::ask::Interact {header prompt args} {
    debug.cmdr/ask {}
︙︙
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309













310
311
312
313

    if {[info exists env(CMDR_NO_WRAP)]} {
	return [list {} $prompt]
    }

    set w [expr {[linenoise columns] - $space }]
    # we leave space for some characters to be entered.

    if {[string length $prompt] < $w} {
	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








|













>
>
>
>
>
>
>
>
>
>
>
>
>





315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352

    if {[info exists env(CMDR_NO_WRAP)]} {
	return [list {} $prompt]
    }

    set w [expr {[linenoise columns] - $space }]
    # we leave space for some characters to be entered.

    if {[::string length $prompt] < $w} {
	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]
}

proc ::cmdr::ask::Chop {var charset} {
    upvar 1 $var text
    set text [::string trimright $text $charset]
    return
}

proc ::cmdr::ask::Ensure {var char} {
    upvar 1 $var text
    if {[::string index $text end] eq $char} return
    append text $char
    return
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::ask 0
Added examples/ask-choose. 


































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::ask

lappend fruit apple
lappend fruit cherry
lappend fruit plum
lappend fruit peach
lappend fruit banana
lappend fruit pear

set rand [lindex $fruit [expr {int(0.1+(rand()*([llength $fruit])))}]]

puts [cmdr ask choose {Which fruit} $fruit $rand]
exit
Added examples/ask-menu. 


































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::ask

lappend fruit apple
lappend fruit cherry
lappend fruit plum
lappend fruit peach
lappend fruit banana
lappend fruit pear

set rand [lindex $fruit [expr {int(0.1+(rand()*([llength $fruit])))}]]

puts [cmdr ask menu {Choose your meal} {Which fruit} $fruit $rand]
exit
Added examples/ask-string. 




















>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9

#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::ask

puts [cmdr ask string  Hostname [info hostname]]
puts [cmdr ask string  Footer]
puts [cmdr ask string* Password]
exit
Added examples/ask-yn. 




















>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9

#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
package require cmdr::ask

puts [cmdr ask yn {Is this ok ?}]
puts [cmdr ask yn {Really ?} no]

exit