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: |
1eeef534319c4756420d5a091a4dd067 |
| User & Date: | andreask 2014-05-23 21:51:43 |
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
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 .. 71 72 73 74 75 76 77 78 79 80 81 82 83 84 ... 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 ... 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 ... 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 ... 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 ... 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 ... 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 |
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
................................................................................
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 -
................................................................................
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 \
................................................................................
}
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]
}
................................................................................
}
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"]
}
................................................................................
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 {}
................................................................................
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
|
| > > > > > > > > > > > > > > > > > | | > > | | > | > > > > > > | | | | | > > > > > > > > > > > > > |
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 .. 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 ... 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 ... 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 ... 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 ... 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 ... 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 ... 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 |
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
................................................................................
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 -
................................................................................
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 \
................................................................................
}
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]
}
................................................................................
}
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"]
}
................................................................................
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 {}
................................................................................
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 |