Check-in [6d60e61228]

Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Started on (TODO 1). Added copy of cmdr framework, plus code to load it, and fall back to the local copy if needed.
Timelines: family | ancestors | descendants | both | v2
Files: files | file ages | folders
SHA1:6d60e61228989da8609e342dbab3cbe112243f55
User & Date: andreask 2013-12-20 00:21:35
Context
2013-12-20
01:20
Bugfixes in the cmdr framework. check-in: fa13d12440 user: andreask tags: v2
00:21
Started on (TODO 1). Added copy of cmdr framework, plus code to load it, and fall back to the local copy if needed. check-in: 6d60e61228 user: andreask tags: v2
2013-12-19
22:56
Implemented and documented a set of glob patterns to ignore when scanning a propject directory. Exposed to the user via DSL commands. check-in: be0587c13c user: andreask tags: v2
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to build.tcl.

1
2
3
4
5
6
7

8
9
#!/bin/sh
# -*- tcl -*- \
exec ./kettle -f "$0" "${1+$@}"
# For kettle sources, documentation, etc. see
# - http://core.tcl.tk/akupries/kettle
# - http://chiselapp.com/user/andreas_kupries/repository/Kettle
kettle ignore += doc-parts/*

kettle tcl
kettle tclapp kettle







>


1
2
3
4
5
6
7
8
9
10
#!/bin/sh
# -*- tcl -*- \
exec ./kettle -f "$0" "${1+$@}"
# For kettle sources, documentation, etc. see
# - http://core.tcl.tk/akupries/kettle
# - http://chiselapp.com/user/andreas_kupries/repository/Kettle
kettle ignore += doc-parts/*
kettle ignore += support/*
kettle tcl
kettle tclapp kettle

Changes to kettle.tcl.

67
68
69
70
71
72
73




74
75
76
77
78
79
80
...
110
111
112
113
114
115
116


117
118
119
120
121
122
123
...
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
## @owns: tclapp.tcl
## @owns: testsuite.tcl
## @owns: tool.tcl
## @owns: try.tcl

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





## The next two files are not sourced as part of the kettle application.
##
# The first is the main entry point for the 'test' and related
# recipes, i.e. the application running a specific .test file. It is
# used to communicate build configuration data into the test
# environment.
##
................................................................................
    # # ## ### ##### ######## ############# #####################
    source $selfdir/status.tcl     ; # General goal status.
    source $selfdir/path.tcl       ; # General path utilities.
    source $selfdir/mdref.tcl      ; # Teapot pkg ref utilities.
    source $selfdir/meta.tcl       ; # Teapot meta data utilities.
    source $selfdir/ovalidate.tcl  ; # Option Validation sub layer.
    source $selfdir/options.tcl    ; # Option management.


    # # ## ### ##### ######## ############# #####################
    source $selfdir/recipes.tcl    ; # Recipe management.
    source $selfdir/invoke.tcl     ; # Goal recursion via sub-processes.
    source $selfdir/tool.tcl       ; # Manage tool requirements.
    source $selfdir/stream.tcl     ; # Log streams
    # # ## ### ##### ######## ############# #####################
    source $selfdir/gui.tcl        ; # GUI support.
................................................................................
    source $selfdir/benchmarks.tcl ; # benchmarks    (tclbench)
    # # ## ### ##### ######## ############# #####################
    source $selfdir/doc.tcl        ; # documentation (doctools, gh-pages)
    # # ## ### ##### ######## ############# #####################
    source $selfdir/tcl.tcl        ; # tcl packages
    source $selfdir/critcl.tcl     ; # critcl v3 packages
    # # ## ### ##### ######## ############# #####################
    kettle::option::set @kettledir $selfdir
}} [file dirname [file normalize [info script]]]

# # ## ### ##### ######## ############# #####################
## Ready

package provide kettle 1
return

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







>
>
>
>







 







>
>







 







<





|



67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
...
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
...
141
142
143
144
145
146
147

148
149
150
151
152
153
154
155
156
## @owns: tclapp.tcl
## @owns: testsuite.tcl
## @owns: tool.tcl
## @owns: try.tcl

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

## @owns: support

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

## The next two files are not sourced as part of the kettle application.
##
# The first is the main entry point for the 'test' and related
# recipes, i.e. the application running a specific .test file. It is
# used to communicate build configuration data into the test
# environment.
##
................................................................................
    # # ## ### ##### ######## ############# #####################
    source $selfdir/status.tcl     ; # General goal status.
    source $selfdir/path.tcl       ; # General path utilities.
    source $selfdir/mdref.tcl      ; # Teapot pkg ref utilities.
    source $selfdir/meta.tcl       ; # Teapot meta data utilities.
    source $selfdir/ovalidate.tcl  ; # Option Validation sub layer.
    source $selfdir/options.tcl    ; # Option management.
    # # ## ### ##### ######## ############# #####################
    kettle::option::set @kettledir $selfdir
    # # ## ### ##### ######## ############# #####################
    source $selfdir/recipes.tcl    ; # Recipe management.
    source $selfdir/invoke.tcl     ; # Goal recursion via sub-processes.
    source $selfdir/tool.tcl       ; # Manage tool requirements.
    source $selfdir/stream.tcl     ; # Log streams
    # # ## ### ##### ######## ############# #####################
    source $selfdir/gui.tcl        ; # GUI support.
................................................................................
    source $selfdir/benchmarks.tcl ; # benchmarks    (tclbench)
    # # ## ### ##### ######## ############# #####################
    source $selfdir/doc.tcl        ; # documentation (doctools, gh-pages)
    # # ## ### ##### ######## ############# #####################
    source $selfdir/tcl.tcl        ; # tcl packages
    source $selfdir/critcl.tcl     ; # critcl v3 packages
    # # ## ### ##### ######## ############# #####################

}} [file dirname [file normalize [info script]]]

# # ## ### ##### ######## ############# #####################
## Ready

package provide kettle 2
return

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

Changes to recipes.tcl.

1
2
3












4
5
6
7
8
9
10
# -*- tcl -*- Copyright (c) 2012 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Recipe management commands. Core definition and execution.













# # ## ### ##### ######## ############# #####################
## Export (internals - recipe definition code, higher control).

namespace eval ::kettle::recipe {
    namespace export {[a-z]*}
    namespace ensemble create



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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# -*- tcl -*- Copyright (c) 2012 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Recipe management commands. Core definition and execution.

# # ## ### ##### ######## ############# #####################
## Import a generic command line processing framework.
## Try to use whatever the installation supplies first.
## On failure fall back to the local copy of the framework.

try {
    package require cmdr
} on error {e o} {
    lappend auto_path [kettle option get @kettledir]/support
    package require cmdr
}

# # ## ### ##### ######## ############# #####################
## Export (internals - recipe definition code, higher control).

namespace eval ::kettle::recipe {
    namespace export {[a-z]*}
    namespace ensemble create

Added support/README.txt.













>
>
>
>
>
>
1
2
3
4
5
6
Local copy of cmdr framework, revision [d46922cc52]
Manual package index file.

=== 2013-12-18 ===
20:29:37 [d46922cc52] *CURRENT* Fix broken requirements cmdr::help::json and
         *::sql. Were not updated to v1. (user: andreask tags: trunk)

Added support/actor.tcl.

























































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
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
314
315
316
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Actor - Command execution. Base.
##                Actors know how to do something.

# @@ Meta Begin
# Package cmdr::actor 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Internal. Base class for officers and privates.
# Meta description Internal. Base class for officers and privates.
# Meta subject {command line}
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require TclOO
# @@ Meta End

## Two types:
## - Privates know to do one thing, exactly, and nothing more.
##   They can process their command line to extract/validate
##   the inputs they need for their action from the arguments.
#
## - Officers can learn to do many things, by delegating things to the
##   actors actually able to perform it.

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

package require Tcl 8.5
package require debug
package require debug::caller
package require TclOO

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

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

# # ## ### ##### ######## ############# #####################
## Definition - Single purpose command.

oo::class create ::cmdr::actor {
    # # ## ### ##### ######## #############
    ## Lifecycle

    constructor {} {
	debug.cmdr/actor {}
	set myname        {}
	set mydescription {}
	set mydocumented  yes
	set mysuper       {}
	set mystore       {}
	return
    }

    # # ## ### ##### ######## #############
    ## Public API: Common actor attributes and behaviour
    ## - Name.
    ## - Description (help information).
    ## - Chain of command.
    ## - Associative data store

    method name {} {
	return $myname
    }

    method dname {} {
	::list {*}[my get *prefix*] $myname
    }

    method fullname {} {
	set result {}
	if {$mysuper ne {}} {
	    lappend result {*}[$mysuper fullname]
	}
	lappend result $myname
	return $result
    }

    method name: {thename} {
	debug.cmdr/actor {}
	set myname $thename
	return
    }

    method description {} {
	my Setup ; # Calls into the derived class
	return $mydescription
    }

    method description: {text} {
	debug.cmdr/actor {}
	set mydescription [string trim $text]
	return
    }

    method documented {} {
	debug.cmdr/actor {}
	my Setup ; # Calls into the derived class
	return $mydocumented
    }

    method undocumented {} {
	debug.cmdr/actor {}
	set mydocumented no
	return
    }

    method super {} {
	return $mysuper
    }

    method super: {thesuper} {
	set mysuper $thesuper
	return
    }

    method root {} {
	if {$mysuper ne {}} {
	    return [$mysuper root]
	}
	return [self]
    }

    method keys {} {
	debug.cmdr/actor {}
	my Setup
	set result [dict keys $mystore]
	if {$mysuper ne {}} {
	    lappend result {*}[$mysuper keys]
	    set result [lsort -unique $result]
	}
	return $result
    }

    method exists {key} {
	debug.cmdr/actor {}
	my Setup
	set ok [dict exists $mystore $key]
	if {!$ok && ($mysuper ne {})} {
	    return [$mysuper exists $key]
	}
	return $ok
    }

    method get {key} {
	debug.cmdr/actor {}
	my Setup ; # Call into derived class.

	# Satisfy from local store first ...
	if {[dict exists $mystore $key]} {
	    return [dict get $mystore $key]
	}
	# ... then ask in the chain of command ...
	if {$mysuper ne {}} {
	    return [$mysuper get $key]
	}
	# ... and fail if we are at the top.
	return -code error -errorcode {CMDR STORE UNKNOWN} \
	    "Expected known key for get, got \"$key\""
    }

    method set {key data} {
	debug.cmdr/actor {}
	dict set mystore $key $data
	return
    }

    method lappend {key data} {
	debug.cmdr/actor {}
	catch { set value [my get $key] }
	lappend value $data
	dict set mystore $key $value
	return
    }

    method unset {key} {
	debug.cmdr/actor {}
	dict unset mystore $key
	return
    }

    # # ## ### ##### ######## #############
    ## Public APIs:
    ## Overridden by sub-classes.

    # - Perform an action.
    # - Return help information about the action.

    method do   {args} {}
    method help {{prefix {}}} {}

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

    variable myname mydescription mydocumented mysuper mystore

    # # ## ### ##### ######## #############
    ## Helper methods common to command completion in actors.

    method Quote {word} {
	# Check if word contains special characters, and quote it to
	# prevent special interpretation of these characters, if so.
	if {
	    [string match "*\[ \"'()\$\|\{\}\]*" $word] ||
	    [string match "*\]*"                 $word] ||
	    [string match "*\[\[\]*"             $word]
	} {
	    set map [list \" \\\"]
	    return \"[string map $map $word]\"
	} else {
	    return $word
	}
    }

    method completions {parse cmdlist} {
	debug.cmdr/actor {} 10
	# Quick exit if there is nothing to complete.
	if {![llength $cmdlist]} {
	    return $cmdlist
	}

	dict with parse {}
	# -> line, words (ignored: ok, nwords, at, doexit)

	# The -> cmd is a valid completion of the line.  The actual
	# completion is the line itself, plus the command.  Note that
	# we have to chop off the incomplete part of cmd in the line
	# before adding the complete command.
	#
	# Example:
	# line       = "foo b"
	# cmd            = "bar"
	# completion = "foo bar"

	# Determine the chop point, then chop: Just before the first
	# character of the last word. Which is a prefix to all
	# commands in the list.
	set  chop [lindex $words end 1]
	incr chop -1
	set line [string range $line 0 $chop]

	set completions {}
	foreach cmd $cmdlist {
	    set cmd [my Quote $cmd]
	    # Chop and complete.
	    lappend completions $line$cmd
	}
	return $completions
    }

    # Could possibly use 'struct::list filter', plus a lambda.
    method match {parse cmdlist} {
	debug.cmdr/actor {} 10
	# Quick exit if nothing can match.
	if {![llength $cmdlist]} {
	    return $cmdlist
	}

	dict with parse {}
	# -> words, at (ignored: ok, nwords, line, doexit)

	# We need just the text of the current word.
	set current [lindex $words $at end]

	set filtered {}
	foreach cmd $cmdlist {
	    if {![string match ${current}* $cmd]} continue
	    lappend filtered $cmd
	}
	return $filtered
    }

    method parse-line {line} {
	debug.cmdr/actor {} 10
	set ok    1
	set words {}

	try {
	    set words [string token shell -partial -indices $line]
	} trap {STRING TOKEN SHELL BAD} {e o} {
	    set ok 0
	}

	set len [string length $line]

	if {$ok} {
	    # last word, end index
	    set lwe [lindex $words end 2]
	    # last word ends before end of line -> trailing whitespace
	    # add the implied empty word for the completion processing.
	    if {$lwe < ($len-1)} {
		lappend words [list PLAIN $len $len {}]
	    }
	}
	set parse [dict create \
		       doexit 1 \
		       at     0 \
		       line   $line \
		       ok     $ok \
		       words  $words \
		       nwords [llength $words]]

	return $parse
    }

    ##
    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::actor 1.0

Added support/cmdr.tcl.





























































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Command dispatcher framework.
## Knows about officers and privates.
## Encapsulates the creation of command hierachies.

# @@ Meta Begin
# Package cmdr 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary Main entry point to the commander framework.
# Meta description A framework for the specification and
# Meta description use of complex command line processing.
# Meta subject {command line} delegation dispatch options arguments
# Meta require TclOO
# Meta require cmdr::officer
# Meta require debug
# Meta require debug::caller
# Meta require {Tcl 8.5-}
# @@ Meta End

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

package require Tcl 8.5
package require debug
package require debug::caller
package require TclOO
package require cmdr::officer

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

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

# # ## ### ##### ######## ############# #####################
## Definition

namespace eval ::cmdr {
    namespace export new create interactive interactive?
    namespace ensemble create

    # Generally interaction is possible.
    variable interactive 1
}

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

proc ::cmdr::new {name spec} {
    debug.cmdr/main {}
    return [cmdr::officer new {} $name $spec]
}

proc ::cmdr::create {obj name spec} {
    debug.cmdr/main {}
    # Uplevel to ensure proper namespace for the 'obj'.
    return [uplevel 1 [list cmdr::officer create $obj {} $name $spec]]
}

# # ## ### ##### ######## ############# #####################
## Global interactivity configuration.

proc ::cmdr::interactive {{enable 1}} {
    debug.cmdr/main {}
    variable interactive $enable
    return
}

proc ::cmdr::interactive? {} {
    variable interactive
    return  $interactive
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr 1.0

Added support/config.tcl.













































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
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
314
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
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Config - Collection of argument values for a private.

# @@ Meta Begin
# Package cmdr::config 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Internal. Collection of parameters for cmd::private instances.
# Meta description Internal. Collection of parameters for cmd::private instances.
# Meta subject {command line}
# Meta require TclOO
# Meta require cmdr::help
# Meta require cmdr::parameter
# Meta require cmdr::util
# Meta require cmdr::validate
# Meta require debug
# Meta require debug::caller
# Meta require linenoise::facade
# Meta require term::ansi::code::ctrl
# Meta require try
# Meta require {Tcl 8.5-}
# Meta require {oo::util 1.2}
# Meta require {struct::queue 1}

# @@ Meta End

## - The config manages the argument values, and can parse
##   a command line against the definition, filling values,
##   issuing errors on mismatches, etc.

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

package require Tcl 8.5
package require debug
package require debug::caller
package require linenoise::facade
package require struct::queue 1 ; #
package require term::ansi::code::ctrl
package require try
package require TclOO
package require oo::util 1.2      ; # link helper
package require cmdr::help
package require cmdr::parameter   ; # Parameter to collect
package require cmdr::util
package require cmdr::validate    ; # Core validation types.

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

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

# # ## ### ##### ######## ############# #####################
## Definition

oo::class create ::cmdr::config {
    # # ## ### ##### ######## #############

    classmethod interactive {{value 1}} {
	variable ourinteractive $value
	return
    }

    classmethod display {cmdprefix} {
	variable ourdisplay $cmdprefix
	return
    }

    method display {{plist {}}} {
	if {![llength $plist]} {
	    set plist [my Visible]
	}
	set plist [lsort -dict $plist]
	return [{*}$mydisplay $plist]
    }

    # # ## ### ##### ######## #############
    ## Lifecycle.

    forward context context

    # Make self accessible.
    method self {} { self }

    constructor {context spec} {
	debug.cmdr/config {}

	classvariable ourinteractive
	if {![info exists ourinteractive]} { set ourinteractive 0 }

	classvariable ourdisplay
	if {[info exists ourdisplay]} {
	    set mydisplay $ourdisplay
	} else {
	    set mydisplay [mymethod PrintState]
	}

	my Colors

	# Import the context (cmdr::private).
	interp alias {} [self namespace]::context {} $context

	# Initialize collection state.
	set myinteractive $ourinteractive
	set mynames    {} ;# list of parameter names
	set mymap      {} ;# parameter name -> object
	set mypub      {} ;# parameter name -> object, non-state only, i.e. user visible
	set myoption   {} ;# option         -> object
	set myfullopt  {} ;# option prefix  -> list of full options having that prefix.
	set myargs     {} ;# List of argument names.
	set mysections {}
	set myinforce  no

	# Import the DSL commands.
	link \
	    {undocumented Undocumented} \
	    {description  Description} \
	    {use          Use} \
	    {input        Input} \
	    {interactive  Interactive} \
	    {option       Option} \
	    {state        State} \
	    {section      Section}

	# Updated in my DefineParameter, called from the $spec
	set splat no

	# Auto inherit common options, state, arguments.
	# May not be defined.
	catch { use *all* }
	eval $spec

	# Postprocessing

	my SetThresholds
	my UniquePrefixes
	my CompletionGraph

	set mypq [struct::queue P] ;# actual parameters
	if {[llength $myargs]} {
	    set myaq [struct::queue A] ;# formal argument parameters
	}
	return
    }

    method help {{mode public}} {
	debug.cmdr/config {}
	# command   = dict ('desc'       -> description
	#                   'options'    -> options
	#                   'arguments'  -> arguments
	#                   'parameters' -> parameters)
	# options   = list (name -> desc)   // name -> index into parameters
	# arguments = list (argument-name...) // name -> index into parameters
	# code in {
	#     +		<=> required
	#     ?		<=> optional
	#     +*	<=> required splat
	#     ?* 	<=> optional splat
	# }
	# parameters = dict (name -> param-def)
	# param-def  = dict (key -> value) // include code
	#
	# Option aliases are listed in options, but not in parameters.

	set options {}
	dict for {o para} $myoption {
	    # in interactive mode undocumented options can be shown in
	    # the help if they already have a value defined for them.
	    if {![$para documented] &&
		(($mode ne "interact") ||
		 ![$para set?])} continue

	    # in interactive mode we skip all the aliases.
	    if {($mode eq "interact") &&
		![$para primary $o]} continue
	    dict set options $o [$para description $o]
	    dict set optpara $o [$para name]
	}

	# Order not required of the structure, improves testability
	set options [cmdr util dictsort $options]
	set optpara [cmdr util dictsort $optpara]

	set arguments $myargs
	set sections  $mysections

	# Full dump of the parameter definitions. Unusual formats
	# (SQL, json) may wish to have acess to all of a parameter,
	# not just bits and pieces.

	set states     {}
	set parameters {}

	foreach p [lsort -dict $mynames] {
	    set para [dict get $mymap $p]
	    dict set parameters $p [$para help]

	    if {![$para is state]} continue
	    lappend states $p
	}

	return [dict create \
		    desc       [context description] \
		    options    $options \
		    opt2para   $optpara \
		    arguments  $arguments \
		    states     $states \
		    parameters $parameters \
		    sections   $sections]
    }

    method interactive {} { return $myinteractive }
    method eoptions    {} { return $myfullopt }
    method names       {} { return [dict keys $mymap] }
    method public      {} { return [dict keys $mypub] }
    method arguments   {} { return $myargs }
    method options     {} { return [dict keys $myoption] }

    method lookup {name} {
	debug.cmdr/config {}
	if {![dict exists $mymap $name]} {
	    set names [linsert [join [lsort -dict [my names]] {, }] end-1 or]
	    return -code error -errorcode {CMDR CONFIG PARAMETER UNKNOWN} \
		"Got \"$name\", expected parameter name, one of $names"
	}
	return [dict get $mymap $name]
    }

    method has {name} {
	debug.cmdr/config {}
	# Accept foo, and @foo.
	if {[regexp {^@(.*)$} $name -> namex]} {
	    set name $namex
	}
	return [dict exists $mymap $name]
    }

    method lookup-option {name} {
	debug.cmdr/config {}
	if {![dict exists $myoption $name]} {
	    set names [linsert [join [lsort -dict [my options]] {, }] end-1 or]
	    return -code error -errorcode {CMDR CONFIG PARAMETER UNKNOWN} \
		"Got \"$name\", expected option name, one of $names"
	}
	return [dict get $myoption $name]
    }

    method force {{allowinteract yes} {forcedefered no}} {
	debug.cmdr/config {}
	my Force $allowinteract $forcedefered
	return
    }

    method Force {allowinteract forcedefered} {
	debug.cmdr/config {recursive=$myinforce}
	# Define the values of all parameters.
	# Done in order of declaration.
	# Any dependencies between parameter can be handled by proper
	# declaration order.

	if {$myinforce} return
	set myinforce yes

	foreach name $mynames {
	    set para [dict get $mymap $name]

	    # Ignore parameters which defer value generation until
	    # actual use, except if we are forced to compute them.
	    if {!$forcedefered && [$para defered]} continue

	    if {!$allowinteract} {
		$para dontinteract
	    }
	    try {
		$para value
	    } trap {CMDR PARAMETER UNDEFINED} {e o} {
		# Ignore when a parameter was not defined.
		# Note that this is transparent to validation
		# errors.
	    }
	}

	set myinforce no
	return
    }

    method reset {} {
	debug.cmdr/config {}
	dict for {name para} $mymap {
	    $para reset
	}
	return
    }

    method forget {} {
	debug.cmdr/config {}
	if {$myinforce} return
	dict for {name para} $mymap {
	    $para forget
	}
	return
    }

    # # ## ### ##### ######## #############
    ## API for use by the actual command run by the private, and by
    ## the values in the config (which may request other values for
    ## their validation, generation, etc.). Access to argument values by name.

    method unknown {m args} {
	debug.cmdr/config {}
	if {![regexp {^@(.*)$} $m -> mraw]} {
	    # Standard error message when not @name ...
	    next $m {*}$args
	    return
	}
	# @name ... => handlerof(name) ...
	if {![llength $args]} { lappend args value }
	return [[my lookup $mraw] {*}$args]
    }

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

    method SetThresholds {} {
	debug.cmdr/config {}
	# Compute the threshold needed by optional arguments to decide
	# when they can take an argument.

	# The threshold is the number of actual parameters required to
	# satisfy all _required_ arguments coming after the current
	# argument. Computed from back to front, starting with 0 (none
	# required after the last argument), this value increments for
	# each required argument found. Optional arguments do not count.

	set required 0
	#set rlist {} ; # Debugging aid

	foreach a [lreverse $myargs] {
	    set para [dict get $mymap $a]
	    $para threshold: $required
	    #lappend rlist $required
	    if {[$para required]} {
		incr required
	    }
	}

	# Debug, show mapping.
	#puts A|$myargs|
	#puts T|[lreverse $rlist]|

	return
    }

    method UniquePrefixes {} {
	debug.cmdr/config {}

	dict for {k v} $myoption {

	    # Generate all prefixes of "$k".
	    set prefix ""
	    foreach c [split $k {}] {
		append prefix $c
		# Ignore option markers as prefix.
		if {$prefix in {- --}} continue

		# Collect the prefix in fullopt, adding a mapping to
		# the full option, i.e. "$k".
		#
		# Prefixes mapping to multiple options are ambigous
		# and will cause a processing failure at runtime, i.e.
		# if used in a command line.

		# An exception are prefixes of some option A which is
		# also the exact name of option B. These are
		# non-ambigous and map to B. This exception is
		# necessary to prevent option B from getting shadowed
		# by the longer A.

		if {[dict exists $myoption $prefix]} {
		    # The prefix of the current option exists as
		    # option itself, same or other.
		    # Map to that option (not! "$k").
		    dict set myfullopt $prefix [list $prefix]
		} else {
		    # Add the current option to the mapping for the
		    # current prefix.
		    dict lappend myfullopt $prefix $k
		}
	    }
	}

	# Sort the expansions, for the error messages.
	dict for {k v} $myfullopt {
	    if {[llength $v] == 1} continue
	    dict set myfullopt $k [lsort -dict $v]
	}

	#array set _o $myoption  ; parray _o ; unset _o
	#array set _f $myfullopt ; parray _f ; unset _f
	return
    }

    method CompletionGraph {} {
	debug.cmdr/config {}
	set next {}
	set start .(start)
	set end   .(end)

	# Basic graph, linear chain of the arguments
	foreach from [linsert $myargs 0 $start] to [linsert $myargs end $end] {
	    dict lappend next $from $to
	    # Loop the chain for a list argument.
	    if {($from ne $start) && [[dict get $mymap $from] list]} {
		dict lappend next $from $from
	    }
	} ; #my SCG $start $next chain

	# Extend the graph, adding links bypassing the optional
	# arguments.  Essentially an iterative transitive closure
	# where the epsilon links are only implied.

	set changed 1
	set handled {} ;# Track processed epsilon links to not follow
	# them again.

	while {$changed} {
	    set changed 0
	    foreach a [linsert $myargs 0 $start] {
		foreach n [dict get $next $a] {
		    if {$n eq $end} continue
		    if {[[dict get $mymap $n] required]} continue
		    if {[dict exists $handled $a,$n]} continue
		    # make sucessors of a sucessor optional argument my sucessors, once
		    dict set handled $a,$n .
		    set changed 1
		    foreach c [dict get $next $n] {
			dict lappend next $a $c
		    }
		}
	    }
	} ; #my SCG $start $next closure

	# Convert the graph into a list of states, i.e. sets of
	# arguments (note that the underlying structure is still
	# essentially linear, which the DFA from the NFA now exposes
	# again).

	set mycchain {}
	foreach a [linsert $myargs 0 $start] {
	    # Tweaks: Ensure state uniqueness, and a canoninical order.
	    set state [lsort -unique [lsort -dict [dict get $next $a]]]
	    # Remove the end state
	    set pos [lsearch -exact $state $end]
	    if {$pos >= 0} { set state [lreplace $state $pos $pos] }

	    # Loop state, list argument last.
	    if {([llength $state] == 1) && $a eq [lindex $state 0]} {
		set state ... ; # marker for stepper in complete-words.
	    }
	    lappend mycchain $state
	}

	#puts stderr \t[join $mycchain \n\t]
	return
    }

    method SCG {start next label} {
	puts stderr \n/$label
	foreach a [linsert $myargs 0 $start] {
	    puts stderr "\t($a) => [dict get $next $a]"
	}
	return
    }

    # # ## ### ##### ######## #############
    ## API for cmdr::private parameter specification DSL.

    # Description is for the context, i.e. the private.
    forward Description  context description:
    forward Undocumented context undocumented

    # Bespoke 'source' command for common specification fragments.
    method Use {name} {
	debug.cmdr/config {}
	# Pull code fragment out of the data store and run.
	uplevel 1 [context get $name]
	return
    }

    method Interactive {} {
	debug.cmdr/config {}
	set myinteractive 1
	return
    }

    method Section {args} {
	# Remember the help section this private is a part of.
	lappend mysections $args
	return
    }

    # Parameter definition itself.
    # order, cmdline, required, defered (O C R D) name ?spec?
    forward Input     my DefineParameter 1 1 1 0
    forward Option    my DefineParameter 0 1 0 0
    forward State     my DefineParameter 0 0 1 1
    # O+C+R specify the parameter type. D may vary.

    method DefineParameter {
	order cmdline required defered
	name desc {spec {}}
    } {
	debug.cmdr/config {}

	upvar 1 splat splat
	if {$splat && $order} {
	    return -code error -errorcode {CMDR CONFIG SPLAT ORDER} \
		"A splat must be the last argument in the specification"
	}

	my ValidateAsUnknown $name

	# Create and initialize handler.
	set para [cmdr::parameter create param_$name [self] \
		      $order $cmdline $required $defered \
		      $name $desc $spec]

	# Map parameter name to handler object.
	dict set mymap $name $para

	# And a second map, user-visible parameters only,
	# i.e. available on the cmdline, and documented.
	if {[$para cmdline] && [$para documented]} {
	    dict set mypub $name $para
	}

	if {$order} {
	    # Arguments, keep names, in order of definition
	    lappend myargs $name
	    set splat [$para list]
	} else {
	    # Keep map of options to their handlers.
	    foreach option [$para options] {
		dict set myoption $option $para
	    }
	}

	# And the list of all parameters in declaration order, for use
	# in 'force'.
	lappend mynames $name
	return
    }

    method ValidateAsUnknown {name} {
	debug.cmdr/config {}
	if {![dict exists $mymap $name]} return
	return -code error -errorcode {CMDR CONFIG KNOWN} \
	    "Duplicate parameter \"[context fullname]: $name\", already specified."
    }

    # # ## ### ##### ######## #############
    ## Command completion. This is the entry point for recursion from
    ## the higher level officers, delegated to config from cmdr::private

    ## Note that command completion for the REPL of the private is
    ## handled by the internal cmdr::config instance, which also manages
    ## the REPL itself.

    method complete-words {parse} {
	debug.cmdr/config {} 10

	dict with parse {}
	# -> ok, at, nwords, words, line

	#puts ?|$ok
	#puts @|$at
	#puts #|$nwords
	#puts =|$words|
	#puts L|$line|

	# The basic idea is to scan over the words, like with 'parse',
	# except that instead of letting the parameters taking their
	# values we keep track of which parameters could have been
	# set. To avoid complexities here we use the mycchain computed
	# by CompletionGraph to know the set of possible parameters,
	# simply stepping through.

	# at = word in the command line we are at.
	# ac = state in the completion chain we are at.
	# st = processing state

	set ac 0    ;# parameters which can be expected at this position
	set st none ;# expect an argument word
	set current [lindex $words $at end]

	while {$at < ($nwords-1)} {
	    if {$st eq "eov"} {
		# Skip over the option value
		set st none
		incr at
		continue
	    }

	    # We need just the text of the current word.
	    set current [lindex $words $at end]

	    if {[my IsOption $current implied]} {
		if {!$implied} {
		    # Expect next word to be an option value.
		    set st eov
		}
	    } else {
		# Step to the chain state for the next word.
		# Note how we bounce back on the loop/list marker.
		incr ac
		if {[lindex $mycchain $ac] eq "..."} { incr ac -1 }
	    }
	    # Step to the next word
	    incr at
	}

	# assert (at == (nwords-1))
	# We are now on the last word, and the system state tells us
	# what we can expect in terms of parameters and such.

	set state [lindex $mycchain $ac]
	dict set parse at $at

	#puts '|$current|
	#puts @|$at|
	#puts c|$ac|
	#puts x|$state|
	#puts s|$st|

	if {$st eq "eov"} {
	    # The last word is an option value, possible incomplete.
	    # The value of 'current' still points to the option name.
	    # Determine the responsible parameter, and delegate.

	    # Unknown option, unable to complete the value.
	    if {![dict exists $myfullopt $current]} { return {} }

	    # Ambiguous option name, unable to complete value.
	    set matches [dict get $myfullopt $current]
	    if {[llength $matches] > 1} { return {} }

	    # Delegate to the now known parameter for completion.
	    set match [lindex $matches 0]
	    set para  [dict get $myoption $match]
	    return [$para complete-words $parse]
	}

	# Not at option value, can be at incomplete option name, and parameters.
	set current [lindex $words $at end]

	if {$current eq {}} {
	    # All options are possible here.
	    set completions [my options]
	    # And the completeable values of the possible arguments.
	    foreach a $state {
		lappend completions {*}[[dict get $mymap $a] complete-words $parse]
	    }
	    return $completions
	}

	if {[string match -* $current]} {
	    # Can be option name, or value, if implied (special form --foo=bar).
	    if {[set pos [string first = $current]] < 0} {
		# Just option name to complete.
		return [context match $parse [my options]]
	    } else {
		set prefix [string range $current 0 $pos]
		set option [string range $prefix 0 end-1] ;# chop =

		# Unknown option, unable to complete the value.
		if {![dict exists $myfullopt $option]} { return {} }

		# Ambiguous option name, unable to complete value.
		set matches [dict get $myfullopt $option]
		if {[llength $matches] > 1} { return {} }

		# Delegate to the now known parameter for completion.
		set match [lindex $matches 0]
		set para  [dict get $myoption $match]
		incr pos
		set val [string range $curent $pos end]

		dict lappend parse words $val
		dict incr    parse at

		set completions
		foreach c [$para complete-words $parse] {
		    lappend completions $prefix$c
		}
		return $completions
	    }
	}

	# Only the completeable values of the possible arguments.
	set completions {}
	foreach a $state {
	    lappend completions {*}[[dict get $mymap $a] complete-words $parse]
	}
	return $completions
    }

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

    method IsOption {current iv} {
	debug.cmdr/config {} 10

	upvar 1 $iv implied at at nwords nwords words words
	set implied 0

	if {![string match -* $current]} {
	    # Cannot be option
	    return 0
	}

	# Is an option (even if not known).

	if {[string first = $current] >= 0} {
	    # --foo=bar special form.
	    set implied 1
	} else {
	    # Try to expand the flag and look the whole option up. If
	    # we can, check if it is boolean, and if yes, look at the
	    # next argument, if any to determine if it belongs to the
	    # option, or not. The latter then means the argument is
	    # implied.

	    set next [expr {$at+1}]
	    if {$next < $nwords} {
		# Have a following word
		if {[dict exists $myfullopt $current]} {
		    # Option is possibly known
		    set matches [dict get $myfullopt $current]
		    if {[llength $matches] == 1} {
			# Option is unambiguously known
			set match [lindex $matches 0]
			set para [dict get $myoption $match]
			if {[$para isbool]} {
			    # option is boolean
			    set next [lindex $words $next end]
			    if {![string is boolean $next]} {
				# next word is not boolean => value is implied.
				# note that we are non-strict here.
				# an empty word is treated as boolean to be completed, not implied.
				set implied 1
			    }
			}
		    }
		}
	    }
	}
	return 1
    }

    # # ## ### ##### ######## #############
    ## API for cmdr::private use of the arguments.
    ## Runtime parsing of a command line, parameter extraction.

    method parse-options {} {
	debug.cmdr/config {}

	# The P queue contains a mix of options and arguments.  An
	# optional argument was encountered and has called on this to
	# now process all options so that it can decode wether to take
	# the front value for itself or not. The front value is
	# definitely not an option.

	# Nothing to process.
	if {![P size]} {
	    debug.cmdr/config {no parameters to process}
	    return
	}

	# Unshift the front value under consideration by
	# 'cmdr::parameter Take'.

	lappend arguments [P get]

	# Process the remainder for options and their values.
	while {[P size]} {
	    set word [P peek]
	    if {[string match -* $word]} {
		my ProcessOption
		continue
	    }
	    lappend arguments [P get]
	}

	# Refill the queue with the arguments which remained after
	# option processing.
	if {![llength $arguments]} {
	    debug.cmdr/config {no arguments to return}
	    return
	}
	P put {*}$arguments

	debug.cmdr/config {done}
	return
    }

    method parse {args} {
	debug.cmdr/config {}

	# - Reset the state values (we might be in an interactive shell, multiple commands).
	# - Stash the parameters into a queue for processing.
	# - Stash the (ordered) arguments into a second queue.
	# - Operate on parameter and arg queues until empty,
	#   dispatching the words to handlers as needed.

	my reset
	P clear
	if {[llength $args]} { P put {*}$args }

	if {![llength $myargs]} {
	    debug.cmdr/config {options only}
	    # The command has no arguments. It may accept options.

	    while {[P size]} {
		set word [P peek]
		debug.cmdr/config {[P size] ? $word}
		if {![string match -* $word]} {
		    # Error. No regular arguments to accept.
		    my tooMany
		}
		my ProcessOption
	    }
	    return
	}

	# Process commands and flags, in order.

	A clear
	A put {*}$myargs

	debug.cmdr/config {a[A size] p[P size]}
	while {1} {
	    debug.cmdr/config {a|[expr {[A size] ? [A peek [A size]] : ""}]|}
	    debug.cmdr/config {p|[expr {[P size] ? [P peek [P size]] : ""}]|}

	    # Option ... Leaves A unchanged.
	    if {[P size]} {
		set word [P peek]
		debug.cmdr/config {[P size] ? $word}
		if {[string match -* $word]} {
		    try {
			my ProcessOption
		    } trap {CMDR CONFIG BAD OPTION} {e o} {
			# Test if we have regular arguments left, and
			# if the first of them is willing to accept
			# the word (on principle, and by type). If
			# yes, the bad option is treated as regular
			# argument.
			if {![A size] ||
			    [[dict get $mymap [A peek]] nopromote] ||
			    ![[dict get $mymap [A peek]] accept $word]} {
			    # Not accepted, throw as error.
			    return {*}$o $e
			}

			debug.cmdr/config {as argument}
			P unget $word
			my ProcessArgument
		    }
		    continue
		}
	    } else break

	    # Out of arguments, yet still getting a non-option word.
	    if {![A size]} { my tooMany }

	    my ProcessArgument

	    if {![P size]} break
	}

	# At this point P is empty. A may not be.  That is ok if the
	# remaining A's are optional.  Simply scan them, those which
	# are mandatory will throw the necessary error.

	debug.cmdr/config {remainder: [A size]}
	while {[A size]} {
	    set argname [A get]
	    debug.cmdr/config {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
	    debug.cmdr/config {$argname, a[A size] p[P size]}
	    [dict get $mymap $argname] process $argname $mypq
	    debug.cmdr/config {/////////////////////////////////}
	}

	debug.cmdr/validate {done remainder}
	#puts "a[A size] p[P size]"

	# End conditions:
	# P left, A empty. - wrong#args, too many.
	# A left, P empty. - wrong#args, not enough.
	# A, P empty.      - OK

	# Note that 'not enough' should not be reached here, but in
	# the parameter instances. I.e. early.

	if {![A size] && [P size]} { my tooMany   }
	if {![P size] && [A size]} { my notEnough }

	# XXX Go through the regular arguments and validate them?
	# XXX Or can we assume that things will work simply through
	# XXX access by the command ?

	debug.cmdr/config {/done all}
	return
    }

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

    method ProcessArgument {} {
	debug.cmdr/config {}
	# Note: The parameter instance is responsible for retrieving
	# its value from the parameter queue. It may pass on this.
	# This also checks if there is enough in the P queue, aborting
	# if not.

	set argname [A get]
	#puts [A size]|$argname|[P size]
	[dict get $mymap $argname] process $argname $mypq
	#puts \t==>[P size]
	return
    }

    method ProcessOption {} {
	debug.cmdr/config {}
	# Get option. Do special handling.
	# Non special option gets dispatched to handler (cmdr::parameter instance).
	# The handler is responsible for retrieved the option's value.
	set option [P get]

	# Handle general special forms:
	#
	# --foo=bar ==> --foo bar
	# -f=bar    ==> -f bar

	if {[regexp {^(-[^=]+)=(.*)$} $option --> option value]} {
	    P unget $value
	}

	# Validate existence of the option
	if {![dict exists $myfullopt $option]} {
	    my raise "Unknown option $option" \
		CMDR CONFIG BAD OPTION
	}

	# Map from option prefix to full option
	set options [dict get $myfullopt $option]
	if {[llength $options] > 1} {
	    my raise "Ambiguous option prefix $option, matching [join $options {, }]" \
		CMDR CONFIG AMBIGUOUS OPTION
	}

	# Now map the fully expanded option name to its handler and
	# let it deal with the remaining things, including retrieval
	# of the option argument (if any), validation, etc.

	[dict get $myoption [lindex $options 0]] process $option $mypq
	return
    }

    method tooMany {} {
	debug.cmdr/config {}
	my raise "wrong#args, too many" \
	    CMDR CONFIG WRONG-ARGS TOO-MANY
    }

    method notEnough {} {
	debug.cmdr/config {}
	my raise "wrong#args, not enough" \
	    CMDR CONFIG WRONG-ARGS NOT-ENOUGH
    }

    method missingOptionValue {name} {
	debug.cmdr/config {}
	my raise "wrong#args, missing value for option '$name'" \
	    CMDR CONFIG WRONG-ARGS OPTION NOT-ENOUGH
    }

    method Help {name {mode public}} {
	return [cmdr help format full \
		    [context root] \
		    [linenoise columns] \
		    [dict create $name \
			 [my help $mode]]]
    }

    method raise {msg args} {
	debug.cmdr/config {}
	if {[context exists *prefix*]} {
	    append msg \n\n[my Help [context get *prefix*]]
	}
	return -code error -errorcode $args $msg
    }

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

    variable mymap mypub myoption myfullopt myargs mynames \
	myaq mypq mycchain myreplexit myreplok myreplcommit \
	myreset myred mygreen mycyan myinteractive myinforce \
	mydisplay myreplskip mysections

    # # ## ### ##### ######## #############
    ## Local shell for interactive entry of the parameters in the collection.

    method interact {} {
	debug.cmdr/config {}
	# compare cmdr::officer REPL (=> method "do").

	set shell [linenoise::facade new [self]]
	set myreplexit   0 ; # Flag: Stop repl, not yet.
	set myreplok     0 ; # Flag: We can't commit properly
	set myreplcommit 0 ; # Flag: We are not asked to commit yet.
	set myreplskip   0 ; # Flag: Do not report.

	my ShowState

	$shell history 1
	[context root] set *in-shell* true
	try {
	    $shell repl
	} trap {CMDR CONFIG INTERACT CANCEL} {e o} {
	    return 0
	} trap {CMDR CONFIG INTERACT OK} {e o} {
	    if {!$myreplok} {
		# Bad commit with incomplete data.
		my raise "Unable to perform \"[context fullname]\", incomplete or bad arguments" \
		    CMDR CONFIG COMMIT FAIL
	    }
	    return 1
	} finally {
	    [context root] set *in-shell* false
	    $shell destroy
	}

	# Regular return indicates abort (^D), treat as cancellation.
	return 0
    }

    # # ## ### ##### ######## #############
    ## Shell hook methods called by the linenoise::facade.

    method prompt1   {}     { return "[context dname] > " }
    method prompt2   {}     { error {Continuation lines are not supported} }
    method continued {line} { return 0 }
    method exit      {}     { return $myreplexit }

    method dispatch {cmd} {
	debug.cmdr/config {}

	if {$cmd eq {}} {
	    # No command, do nothing.
	    set myreplskip 1
	    return
	}

	switch -exact -- $cmd {
	    .run - .ok {
		set myreplexit   1
		set myreplcommit 1
		return
	    }
	    .exit - .cancel {
		set myreplexit 1
		return
	    }
	    .help {
		puts [my Help [context dname] interact]
		return
	    }
	}

	set words [lassign [string token shell $cmd] cmd]
	# cmd = parameter name, words = parameter value.
	# Note: Most pseudo commands take a single argument!
	#       Presence-only options are the exception.
	# Note: The lookup accepts the undocumented parameters as
	#       well, despite them not shown by ShowState, nor
	#       available for completion.

	set para [my lookup $cmd]

	if {[$para presence] && ([llength $words] != 0)} {
	    return -code error -errorcode {CMDR CONFIG WRONG ARGS} \
		"wrong \# args: should be \"$cmd\""
	}
	if {[llength $words] < 1} {
	    $para interact
	    return
	}
	if {![$para list] && [llength $words] > 1} {
	    return -code error -errorcode {CMDR CONFIG WRONG ARGS} \
		"wrong \# args: should be \"$cmd value\""
	}

	# cmd is option => Add the nessary dashes? No. Only needed for
	# boolean special form, and direct interaction does not allow
	# that.

	if {[$para presence]} {
	    # See also cmdr::parameter/ProcessOption
	    $para set yes
	} elseif {[$para list]} {
	    foreach w $words { $para set $w }
	} else {
	    $para set {*}$words
	}
	return
    }

    method report {what data} {
	debug.cmdr/config {}

	if {$myreplskip} {
	    set myreplskip 0
	    return
	}

	if {$myreplexit} {
	    if {$myreplcommit} {
		return -code error -errorcode {CMDR CONFIG INTERACT OK} ""
	    } else {
		return -code error -errorcode {CMDR CONFIG INTERACT CANCEL} ""
	    }
	}

	my ShowState
	switch -exact -- $what {
	    ok {
		if {$data eq {}} return
		puts stdout $data
	    }
	    fail {
		puts stderr $data
	    }
	    default {
		return -code error \
		    "Internal error, bad result type \"$what\", expected ok, or fail"
	    }
	}
    }

    # # ## ### ##### ######## #############
    # Shell hook method - Command line completion.

    method complete {line} {
	debug.cmdr/config {} 10
	#puts stderr ////////$line
	try {
	    set completions [my complete-repl [context parse-line $line]]
	} on error {e o} {
	    puts stderr "ERROR: $e"
	    puts stderr $::errorInfo
	    set completions {}
	}
	#puts stderr =($completions)
	return $completions
    }

    method complete-repl {parse} {
	debug.cmdr/config {} 10
	#puts stderr [my fullname]/[self]/$parse/

	dict with parse {}
	# -> line, words, nwords, ok, at, doexit

	if {!$ok} {
	    #puts stderr \tBAD
	    return {}
	}

	# All arguments and options are (pseudo-)commands.
	# The special exit commands as well.
	set     commands [my Visible]
	lappend commands .ok     .run
	lappend commands .cancel .exit
	lappend commands .help

	set commands [lsort -unique [lsort -dict $commands]]

	if {$line eq {}} {
	    return $commands
	}

	if {$nwords == 1} {
	    # Match among the arguments, options, and specials
	    return [context completions $parse [context match $parse $commands]]
	}

	if {$nwords == 2} {
	    # Locate the responsible parameter and let it complete.
	    # Note: Here we non-public parameters as well.

	    set matches [context match $parse [my names]]

	    if {[llength $matches] == 1} {
		# Proper subordinate found. Delegate. Note: Step to next
		# word, we have processed the current one, the command.
		dict incr parse at
		set para [my lookup [lindex $matches 0]]

		# Presence-only options do not have an argument to complete.
		if {[$para presence]} {
		    return {}
		}
		return [context completions $parse [$para complete-words $parse]]
	    }

	    # No completion if nothing found, or ambiguous.
	    return {}
	}

	# No completion beyond the command and 1st argument.
	return {}
    }

    method Visible {} {
	set visible {}
	foreach p [my names] {
	    if {![dict exists $mypub $p] &&
		![[my lookup $p] set?]
	    } continue
	    # Keep public elements, and any hidden ones already having
	    # a user definition. The user obviously knows about them.
	    lappend visible $p
	}
	return $visible
    }

    method dump {} {
	my PrintState [my names] 1
    }

    method ShowState {} {
	puts [my display]
	flush stdout
	return
    }

    method PrintState {plist {full 0}} {
	set header [context dname]

	set plist  [lsort -dict $plist]
	set labels [cmdr util padr $plist]
	set blank  [string repeat { } [string length [lindex $labels 0]]]

	# Recalculate the value of changed parameters. (They have
	# 'forgotten' their value due to 'set'). We disallow interaction
	# for parameters who would normally do this to gather information
	# from the user.
	my Force 0 0

	set text {}
	set alldefined 1
	set somebad    0
	foreach label $labels para $plist {
	    set para [my lookup $para]

	    set label    [string totitle $label 0 0]
	    set required [$para required]
	    set islist   [$para list]
	    set defined  [$para set?]

	    try {
		set value [$para value]
		if {$value eq {}} {
		    set value ${mycyan}<<epsilon>>${myreset}
		}
	    } trap {CMDR PARAMETER UNDEFINED} {e o} {
		# Mandatory argument, without user-specified value.
		set value "${mycyan}(undefined)$myreset"
	    } trap {CMDR VALIDATE} {e o} {
		# Any argument with a bad value.
		set value "[$para string] ${mycyan}($e)$myreset"
		set somebad 1
	    }

	    append text {    }

	    if {$required && !$defined} {
		set label ${myred}$label${myreset}
		set alldefined 0
	    } else {
		#set label "$label "
	    }

	    if {$full} {
		append label " ("
		append label [expr {[$para ordered]    ? "o":"-"}]
		append label [expr {[$para cmdline]    ? "c":"-"}]
		append label [expr {[$para list]       ? "L":"-"}]
		append label [expr {[$para presence]   ? "P":"-"}]
		append label [expr {[$para documented] ? "d":"-"}]
		append label [expr {[$para isbool]     ? "B":"-"}]
		append label [expr {[$para hasdefault] ? "D":"-"}]
		append label [expr {[$para set?]   ? "!":"-"}]
		append label [expr {[$para defered]    ? ">":"-"}]

		append label [expr {[$para required] ? "/.." : [$para threshold] < 0 ? "/pt":"/th"}]

		append label ")"
		set sfx {              }
	    } else {
		append label [expr {[$para list]       ? " L":"  "}]
		set sfx {  }
	    }

	    append text $label
	    append text { : }

	    if {!$islist} {
		append text $value
	    } else {
		set remainder [lassign $value first]
		append text $first
		foreach r $remainder {
		    append text "\n    $blank$sfx  : $r"
		}
	    }

	    append text \n
	}

	if {$somebad} {
	    set text "$header (${myred}BAD$myreset):\n$text"
	} elseif {!$alldefined} {
	    set text "$header (${myred}INCOMPLETE$myreset):\n$text"
	} else {
	    set text "$header (${mygreen}OK$myreset):\n$text"
	    set myreplok 1
	}

	return $text
    }

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

    method Colors {} {
	if {$::tcl_platform(platform) eq "windows"} {
	    set myreset ""
	    set myred   ""
	    set mygreen ""
	    set mycyan  ""
	} else {
	    set myreset [::term::ansi::code::ctrl::sda_reset]
	    set myred   [::term::ansi::code::ctrl::sda_fgred]
	    set mygreen [::term::ansi::code::ctrl::sda_fggreen]
	    set mycyan  [::term::ansi::code::ctrl::sda_fgcyan]
	}
	return
    }

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::config 1.0

Added support/help.tcl.



































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
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
314
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
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Help - Help support.

# @@ Meta Begin
# Package cmdr::help 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Internal. Utilities for help text formatting and setup.
# Meta description Internal. Utilities for help text formatting and setup.
# Meta subject {command line}
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require lambda
# Meta require linenoise
# Meta require textutil::adjust
# Meta require cmdr::util
# @@ Meta End

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

package require Tcl 8.5
package require debug
package require debug::caller
package require lambda
package require linenoise
package require textutil::adjust
package require cmdr::util

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

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

# # ## ### ##### ######## ############# #####################
## Definition

namespace eval ::cmdr {
    namespace export help
    namespace ensemble create
}

namespace eval ::cmdr::help {
    namespace export query query-actor format auto
    namespace ensemble create
}

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

proc ::cmdr::help::query {actor words} {
    debug.cmdr/help {}
    # Resolve chain of words (command name path) to the actor
    # responsible for that command, starting from the specified actor.
    # This is very much a convenience command.

    return [[query-actor $actor $words] help $words]
}

proc ::cmdr::help::query-actor {actor words} {
    debug.cmdr/help {}
    # Resolve chain of words (command name path) to the actor
    # responsible for that command, starting from the specified actor.
    # This is very much a convenience command.

    set n -1
    foreach word $words {
	if {[info object class $actor] ne "::cmdr::officer"} {
	    # Privates do not have subordinates to look up.
	    # We now have a bad command name argument to help.

	    set prefix [lrange $words 0 $n]
	    return -code error \
		-errorcode [list CMDR ACTION BAD $word] \
		"The command \"$prefix\" has no sub-commands, unexpected word \"$word\""
	}

	set actor [$actor lookup $word]
	incr n
    }

    return $actor
}

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

proc ::cmdr::help::auto {actor} {
    debug.cmdr/help {}
    # Generate a standard help command for any actor, and add it dynamically.

    # Auto create options based on the help formats found installed
    foreach c [lsort -dict [info commands {::cmdr::help::format::[a-z]*}]] {
	set format [namespace tail $c]

	# Skip the imported helper commands which are NOT formats
	if {[string match query* $format]} continue

	lappend formats --$format
	lappend options [string map [list @c@ $format] {
	    option @c@ {
		Activate @c@ form of the help.
	    } {
		presence
		when-set [lambda {p x} { $p config @format set @c@ }]
	    }}]
    }

    # Standard option for line width to format against.
    lappend options {
	option width {
	    The line width to format the help for.
	    Defaults to the terminal width, or 80 when
	    no terminal is available.
	} {
	    alias w
	    validate integer ;# better: integer > 0, or even > 10
	    generate [lambda {p} { linenoise columns }]
	}
    }
    lappend map @formats@ [linsert [join $formats {, }] end-1 and]
    lappend map @options@ [join $options \n]
    lappend map @actor@   $actor

    $actor learn [string map $map {private help {
	description {
	    Retrieve help for a command or command set.
	    Without arguments help for all commands is given.
	    The default format is --full.
	}
	@options@
	state format {
	    Format of the help to generate.
	    This field is fed by the options @formats@.
	} { default {} }
	input cmdname {
	    The entire command line, the name of the
	    command to get help for. This can be several
	    words.
	} { optional ; list }
    } {::cmdr::help::auto-help @actor@}}]
    return
}

proc ::cmdr::help::auto-help {actor config} {
    debug.cmdr/help {}

    set width  [$config @width]
    set words  [$config @cmdname]
    set format [$config @format]

    if {$format eq {}} {
	# Default depends on the presence of additional arguments, i.e. if a specific command is asked for, or not.
	if {[llength $words]} {
	    set format full
	} else {
	    set format by-category
	}
    }

    puts [format $format [$actor root] $width [cmdr util dictsort [query $actor $words]]]
    return
}

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

namespace eval ::cmdr::help::format {
    namespace export full list short by-category
    namespace ensemble create

    namespace import ::cmdr::help::query
    namespace import ::cmdr::help::query-actor
}

# Alternate formats:
# List
# Short
# By-Category
# ... entirely different formats (json, .rst, docopts, ...)
# ... See help_json.tcl, and help_sql.tcl for examples.
#

# # ## ### ##### ######## ############# #####################
## Full list of commands, with full description (text and parameters)

proc ::cmdr::help::format::full {root width help} {
    debug.cmdr/help {}

    # help = dict (name -> command)
    set result {}
    dict for {cmd desc} $help {
	lappend result [Full $width $cmd $desc]
    }
    return [join $result \n]
}

proc ::cmdr::help::format::Full {width name command} {
    # Data structure: see config.tcl,  method 'help'.
    # Data structure: see private.tcl, method 'help'.

    dict with command {} ; # -> desc, options, arguments, parameters

    # Short line.
    lappend lines \
	[string trimright \
	     "[join $name] [HasOptions $options][Arguments $arguments $parameters]"]

    if {$desc ne {}} {
	# plus description
	set w [expr {$width - 5}]
	set w [expr {$w < 1 ? 1 : $w}]
	lappend lines [textutil::adjust::indent \
			   [textutil::adjust::adjust $desc \
				-length $w -strictlength 1] \
			   {    }]
    }

    # plus per-option descriptions (sort by flag name)
    if {[dict size $options]} {
	set onames {}
	set odefs  {}
	foreach {oname ohelp} [::cmdr util dictsort $options] {
	    lappend onames $oname
	    lappend odefs  $ohelp
	}
	DefList $width $onames $odefs
    }

    # plus per-argument descriptions (keep in cmdline order)
    if {[llength $arguments]} {
	set anames {}
	set adefs  {}
	foreach aname $arguments {
	    set v [dict get $parameters $aname]
	    dict with v {} ; # -> code, description, label
	    lappend anames $label
	    lappend adefs  $description
	}
	DefList $width $anames $adefs
    }
    lappend lines ""
    return [join $lines \n]
}

# # ## ### ##### ######## ############# #####################
## List of commands. Nothing else.

proc ::cmdr::help::format::list {root width help} {
    debug.cmdr/help {}

    # help = dict (name -> command)
    set result {}
    dict for {cmd desc} $help {
	lappend result [List $width $cmd $desc]
    }
    return [join $result \n]
}

proc ::cmdr::help::format::List {width name command} {
    # Data structure: see config.tcl,  method 'help'.
    # Data structure: see private.tcl, method 'help'.

    dict with command {} ; # -> desc, options, arguments, parameters

    # Short line.
    lappend lines \
	[string trimright \
	     "    [join $name] [HasOptions $options][Arguments $arguments $parameters]"]
    return [join $lines \n]
}

# # ## ### ##### ######## ############# #####################
## List of commands with basic description. No parameter information.

proc ::cmdr::help::format::short {root width help} {
    debug.cmdr/help {}

    # help = dict (name -> command)
    set result {}
    dict for {cmd desc} $help {
	lappend result [Short $width $cmd $desc]
    }
    return [join $result \n]
}

proc ::cmdr::help::format::Short {width name command} {
    # Data structure: see config.tcl,  method 'help'.
    # Data structure: see private.tcl, method 'help'.

    dict with command {} ; # -> desc, options, arguments, parameters

    # Short line.
    lappend lines \
	[string trimright \
	     "[join $name] [HasOptions $options][Arguments $arguments $parameters]"]

    if {$desc ne {}} {
	# plus description
	set w [expr {$width - 5}]
	set w [expr {$w < 1 ? 1 : $w}]
	lappend lines [textutil::adjust::indent \
			   [textutil::adjust::adjust $desc \
				-length $w -strictlength 1] \
			   {    }]
    }
    lappend lines ""
    return [join $lines \n]
}

# # ## ### ##### ######## ############# #####################
## Show help by category/ies

proc ::cmdr::help::format::by-category {root width help} {
    debug.cmdr/help {}

    # I. Extract the category information from the help structure and
    #    generate the tree of categories with their commands.

    lassign [SectionTree $help] subc cmds

    # II. Order the main categories. Allow for user influences.
    set categories [SectionOrder $root $subc]

    # III. Take the category tree and do the final formatting.
    set lines {}
    foreach c $categories {
	ShowCategory $width lines [::list $c] ""
    }
    return [join $lines \n]
}

proc ::cmdr::help::format::ShowCategory {width lv path indent} {
    upvar 1 $lv lines cmds cmds subc subc

    # Print category header
    lappend lines "$indent[lindex $path end]"

    # Indent the commands and sub-categories a bit more...
    append indent "    "
    set    sep    "    "

    # Get the commands in the category, preliminary formatting
    # (labels, descriptions).

    foreach def [lsort -dict -unique [dict get $cmds $path]] {
	lassign $def syntax desc
	lappend names $syntax
	lappend descs $desc
    }
    set labels [cmdr util padr $names]

    # With the padding all labels are the same length. We can
    # precompute the blank and the width to format the descriptions
    # into.

    regsub -all {[^\t]}  "$indent[lindex $labels 0]$sep" { } blank
    set w [expr {$width - [string length $blank]}]

    # Print the commands, final formatting.
    foreach label $labels desc $descs {
	set desc [textutil::adjust::adjust $desc \
		      -length $w \
		      -strictlength 1]
	set desc [textutil::adjust::indent $desc $blank 1]

	lappend lines $indent$label$sep$desc
    }

    lappend lines {}
    if {![dict exists $subc $path]} return

    # Print the sub-categories, if any.
    foreach c [lsort -dict -unique [dict get $subc $path]] {
	ShowCategory $width lines [linsert $path end $c] $indent
    }
    return
}

# # ## ### ##### ######## ############# #####################
## Common utility commands.

proc ::cmdr::help::format::DefList {width labels defs} {
    upvar 1 lines lines

    set labels [cmdr util padr $labels]

    set  nl [string length [lindex $labels 0]]
    incr nl 5
    set blank [string repeat { } $nl]

    lappend lines ""
    foreach l $labels def $defs {
	# FUTURE: Consider paragraph breaks in $def (\n\n),
	#         and format them separately.
	set w [expr {$width - $nl}]
	set w [expr {$w < 1 ? 1 : $w}]
	lappend lines "    $l [textutil::adjust::indent \
		       [textutil::adjust::adjust $def \
			    -length $w -strictlength 1] \
		       $blank 1]"
    }
    return
}

proc ::cmdr::help::format::Arguments {arguments parameters} {
    set result {}
    foreach a $arguments {
	set v [dict get $parameters $a]
	dict with v {} ; # -> code, desc, label
	switch -exact -- $code {
	    +  { set text "<$label>" }
	    ?  { set text "\[<${label}>\]" }
	    +* { set text "<${label}>..." }
	    ?* { set text "\[<${label}>...\]" }
	}
	lappend result $text
    }
    return [join $result]
}

proc ::cmdr::help::format::HasOptions {options} {
    if {[dict size $options]} {
	return "\[OPTIONS\] "
    } else {
	return {}
    }
}

proc ::cmdr::help::format::SectionTree {help {fmtname 1}} {

    array set subc {} ;# category path -> list (child category path)
    array set cmds {} ;# category path -> list (cmd)
    #                    cmd = tuple (label description)

    dict for {name def} $help {
	dict with def {} ; # -> desc, arguments, parameters, sections

	if {![llength $sections]} {
	    lappend sections Miscellaneous
	}

	if {$fmtname} {
	    append name " " [Arguments $arguments $parameters]
	}
	set    desc [lindex [split $desc .] 0]
	set    cmd  [::list $name $desc]

	foreach category $sections {
	    lappend cmds($category) $cmd
	    set parent [lreverse [lassign [lreverse $category] leaf]]
	    lappend subc($parent) $leaf
	}
    }

    #parray subc
    #parray cmds

    ::list [array get subc] [array get cmds]
}

proc ::cmdr::help::format::SectionOrder {root subc} {

    # IIa. Natural order first.
    set categories [lsort -dict -unique [dict get $subc {}]]

    # IIb. Look for and apply user overrides.
    if {[$root exists *category-order*]} {
	# Record natural order
	set n 0
	foreach c $categories {
	    dict set map $c $n
	    incr n -10
	}
	# Special treatment of generated category, move to end.
	if {"Miscellaneous" in $categories} {
	    dict set map Miscellaneous -10000
	}
	# Overwrite natural with custom ordering.
	dict for {c n}  [$root get *category-order*] {
	    if {$c ni $categories} continue
	    dict set map $c $n
	}
	# Rewrite into tuples.
	foreach {c n} $map {
	    lappend tmp [::list $n $c]
	}

	#puts [join [lsort -decreasing -integer -index 0 $tmp] \n]

	# Sort tuples into chosen order, and rewrite back to list of
	# plain categories.
	set categories {}
	foreach item [lsort -decreasing -integer -index 0 $tmp] {
	    lappend categories [lindex $item 1]
	}
    } else {
	# Without bespoke ordering only the generated category gets
	# treated specially.
	set pos [lsearch -exact $categories Miscellaneous]
	if {$pos >= 0} {
	    set categories [linsert [lreplace $categories $pos $pos] end Miscellaneous]
	}
    }

    return $categories
}


# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help 1.0

Added support/help_json.tcl.

























































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Help - JSON format. Not available by default.
## Require this package before creation a commander, so that the
## mdr::help heuristics see and automatically integrate the format.

# @@ Meta Begin
# Package cmdr::help::json 1.0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Formatting help as JSON object.
# Meta description Formatting help as JSON object.
# Meta subject {command line}
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require {cmdr::help 1}
# Meta require {cmdr::util 1}
# Meta require json::write
# @@ Meta End

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

package require Tcl 8.5
package require debug
package require debug::caller
package require cmdr::help 1
package require cmdr::util 1
package require json::write

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

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

# # ## ### ##### ######## ############# #####################
## Definition

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

namespace eval ::cmdr::help::format {
    namespace export json
    namespace ensemble create

    namespace import ::cmdr::help::query
}

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

proc ::cmdr::help::format::json {root width help} {
    debug.cmdr/help/json {}
    # help = dict (name -> command)

    # Step 1. Command mapping.
    set dict {}
    dict for {cmd desc} $help {
	lappend dict $cmd [JSON $desc]
    }
    set commands [json::write object {*}$dict]


    # Step 2. Section Tree. This is very similar to
    # cmdr::help::format::by-category, and re-uses its frontend helper
    # commands.

    lassign [SectionTree $help 0] subc cmds
    foreach c [SectionOrder $root $subc] {
	lappend sections [JSON::acategory [::list $c] $cmds $subc]
    }

    return [json::write object \
		sections [json::write array {*}$sections] \
		commands $commands]
}

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

namespace eval ::cmdr::help::format::JSON {}

proc ::cmdr::help::format::JSON::acategory {path cmds subc} {
    set name [lindex $path end]

    # With struct::list map we could then also re-use alist.
    set commands {}
    foreach def [lsort -dict -unique [dict get $cmds $path]] {
	lassign $def cname _
	lappend commands [json::write string $cname]
    }

    set sections {}
    if {[dict exists $subc $path]} {
	# Add the sub-categories, if any.
	foreach c [lsort -dict -unique [dict get $subc $path]] {
	    lappend sections [acategory [linsert $path end $c] $cmds $subc]
	}
    }

    return [json::write object \
		name     [json::write string $name] \
		commands [json::write array {*}$commands] \
		sections [json::write array {*}$sections]]
}

proc ::cmdr::help::format::JSON {command} {
    # Data structure: see config.tcl,  method 'help'.
    # Data structure: see private.tcl, method 'help'.

    dict with command {}
    # -> action, desc, options, arguments, parameters, states, sections

    lappend dict description [JSON::astring    $desc]
    lappend dict action      [JSON::alist      $action]
    lappend dict arguments   [JSON::alist      $arguments]
    lappend dict options     [JSON::adict      $options]
    lappend dict opt2para    [JSON::adict      $opt2para]
    lappend dict states      [JSON::alist      $states]
    lappend dict parameters  [JSON::parameters $parameters]
    lappend dict sections    [JSON::alist      $sections]
    
    return [json::write object {*}$dict]
}

proc ::cmdr::help::format::JSON::parameters {parameters} {
    set dict {}
    foreach {name def} [::cmdr util dictsort $parameters] {
	set tmp {}
	foreach {xname xdef} [::cmdr util dictsort $def] {
	    switch -glob -- $xname {
		cmdline -
		defered -
		documented -
		interactive -
		isbool -
		list -
		ordered -
		presence -
		required -
		@bool {
		    # normalize to boolean
		    set value [expr {!!$xdef}]
		}
		threshold {
		    # null|integer
		    set value [expr {($xdef eq {}) ? "null" : $xdef}]
		}
		code -
		default -
		description -
		prompt -
		type -
		label -
		@string {
		    set value [astring $xdef]
		}
		generator -
		validator -
		@cmdprefix { 
		    set value [alist $xdef]
		}
		flags -
		@dict {
		    set value [adict $xdef]
		}
		* {
		    error "Unknown key \"$xname\", do not know how to format"
		    #lappend tmp $xname [astring $xdef]
		}
	    }
	    lappend tmp $xname $value
	}
	lappend dict $name [json::write object {*}$tmp]
    }
    return [json::write object {*}$dict]
}

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

proc ::cmdr::help::format::JSON::alist {thelist} {
    set tmp {}
    foreach w $thelist {
	lappend tmp [json::write string $w]
    }
    return [json::write array {*}$tmp]
}

proc ::cmdr::help::format::JSON::adict {thedict} {
    set tmp {}
    foreach {k v} [::cmdr util dictsort $thedict] {
	lappend tmp $k [json::write string $v]
    }
    return [json::write object {*}$tmp]
}

proc ::cmdr::help::format::JSON::astring {string} {
    regsub -all -- {[ \n\t]+} $string { } string
    return [json::write string [string trim $string]]
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help::json 1.0

Added support/help_sql.tcl.

















































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Help - SQL format. Not available by default.
## Require this package before creation a commander, so that the
## mdr::help heuristics see and automatically integrate the format.

# @@ Meta Begin
# Package cmdr::help::sql 1.0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Formatting help as series of SQL commands.
# Meta description Formatting help as series of SQL commands.
# Meta subject {command line}
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require {cmdr::help 1}
# Meta require {cmdr::util 1}
# @@ Meta End

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

package require Tcl 8.5
package require debug
package require debug::caller
package require cmdr::help 1
package require cmdr::util 1

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

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

# # ## ### ##### ######## ############# #####################
## Definition

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

namespace eval ::cmdr::help::format {
    namespace export sql
    namespace ensemble create

    namespace import ::cmdr::help::query
}

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

proc ::cmdr::help::format::sql {root width help} {
    debug.cmdr/help/sql {}
    # help = dict (name -> command)

    # TABLES:
    # - commands   (id,name,desc,action)
    # - parameters (id,name,command-id,sequence, ...)
    # - arguments  (parameter-id,name,command-id,sequence)
    # - states     (parameter-id,name,command-id,sequence)
    # - options    (id,name,command-id,parameter-id,desc)
    # - flags      (id,name,type,parameter-id)

    # State, imported into the generator functions.
    set commands   {} ; set cno 0
    set parameters {} ; set pno 0
    set arguments  {} ; # arguments are unique parameters
    set options    {} ; set ono 0
    set states     {} ; # states are unique parameters
    set flags      {} ; # flags match to options

    foreach {cmd desc} $help {
	SQL $cmd $desc
    }

    lappend lines {-- Commands}   {*}$commands   {}
    lappend lines {-- Parameters} {*}$parameters {}
    lappend lines {-- Arguments}  {*}$arguments  {}
    lappend lines {-- Options}    {*}$options    {}
    lappend lines {-- States}     {*}$states     {}
    lappend lines {-- Flags}      {*}$flags      {}

    return \n\n[SQL::schema]\n\n[join $lines \n]\n
}

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

namespace eval ::cmdr::help::format::SQL {}

proc ::cmdr::help::format::SQL {name command} {
    # Data structure: see config.tcl,  method 'help'.
    # Data structure: see private.tcl, method 'help'.

    upvar 1 commands   xcommands   cno cno
    upvar 1 parameters xparameters pno pno
    upvar 1 arguments  xarguments
    upvar 1 options    xoptions    ono ono
    upvar 1 states     xstates
    upvar 1 flags      xflags

    # ---

    dict with command {} ; # -> action, desc, options, arguments, parameters, states

    set cid [SQL::++ commands cno [SQL::astring $name] \
		 [SQL::astring $desc] [SQL::astring $action]]

    set sequence 0
    foreach {pname param} $parameters {
	set pid [SQL::++ parameters pno [SQL::astring $pname] \
		     $cid $sequence \
		     {*}[SQL::para $param]]

	dict set pmap $pname $pid

	foreach {fname ftype} [dict get $param flags] {
	    set fid [SQL::++ flags ono [SQL::astring $fname] \
			 [SQL::astring $ftype] $pid]

	    dict set fmap $fname $pid
	    dict set omap $fname $fid
	    # Redundancy: pid --> cid
	}

	incr sequence
    }

    set sequence 0
    foreach aname $arguments {
	set pid [dict get $pmap $aname]
	SQL::== arguments $pid [SQL::astring $aname] \
	    $cid $sequence
	incr sequence
    }

    foreach {flag desc} $options {
	set pid [dict get $fmap $flag]
	set fid [dict get $omap $flag]
	SQL::== options $fid [SQL::astring $flag] \
	    $cid $pid [SQL::astring $desc]
	# Redundancy: fid --> flag
	# Redundancy: fid --> cid
    }

    set sequence 0
    foreach sname $states {
	set pid [dict get $pmap $sname]
	SQL::== states $pid [SQL::astring $sname] \
	    $cid $sequence
	incr sequence
	# Redundancy: pid --> sname
    }

    return
}

proc ::cmdr::help::format::SQL::para {def} {
    set result {}

    foreach {xname xdef} [::cmdr util dictsort $def] {
	switch -glob -- $xname {
	    cmdline -
	    defered -
	    documented -
	    interactive -
	    isbool -
	    list -
	    ordered -
	    presence -
	    required -
	    @bool {
		# normalize to boolean
		set value [expr {!!$xdef}]
	    }
	    threshold {
		# null|integer
		set value [expr {($xdef eq {}) ? "NULL" : $xdef}]
	    }
	    code -
	    default -
	    description -
	    prompt -
	    type -
	    generator -
	    validator -
	    label -
	    @string {
		set value [astring $xdef]
	    }
	    flags {
		# Ignored, handled separately (see caller).
		continue
	    }
	    * {
		error "Unknown key \"$xname\", do not know how to format"
		#lappend tmp $xname [astring $xdef]
	    }
	}
	lappend result $value
    }
    return $result
}

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

proc ::cmdr::help::format::SQL::++ {table idvar args} {
    upvar 1 $idvar counter x$table lines
    set last $counter
    lappend lines "INSERT INTO $table VALUES ($counter, [join $args {, }]);"
    incr counter
    return $last
}

proc ::cmdr::help::format::SQL::== {table id args} {
    upvar 1 x$table lines
    lappend lines "INSERT INTO $table VALUES ($id, [join $args {, }]);"
    return
}

proc ::cmdr::help::format::SQL::astring {string} {
    lappend map "\"" "\"\""
    regsub -all -- {[ \n\t]+} $string { } string
    return \"[string map $map [string trim $string]]\"
}

proc ::cmdr::help::format::SQL::schema {} {
    return {
	CREATE TABLE commands (
	       id     INTEGER PRIMARY KEY,
	       name   STRING,
	       desc   STRING,
	       action STRING,
	       UNIQUE ( name )
       );
	CREATE TABLE parameters (
	       id   INTEGER PRIMARY KEY,
	       name STRING,
	       cid  INTEGER REFERENCES commands,
	       seq  INTEGER,
	       -- --- Parameter Details
	       cmdline     INTEGER,
	       code        STRING,
	       dfltvalue   STRING,
	       defered     INTEGER,
	       description STRING,
	       documented  INTEGER,
	       generator   STRING,
	       interactive INTEGER,
	       isbool      INTEGER,
	       list        INTEGER,
	       ordered     INTEGER,
	       presence    INTEGER,
	       prompt      STRING,
	       required    INTEGER,
	       threshold   INTEGER,
	       type        STRING,
	       validator   STRING,
	       -- ---
	       UNIQUE ( cid, seq )
       );
	CREATE INDEX pname on parameters ( name );
	CREATE TABLE arguments (
	       id   INTEGER PRIMARY KEY REFERENCES parameters,
	       name STRING,
	       cid  INTEGER REFERENCES commands,
	       seq  INTEGER,
	       UNIQUE ( cid, seq )
       );
	CREATE INDEX aname on arguments ( name );
	CREATE TABLE options (
	       id   INTEGER PRIMARY KEY,
	       name STRING,
	       cid  INTEGER REFERENCES commands,
	       pid  INTEGER REFERENCES parameters,
	       desc STRING
       );
	CREATE INDEX oname on options ( name );
	CREATE TABLE states (
	       id   INTEGER PRIMARY KEY REFERENCES parameters,
	       name STRING,
	       cid  INTEGER REFERENCES commands,
	       seq  INTEGER,
	       UNIQUE ( cid, seq )
       );
	CREATE INDEX sname on states ( name );
	CREATE TABLE flags (
	       id   INTEGER PRIMARY KEY REFERENCES options,
	       name STRING,
	       type STRING,
	       pid  INTEGER REFERENCES parameters
       );
	CREATE INDEX fname on flags ( name );
    }
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help::sql 1.0

Added support/officer.tcl.













































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
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
314
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
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Officer - Command execution. Dispatcher.
##                An actor.

## - Officers can learn to do many things, by delegating things to the
##   privates actually able to perform it.

# @@ Meta Begin
# Package cmdr::officer 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary Aggregation of multiple commands for dispatch.
# Meta description 'cmdr::officer's can learn to do many things,
# Meta description by delegating things to the 'cmdr::private's
# Meta description actually able to perform it.
# Meta subject {command line} delegation dispatch
# Meta require TclOO
# Meta require cmdr::actor
# Meta require cmdr::help
# Meta require cmdr::private
# Meta require debug
# Meta require debug::caller
# Meta require linenoise::facade
# Meta require try
# Meta require {Tcl 8.5-}
# Meta require {oo::util 1.2}
# Meta require {string::token::shell 1.1}
# @@ Meta End

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

package require Tcl 8.5
package require debug
package require debug::caller
package require linenoise::facade
package require string::token::shell 1.1
package require try
package require TclOO
package require oo::util 1.2 ;# link helper.
package require cmdr::actor
package require cmdr::private
package require cmdr::help

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

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

# # ## ### ##### ######## ############# #####################
## Definition - Single purpose command.

# # ## ### ##### ######## ############# #####################
## Definition

oo::class create ::cmdr::officer {
    superclass ::cmdr::actor
    # # ## ### ##### ######## #############
    ## Lifecycle.

    # action specification.
    # declares a hierarchy of sub-ordinate officers and privates.

    # Specification commands.
    #
    # private $name $arguments $cmdprefix --> sub-ordinate private for the action.
    # officer $name $actions              --> sub-ordinate officer with more actions.
    # default $name                       --> default action

    constructor {super name actions} {
	debug.cmdr/officer {}
	next

	my super: $super
	my name:  $name

	set myactions   $actions ; # Action spec for future initialization
	set myinit      no       ; # Dispatch map will be initialized lazily
	set mymap       {}       ; # Action map starts knowing nothing
	set mycommands  {}       ; # Ditto
	set myccommands {}       ; # Ditto, derived cache, see method CCommands.
	set mychildren  {}       ; # List of created subordinates.
	set myhandler   {}
	return
    }

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

    method ehandler {cmd} {
	debug.cmdr/officer {}
	set myhandler $cmd
	return
    }

    # # ## ### ##### ######## #############
    ## Public API. (Introspection, mostly).
    ## - Determine set of known actions.
    ## - Determine default action.
    ## - Determine handler for an action.

    method known {} {
	debug.cmdr/officer {}
	my Setup
	set result {}
	dict for {k v} $mymap {
	    if {![string match a,* $k]} continue
	    lappend result [string range $k 2 end]
	}
	return $result
    }

    method hasdefault {} {
	debug.cmdr/officer {} 10
	my Setup
	return [dict exists $mymap default]
    }

    method default {} {
	debug.cmdr/officer {} 10
	my Setup
	return [dict get $mymap default]
    }

    method lookup {name} {
	debug.cmdr/officer {}
	my Setup
	if {![dict exists $mymap a,$name]} {
	    return -code error \
		-errorcode [list CMDR ACTION UNKNOWN $name] \
		"Expected action name, got \"$name\""
	}
	return [dict get $mymap a,$name]
    }

    method has {name} {
	debug.cmdr/officer {}
	my Setup
	return [dict exists $mymap a,$name]
    }

    method children {} {
	debug.cmdr/officer {}
	my Setup
	return $mychildren
    }

    # # ## ### ##### ######## #############
    ## Internal. Dispatcher setup. Defered until required.
    ## Core setup code runs only once.

    method Setup {} {
	# Process the action specification only once.
	if {$myinit} return
	set myinit 1
	debug.cmdr/officer {}

	my learn $myactions

	# Auto-create a 'help' command when possible, i.e not in
	# conflict with a user-specified command.
	if {![my has help]} {
	    cmdr help auto [self]
	}

	# Auto-create an 'exit' command when possible, i.e not in
	# conflict with a user-specified command.
	if {![my has exit]} {
	    my learn {
		private exit {
		    description {
			Exit the shell.
			No-op if not in a shell.
		    }
		} [mymethod shell-exit]
	    }
	}
	return
    }

    method learn {script} {
	debug.cmdr/officer {}
	# Make the DSL commands directly available. Note that
	# "description:" and "common" are superclass methods, and
	# renamed to their DSL counterparts. The others are unexported
	# instance methods of this class.

	link \
	    {ehandler    ehandler} \
	    {private     Private} \
	    {officer     Officer} \
	    {default     Default} \
	    {alias       Alias} \
	    {description description:} \
	    undocumented \
	    {common      set}
	eval $script

	# Postprocessing.
	set mycommands [lsort -dict $mycommands]
	return
    }

    # Convenience method for dynamically creating a command hierarchy.
    # Command specified as path, intermediate officers are generated
    # automatically as needed.

    method extend {path arguments action} {
	if {[llength $path] == 1} {
	    # Reached the bottom of the recursion.
	    # Generate the private handling arguments and action.
	    set cmd [lindex $path 0]
	    Private $cmd $arguments $action
	    return
	}

	# Recurse, creating the intermediate officers as needed.
	set path [lassign $path cmd]
	if {![has $cmd]} {
	    Officer $cmd {}
	}

	[my lookup $cmd] extend $path $arguments $action
	return
    }

    # # ## ### ##### ######## #############
    ## Implementation of the action specification language.

    # common      => set          (super cmdr::actor)
    # description => description: (super cmdr::actor)

    forward Private my DefineAction private
    forward Officer my DefineAction officer

    method Default {{name {}}} {
	if {[llength [info level 0]] == 2} {
	    set name [my Last]
	} elseif {![dict exists $mymap a,$name]} {
	    return -code error \
		-errorcode [list CMDR ACTION UNKNOWN $name] \
		"Unable to set default, expected action, got \"$name\""
	}
	dict set mymap default $name
	return
    }

    method Alias {name args} {
	set n [llength $args]
	if {($n == 1) || (($n > 1) && ([lindex $args 0] ne "="))} {
	    return -code error \
		"wrong\#args: should be \"name ?= cmd ?word...??\""
	}
	my ValidateAsUnknown $name

	if {$n == 0} {
	    # Simple alias, to preceding action.
	    set handler [my lookup [my Last]]
	} else {
	    # Track the chain of words through the existing hierarchy
	    # of actions to locate the final handler.
	    set handler [self]
	    foreach word [lassign $args _dummy_] {
		set handler [$handler lookup $word]
	    }
	}

	# We essentially copy the definition of the command the alias
	# refers to.
	my Def $name $handler
	return
    }

    # Internal. Common code to declare actions and their handlers.
    method DefineAction {what name args} {
	my ValidateAsUnknown $name

	# Note: By placing the subordinate objects into the officer's
	# namespace they will be automatically destroyed with the
	# officer itself. No special code for cleanup required.

	set handler [self namespace]::${what}_$name
	cmdr::$what create $handler [self] $name {*}$args

	# Propagate error handler.
	$handler ehandler $myhandler

	lappend mychildren $handler

	my Def $name $handler
	return
    }

    method Def {name handler} {
	# Make an action known to the dispatcher.
	dict set mymap last $name
	dict set mymap   a,$name $handler
	lappend mycommands $name
	return
    }

    method ValidateAsUnknown {name} {
	debug.cmdr/officer {}
	if {![dict exists $mymap a,$name]} return
	return -code error -errorcode {CMDR ACTION KNOWN} \
	    "Unable to learn $name, already specified."
    }

    method Last {} {
	if {![dict exists $mymap last]} {
	    return -code error -errorcode {CMDR ACTION NO-LAST} \
		"Cannot be used as first command"
	}
	return [dict get $mymap last]
    }

    method Known {name} {
	return [dict exists $mymap a,$name]
    }

    # # ## ### ##### ######## #############
    ## Command dispatcher. Choose the subordinate and delegate.

    method do {args} {
	debug.cmdr/officer {}
	my Setup

	# No command specified, what should we do ?
	# (1) If there is a default, we can go on (Do will call on it).
	# (2) Without default we must enter an interactive shell.
	# (3) Except if interaction is globally suppressed. Then we
	#     fall through, again, to generate the proper error message.
	#
	# Result: Interact with the user if no command was specified,
	# we have no default to punt to and interaction is globally
	# allowed.

	if {![llength $args] && ![my hasdefault] && [cmdr interactive?]} {
	    # Drop into a shell where the user can enter her commands
	    # interactively.

	    set shell [linenoise::facade new [self]]
	    set myreplexit 0 ; # Initialize stop signal, no stopping
	    $shell history 1
	    [my root] set *in-shell* true
	    $shell repl
	    [my root] set *in-shell* false
	    $shell destroy
	    return
	}

	my Do {*}$args
	return
    }

    # Internal. Actual dispatch. Shared by main entry and shell.
    method Do {args} {
	debug.cmdr/officer {}
	set reset 0
	if {![my exists *command*]} {
	    my set *command* $args
	    set reset 1
	}
	try {
	    # Empty command. Delegate to the default, if we have any.
	    # Otherwise fail.
	    if {![llength $args]} {
		if {[my hasdefault]} {
		    return [[my lookup [my default]] do]
		}
		return -code error -errorcode {CMDR DO EMPTY} \
		    "No command found."
	    }

	    # Split into command and arguments
	    set remainder [lassign $args cmd]

	    # Delegate to the handler for a known command.
	    if {[my Known $cmd]} {
		my lappend *prefix* $cmd
		[my lookup $cmd] do {*}$remainder
		return
	    }

	    # The command word is not known. Delegate the full command to
	    # the default, if we have any. Otherwise fail.

	    if {[my hasdefault]} {
		# prefix left as is.
		return [[my lookup [my default]] do {*}$args]
	    }

	    if {[catch {
		set prefix " [my get *prefix*] "
	    }]} { set prefix "" }
	    return -code error \
		-errorcode [list CMDR DO UNKNOWN $cmd] \
		"Unknown command \"[string trimleft $prefix]$cmd\". Please use 'help[string trimright $prefix]' to see the list of available commands."
	} finally {
	    if {$reset} {
		my unset *command*
	    }
	    my unset *prefix*
	}
    }

    # # ## ### ##### ######## #############
    ## Shell hook methods called by the linenoise::facade.

    method prompt1   {}     { return "[my fullname] > " }
    method prompt2   {}     { error {Continuation lines are not supported} }
    method continued {line} { return 0 }
    method exit      {}     { return $myreplexit }

    method shell-exit {config} {
	# No arguments, ignore config.
	set myreplexit 1
	return
    }

    method dispatch {cmd} {
	debug.cmdr/officer {}

	if {$cmd eq {}} {
	    # No command, do nothing.
	    return
	}

	if {$cmd eq ".exit"} {
	    # See method 'shell-exit' as well, and 'Setup' for
	    # the auto-creation of an 'exit' command when possible,
	    # i.e not in conflict with a user-specified command.
	    set myreplexit 1 ; return
	}
	my Do {*}[string token shell $cmd]
    }

    method report {what data} {
	debug.cmdr/officer {}
	switch -exact -- $what {
	    ok {
		if {$data eq {}} return
		puts stdout $data
	    }
	    fail {
		puts stderr $data
	    }
	    default {
		return -code error \
		    "Internal error, bad result type \"$what\", expected ok, or fail"
	    }
	}
    }

    # # ## ### ##### ######## #############
    # Shell hook method - Command line completion.

    method complete {line} {
	debug.cmdr/officer {} 10
	#puts stderr ////////$line
	try {
	    set completions [my complete-words [my parse-line $line]]
	} on error {e o} {
	    puts stderr "ERROR: $e"
	    puts stderr $::errorInfo
	    set completions {}
	}
	#puts stderr =($completions)
	return $completions
    }

    method complete-words {parse} {
	debug.cmdr/officer {} 10
	#puts stderr [my fullname]/[self]/$parse/
	# Note: This method has to entry-points.
	# (1) Above in 'complete', for command completion from self's REPL.
	# (2) Below, as part of recursion from a higher officer while
	#     following the chain of words to the actor responsible
	#     for handling the last word.

	my Setup

	# Unfold the parse state
	dict with parse {} ;# --> line ok words at nwords doexit
	# ok     - boolean flag, syntax ok ? yes/no
	# line   - string, the raw command line with quotes, escapes, etc.
	# nwords - number of words found in the -> line
	# words  - list of words found in the -> line.
	# at     - index of the current word to process.
	# doexit - boolean flag, pseudo-command 'exit' active ? yes/no
	#
	# words = list (tuple), where tuple = (type startoff endoff string)
	# doexit - True only for entry point (1), false for all of (2) and down.

	# Parse error, bad syntax. No completions.

	if {!$ok} {
	    #puts stderr \tBAD
	    return {}
	}

	# Empty line. All our commands are completions, plus the
	# special '.exit' command to stop the REPL. Thus using
	# my<c>commands instead of mycommands.

	if {$line eq {}} {
	    #puts stderr \tALL
	    set completions [my CCommands]
	    if {[my hasdefault]} {
		dict set parse doexit 0
		lappend completions {*}[[my lookup [my default]] complete-words $parse]
	    }
	    return [lsort -unique [lsort -dict $completions]]
	}

	# Beyond the end of the line. No completions.

	if {$at == $nwords} {
	    #puts stderr \tBEYOND
	    return {}
	}

	if {$at < ($nwords - 1)} {
	    # This officer has to handle a word in the middle of the
	    # command line. This is done by delegating to the
	    # subordinate associated with the current word and letting
	    # it handle the remainder.

	    #puts stderr \tRECURSE
	    return [my CompleteRecurse $parse]
	}

	# This officer is responsible for handling the last word on
	# the command line. We do this by computing the set of
	# matching commands from the set the officer knows and
	# providing them as completions. One tricky thing: If we have
	# a default we ask it as well, and merge its completions to
	# ours. Lastly, we may have to add the '.exit' pseudo-command
	# as well.

	#puts stderr \tMATCH\ ([lindex $words $at end])

	set commands [my CCommands $doexit]

	set completions \
	    [my completions $parse \
		 [my match $parse $commands]]

	if {[my hasdefault]} {
	    dict set parse doexit 0
	    lappend completions {*}[[my lookup [my default]] complete-words $parse]
	}

	#puts stderr \tC($completions)
	return [lsort -unique [lsort -dict $completions]]
    }

    method CompleteRecurse {parse} {
	debug.cmdr/officer {} 10
	# Inside the command line. Find the relevant subordinate based
	# on the current word and let it handle everything.

	# The '.exit' pseudo-command of the subordinate is irrelevant
	# during recursion from the current or higher REPL, suppress
	# it. The pseudo-command is only relevant to the officers
	# actually in their REPL.
	dict set parse doexit 0

	set matches [my match $parse [my known]]

	if {[llength $matches] == 1} {
	    # Proper subordinate found. Delegate. Note: Step to next
	    # word, we have processed the current one.
	    dict incr parse at
	    set handler [my lookup [lindex $matches 0]]
	    return [$handler complete-words $parse]
	}

	# The search was inconclusive. Try the default, if we have any.
	if {[my hasdefault]} {
	    return [[my lookup [my default]] complete-words $parse]
	}

	# No default, no completions.
	return {}
    }

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

    method CCommands {{doexit 1}} {
	debug.cmdr/officer {} 10
	if {![llength $myccommands]} {
	    # Fill completion command cache.

	    # Standard pseudo-commands.
	    if {$doexit} {
		lappend myccommands .exit
	    }

	    foreach c $mycommands {
		# Undocumented commands are not available to completion.
		if {![[my lookup $c] documented]} continue
		lappend myccommands $c
	    }

	    set myccommands [lsort -unique [lsort -dict $myccommands]]
	}

	return $myccommands
    }


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

    method help {{prefix {}}} {
	debug.cmdr/officer {}
	my Setup
	# Query each subordinate for their help and use it to piece ours together.
	# Note: Result is not finally formatted text, but nested dict structure.
	# Same is expected from the sub-ordinates

	# help = dict (name -> command)
	#if {![my documented]} { return {} }
	set help {}
	foreach c [my known] {
	    set cname [list {*}$prefix $c]
	    set actor [my lookup $c]
	    if {![$actor documented]} continue
	    set help [dict merge $help [$actor help $cname]]
	}
	return $help
    }

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

    variable myinit myactions mymap mycommands myccommands mychildren \
	myreplexit myhandler

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::officer 1.0

Added support/parameter.tcl.





















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
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
314
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
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Value - Definition of command parameters (for a private).

# @@ Meta Begin
# Package cmdr::parameter 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Internal. Command parameters.
# Meta description Internal. Arguments, options, and other
# Meta description parameters to privates (commands).
# Meta subject {command line}
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require TclOO
# Meta require {oo::util 1.2}    ;# link helper
# Meta require linenoise
# @@ Meta End

## Reference "doc/notes_parameter.txt". The Rnnn and Cnnn tags are
## links into this document.

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

package require Tcl 8.5
package require debug
package require debug::caller
package require TclOO
package require oo::util 1.2    ;# link helper
package require linenoise

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

debug define cmdr/parameter
debug level  cmdr/parameter
debug prefix cmdr/parameter {[string map [::list [self] "([config context fullname])@$myname" my "    @$myname"] [debug caller]] | }
# In the above prefix we massage the object reference into a better
# name for navigation into a command hierarchy.

# # ## ### ##### ######## ############# #####################
## Definition

oo::class create ::cmdr::parameter {
    # # ## ### ##### ######## #############
    ## Lifecycle.

    constructor {theconfig order cmdline required defered name desc valuespec} {
	set myname  $name		; # [R1]
	set mylabel $name

	# Import the whole collection of parameters this one is a part
	# of into our namespace, as the fixed command "config", for
	# use by the various command prefixes (generate, validate,
	# when-complete), all of which will be run in our namespace
	# context.

	interp alias {} [self namespace]::config {} $theconfig

	# Note ordering!
	# We set up the pieces required by the narrator first, above.

	debug.cmdr/parameter {}

	# The valuespec is parsed immediately.  In contrast to actors,
	# which defer until they are required.  As arguments are
	# required when the using private is required further delay is
	# nonsense.

	set mydescription $desc		; # [R2]

	set myisordered   $order	; # [R3,4,5,6]
	set myiscmdline   $cmdline	; # [R3,4,5,6]
	set myisrequired  $required	; # [R7,8,9,10]
	set myisdefered   $defered      ; # [R ???]
	set mynopromote   no

	my C1_StateIsUnordered
	my C2_OptionIsOptional
	my C3_StateIsRequired

	set mystopinteraction no ;# specified interaction is not suppressed.
	set myislist       no ;# scalar vs list parameter
	set myisdocumented yes
	set myonlypresence no ;# options only, no argument when true.
	set myhasdefault   no ;# flag for default existence
	set mydefault      {} ;# default value - raw
	set mygenerate     {} ;# generator command
	set myinteractive  no ;# no interactive query of value
	set myprompt       "Enter ${name}: " ;# standard prompt for interaction

	set myvalidate     {} ;# validation command
	set mywhencomplete {} ;# action-on-int-rep-creation command.
	set mywhenset      {} ;# action-on-set(-from-parse) command.

	set mythreshold    {} ;# threshold for optional arguments
	#                     ;# empty: Undefined
	#                     ;#    -1: No threshold, peek and validate for choice.
	#                     ;#  else: #required arguments after this one.

	my ExecuteSpecification $valuespec

	# Start with a proper runtime state. See also method 'reset'
	# for an exported variant with cleanup, for use by cmdr::config.
	set myhasstring no
	set mystring    {}
	set myhasvalue  no
	set myisundefined no
	set myvalue     {}
	set mylocker    {}

	return
    }

    # # ## ### ##### ######## #############
    ## API: Property accessors...

    # Make the container accessible, and through it also all other
    # parameters of a private.
    method config {args} {
	debug.cmdr/parameter {}
	if {![llength $args]} {
	    return [config self]
	}
	config {*}$args
    }

    # Make self accessible.
    method self {} { self }

    method code {} {
	# code in {
	#     +		<=> required
	#     ?		<=> optional
	#     +*	<=> required splat
	#     ?* 	<=> optional splat
	# }
	my Assert {$myiscmdline} {State parameter "@" has no help (coding)}
	append code [expr {$myisrequired ? "+" : "?"}]
	append code [expr {$myislist     ? "*" : ""}]
	return $code
    }

    method is {type} {
	string equal $type [my type]
    }

    method type {} {
	if {$myisordered} { return "input" }
	if {$myiscmdline} { return "option" }
	return "state"
    }

    # Identification and help. Add context name into it?
    method name        {} { return $myname }
    method label       {} { return $mylabel }
    method description {{detail {}}} {
	if {($detail ne {}) && [dict exists $myflags $detail]} {
	    switch -exact -- [dict get $myflags $detail] {
		primary  {}
		alias    { return "Alias of [my Option $myname]." }
		inverted { return "Complementary alias of [my Option $myname]." }
	    }
	}
	return $mydescription
    }

    method primary {option} {
	return [expr {[dict get $myflags $option] eq "primary"}]
    }

    method flag {} {
	my Option $mylabel
    }

    # Core classification properties
    method ordered      {} { return $myisordered }
    method cmdline      {} { return $myiscmdline }
    method required     {} { return $myisrequired }
    method defered      {} { return $myisdefered }
    method nopromote    {} { return $mynopromote }

    method list         {} { return $myislist }
    method presence     {} { return $myonlypresence }
    method documented   {} { return $myisdocumented }
    method isbool       {} { return [expr {$myvalidate eq "::cmdr::validate::boolean"}] }
    method locker       {} { return $mylocker }

    # Alternate sources for the parameter value.
    method hasdefault   {} { return $myhasdefault }
    method default      {} { return $mydefault }
    method generator    {} { return $mygenerate }
    method interactive  {} { return $myinteractive }
    method prompt       {} { return $myprompt }

    # Hooks for validation and side-effects at various stages.
    method validator     {} { return $myvalidate }
    method when-complete {} { return $mywhencomplete }
    method when-set      {} { return $mywhenset }

    # - test mode of optional arguments (not options)
    method threshold   {} { return $mythreshold }
    method threshold: {n} {
	# Ignore when parameter is required, or already set to mode peek+test
	if {$myisrequired || ($mythreshold ne {})} return
	debug.cmdr/parameter {}
	set mythreshold $n
	return
    }


    method help {} {
	# Generate a dictionary describing the parameter configuration.
	if {[catch {
	    my code
	} thecode]} {
	    set thecode {}
	}
	# mynopromote - Irrelevant to help
	return [dict create \
		    cmdline     $myiscmdline    \
		    code        $thecode        \
		    default     $mydefault      \
		    defered     $myisdefered    \
		    description $mydescription  \
		    documented  $myisdocumented \
		    flags       $myflags        \
		    generator   $mygenerate     \
		    interactive $myinteractive  \
		    isbool      [my isbool]     \
		    label       $mylabel        \
		    list        $myislist       \
		    ordered     $myisordered    \
		    presence    $myonlypresence \
		    prompt      $myprompt       \
		    required    $myisrequired   \
		    threshold   $mythreshold    \
		    type        [my type]       \
		    validator   $myvalidate     \
		]
    }

    # One shot disabling of interaction, if any.
    method dontinteract {} {
	set mystopinteraction yes
	return
    }

    # # ## ### ##### ######## #############
    ## Internal: Parameter DSL implementation + support.

    method ExecuteSpecification {valuespec} {
	debug.cmdr/parameter {}
	# Dictionary of flags to recognize for an option.
	# The value indicates if the flag is primary or alias, or
	# inverted alias. This is used by 'description' to return
	# generated text as description of the aliases.

	set myflags {}

	# Import the DSL commands to translate the specification.
	link \
	    {alias         Alias} \
	    {default       Default} \
	    {defered       Defered} \
	    {generate      Generate} \
	    {immediate     Immediate} \
	    {interact      Interact} \
	    {label         Label} \
	    {list          List} \
	    {no-promotion  NoPromote} \
	    {optional      Optional} \
	    {presence      Presence} \
	    {test          Test} \
	    {undocumented  Undocumented} \
	    {validate      Validate} \
	    {when-complete WhenComplete} \
	    {when-set      WhenSet}
	eval $valuespec

	# Postprocessing ... Fill in validation and other defaults

	my FillMissingValidation
	my FillMissingDefault
	my DefineStandardFlags

	# Validate all constraints.

	my C1_StateIsUnordered
	my C2_OptionIsOptional
	my C3_StateIsRequired
	my C5_OptionalHasAlternateInput
	my C5_StateHasAlternateInput
	my C6_RequiredArgumentForbiddenDefault
	my C6_RequiredArgumentForbiddenGenerator
	my C6_RequiredArgumentForbiddenInteract
	my C7_DefaultGeneratorConflict

	return
    }

    # # ## ### ##### ######## #############
    ## Internal: Parameter DSL commands.

    method Label {name} {
	set mylabel $name
	return
    }

    method List {} {
	set myislist yes
	return
    }

    method Presence {} {
	my C8_PresenceOption
	my C9_ForbiddenPresence
	# Implied type and default
	my Validate boolean
	my Default  no
	set myonlypresence yes
	return
    }

    method Undocumented {} {
	set myisdocumented no
	return
    }

    method Alias {name} {
	my Alias_Option
	dict set myflags [my Option $name] alias
	return
    }

    method Optional {} {
	# Arguments only. Options are already optional, and state
	# parameters must not be.
	my Optional_State  ; # Order of tests is important, enabling us
	my Optional_Option ; # to simplify the guard conditions inside.
	set myisrequired no
	return
    }

    method Interact {{prompt {}}} {
	# Check relevant constraint(s) after making the change. That
	# is easier than re-casting the expressions for the proposed
	# change.
	set myinteractive yes
	my C6_RequiredArgumentForbiddenInteract
	if {$prompt eq {}} return ; # keep standard prompt
	set myprompt $prompt
	return
    }

    method Defered {} {
	# Consider adding checks against current state, prevent use
	# of calls not making an actual change.
	set myisdefered yes
	return
    }

    method Immediate {} {
	# Consider adding checks against current state, prevent use
	# of calls not making an actual change.
	set myisdefered no
	return
    }

    method NoPromote {} {
	# Arguments only. Options cannot take unknown option as value,
	# nor can hidden state.
	my Promote_InputOnly
	# Consider adding checks against current state, prevent use
	# of calls not making an actual change.
	set mynopromote yes
	return
    }

    method Default {value} {
	my C9_PresenceDefaultConflict
	# Check most of the relevant constraint(s) after making the
	# change. That is easier than re-casting the expressions for
	# the proposed change.
	set myhasdefault yes
	set mydefault    $value
	my C6_RequiredArgumentForbiddenDefault
	my C7_DefaultGeneratorConflict
	return
    }

    method Generate {cmd} {
	my C9_PresenceGeneratorConflict
	# Check most of the relevant constraint(s) after making the
	# change. That is easier than re-casting the expressions for
	# the proposed change.
	set mygenerate $cmd
	my C6_RequiredArgumentForbiddenGenerator
	my C7_DefaultGeneratorConflict
	return
    }

    method Validate {cmdprefix} {
	my C9_PresenceValidateConflict

	# Extract primary command.
	set cmd [lindex $cmdprefix 0]

	# Allow FOO shorthand for cmdr::validate::FOO
	if {![llength [info commands $cmd]] &&
	    [llength [info commands ::cmdr::validate::$cmd]]} {
	    set cmdprefix [lreplace $cmdprefix 0 0 ::cmdr::validate::$cmd]
	}

	set myvalidate $cmdprefix
	return
    }

    method WhenComplete {cmd} {
	set mywhencomplete $cmd
	return
    }

    method WhenSet {cmd} {
	set mywhenset $cmd
	return
    }

    method Test {} {
	my Test_NotState    ; # Order of tests is important, enabling us
	my Test_NotOption   ; # to simplify the guard conditions inside.
	my Test_NotRequired ; #
	# Switch the mode of the optional argument from testing by
	# argument counting to peeking at the queue and validating.
	set mythreshold -1
	return
    }

    # # ## ### ##### ######## #############
    ## Internal: DSL support.

    # # ## ### ##### ######## #############
    ## Internal: DSL support. Constraints.

    forward C1_StateIsUnordered \
	my Assert {$myiscmdline || !$myisordered} \
	{State parameter "@" must be unordered}

    forward C2_OptionIsOptional \
	my Assert {!$myisrequired || !$myiscmdline || $myisordered} \
	{Option argument "@" must be optional}

    forward C3_StateIsRequired \
	my Assert {$myiscmdline || $myisrequired} \
	{State parameter "@" must be required}

    forward C5_OptionalHasAlternateInput \
	my Assert {$myisrequired||$myhasdefault||[llength $mygenerate]||$myinteractive} \
	{Optional parameter "@" must have default value, generator command, or interaction}

    forward C5_StateHasAlternateInput \
	my Assert {$myiscmdline||$myhasdefault||[llength $mygenerate]||$myinteractive} \
	{State parameter "@" must have default value, generator command, or interaction}

    forward C6_RequiredArgumentForbiddenDefault \
	my Assert {!$myhasdefault || !$myisrequired || !$myiscmdline} \
	{Required argument "@" must not have default value}

    forward C6_RequiredArgumentForbiddenGenerator \
	my Assert {![llength $mygenerate] || !$myisrequired || !$myiscmdline} \
	{Required argument "@" must not have generator command}

    forward C6_RequiredArgumentForbiddenInteract \
	my Assert {!$myinteractive || !$myisrequired || !$myiscmdline} \
	{Required argument "@" must not have user interaction}

    forward C7_DefaultGeneratorConflict \
	my Assert {!$myhasdefault || ![llength $mygenerate]} \
	{Default value and generator command for parameter "@" are in conflict}

    forward C8_PresenceOption \
	my Assert {$myiscmdline && !$myisordered} \
	{Non-option parameter "@" cannot have presence-only}

    forward C9_ForbiddenPresence \
	my Assert {(!$myhasdefault && ![llength $mygenerate] && ![llength $myvalidate]) || !$myonlypresence} \
	{Customized option cannot be presence-only}

    forward C9_PresenceDefaultConflict \
	my Assert {!$myonlypresence} \
	{Presence-only option cannot have custom default value}

    forward C9_PresenceGeneratorConflict \
	my Assert {!$myonlypresence} \
	{Presence-only option cannot have custom generator command}

    forward C9_PresenceValidateConflict \
	my Assert {!$myonlypresence} \
	{Presence-only option cannot have custom validation type}

    # # ## ### ##### ######## #############
    ## Internal: DSL support. Syntax constraints.

    forward Alias_Option \
	my Assert {$myiscmdline && !$myisordered} \
	{Non-option parameter "@" cannot have alias}

    forward Optional_Option \
	my Assert {$myisordered} \
	{Option "@" is already optional}

    forward Optional_State \
	my Assert {$myiscmdline} \
	{State parameter "@" cannot be optional}

    forward Test_NotState \
	my Assert {$myiscmdline} \
	{State parameter "@" has no test-mode}

    forward Test_NotOption \
	my Assert {$myisordered} \
	{Option "@" has no test-mode}

    forward Test_NotRequired \
	my Assert {!$myisrequired} \
	{Required argument "@" has no test-mode}

    forward Promote_InputOnly \
	my Assert {$myisordered && $myiscmdline} \
	{Non-input parameter "@" does not handle promotion}

    # # ## ### ##### ######## #############
    ## Internal: DSL support. General helpers.

    method Assert {expr msg} {
	# Note: list is a local command, we want the builtin
	if {[uplevel 1 [::list expr $expr]]} return
	return -code error \
	    -errorcode {CMDR PARAMETER CONSTRAINT VIOLATION} \
	    [string map [::list @ $myname] $msg]
    }

    method FillMissingValidation {} {
	debug.cmdr/parameter {}
	# Ignore when the user specified a validation type
	# Note: 'presence' has set 'boolean'.
	if {[llength $myvalidate]} return

	# The parameter has no user-specified validation type. Deduce
	# a validation type from the default value, if there is
	# any. If there is not, go with "boolean". Exception: Go with
	# "identity" when a generator command is specified. Note that
	# the constraints ensured that we have no default value in
	# that case.

	if {[llength $mygenerate]} {
	    set myvalidate ::cmdr::validate::identity
	} elseif {!$myhasdefault} {
	    # Without a default value base the validation type on the
	    # kind of parameter we have here:
	    # - input, state: identity
	    # - option:       boolean
	    if {$myiscmdline && !$myisordered} {
		set myvalidate ::cmdr::validate::boolean
	    } else {
		set myvalidate ::cmdr::validate::identity
	    }
	} elseif {[string is boolean -strict $mydefault]} {
	    set myvalidate ::cmdr::validate::boolean
	} elseif {[string is integer -strict $mydefault]} {
	    set myvalidate ::cmdr::validate::integer
	} else {
	    set myvalidate ::cmdr::validate::identity
	}
	return
    }

    method FillMissingDefault {} {
	debug.cmdr/parameter {}
	# Ignore when the user specified a default value.
	# Ditto when the user specified a generator command.
	# Ditto if the parameter is a required argument.
	# Note: 'presence' has set 'no' (together ith type 'boolean').
	if {$myhasdefault ||
	    [llength $mygenerate] ||
	    ($myiscmdline && $myisordered && $myisrequired)
	} return

	if {$myislist} {
	    # For a list parameter the default is the empty list,
	    # regardless of the validation type.
	    my Default {}
	} else {
	    # For a scalar parameter ask the chosen validation type
	    # for a default value.
	    my Default [{*}$myvalidate default [self]]
	}
	return
    }

    method DefineStandardFlags {} {
	debug.cmdr/parameter {}
	# Only options have flags, arguments and state don't.
	# NOTE: Arguments may change in the future (--ask-FOO)
	if {!$myiscmdline || $myisordered} return

	# Flag derived from option name.
	dict set myflags [my Option $mylabel] primary
	# Special flags for boolean options
	# XXX Consider pushing this into the validators.
	if {$myvalidate ne "::cmdr::validate::boolean"} return

	# A boolean option triggered on presence does not have a
	# complementary alias. There is no reverse setting.
	if {$myonlypresence} return

	if {[string match no-* $myname]} {
	    # The primary option has prefix 'no-', create an alias without it.
	    set alternate [string range $myname 3 end]
	} else {
	    # The primary option is not inverted, make an alias which is.
	    set alternate no-$myname
	}

	dict set myflags [my Option $alternate] inverted
	return
    }

    method Option {name} {
	# Short options (single character) get a single-dash '-'.
	# Long options use a double-dash '--'.
	if {[string length $name] == 1} {
	    return "-$name"
	}
	return "--$name"
    }

    # # ## ### ##### ######## #############
    ## API. Support for runtime command line parsing.
    ## See "cmdr::config" for the main controller.

    method lock {reason} {
	debug.cmdr/parameter {}
	set mylocker $reason
	return
    }

    method reset {{cleanup 1}} {
	debug.cmdr/parameter {}
	# Runtime configuration, force initial state. See also the
	# constructor for an inlined variant without cleanup.

	my forget

	set mylocker    {}
	set myhasstring no
	set mystring    {}
	return
    }

    method forget {} {
	debug.cmdr/parameter {}
	# Clear a cached value.

	if {$myhasvalue} {
	    my ValueRelease $myvalue
	}
	set myisundefined no
	set myhasvalue  no
	set myvalue     {}
	return
    }

    method options {} { 
	return [lsort -dict [dict keys $myflags]]
    }

    method complete-words {parse} {
	debug.cmdr/parameter {} 10
	# Entrypoint for completion, called by
	# cmdr::config (complete-words|complete-repl).
	# See cmdr::actor/parse-line for structure definition.
	dict with parse {}
	# -> words, at (ignored: ok, nwords, line, doexit)

	# We need just the text of the current word.
	set current [lindex $words $at end]

	# Actual completion is delegated to the validation type of the
	# parameter.
	return [{*}$myvalidate complete [self] $current]
    }

    method setq {queue} {
	debug.cmdr/parameter {}
	my Locked
	if {$myislist} {
	    # Bug 99702. The 'get' method of queues is variable-type.
	    # Retrieve 2 or more elements => get a list.
	    # Retrieve one element => get that element (NOT a list of one element).
	    # So, if our splat argument consists of just one element we have to
	    # undo 'get's stripping of list-ness, mystring must always be a list.

	    set n [$queue size]
	    set mystring [$queue get $n]

	    if {$n == 1} {
		set mystring [::list $mystring]
	    }
	} else {
	    set mystring [$queue get]
	}
	set myhasstring yes

	my forget

	if {[llength $mywhenset]} {
	    {*}$mywhenset [self] $mystring
	}
	return
    }

    method set {value} {
	debug.cmdr/parameter {}
	my Locked
	if {$myislist} {
	    lappend mystring $value
	} else {
	    set mystring $value
	}
	set myhasstring yes

	my forget

	if {[llength $mywhenset]} {
	    {*}$mywhenset [self] $mystring
	}
	return
    }

    method accept {x} {
	debug.cmdr/parameter {}
	try {
	    my ValueRelease [{*}$myvalidate validate [self] $x]
	    # If that was ok it has to be released also!
	    # XXX Or should we maybe immediately cache it for 'value'?
	} trap {CMDR VALIDATE} {e o} {
	    #puts "$myname (type mismatch, pass, $e)"
	    # Type mismatch, pass.
	    return 0
	} ; # internal errors bubble further
	return 1
    }

    method Locked {} {
	if {$mylocker eq {}} return
	debug.cmdr/parameter {}
	return -code error \
	    -errorcode {CMDR PARAMETER LOCKED} \
	    "You cannot use \"[my name]\" together with \"$mylocker\"."
    }

    method process {detail queue} {
	debug.cmdr/parameter {}
	# detail = actual flag (option)
	#        = parameter name (argument)

	my Assert {$myiscmdline} "Illegal command line input for state parameter \"$myname\""

	if {$myisordered} {
	    my ProcessArgument $queue
	    return
	}

	# Option parameters.
	my ProcessOption $detail $queue
	return
    }

    method ProcessArgument {queue} {
	debug.cmdr/parameter {}
	# Arguments.

	if {$myisrequired} {
	    # Required. Unconditionally retrieve its parameter
	    # value. Must have a value.
	    if {![$queue size]} { config notEnough }
	} elseif {![my Take $queue]} return

	# Optional. Conditionally retrieve the parameter value based
	# on argument count and threshold or validation of the
	# value. For the count+threshold method to work we have to
	# process (i.e. remove) all the options first.

	# Note also the possibility of the argument being a list.

	my setq $queue
	return
    }

    method ProcessOption {flag queue} {
	debug.cmdr/parameter {}
	if {$myonlypresence} {
	    # See also cmdr::config/dispatch
	    # Option has only presence.
	    # Validation type is 'boolean'.
	    # Default value is 'no', presence therefore 'yes'.
	    my set yes
	    return
	}

	if {[my isbool]} {
	    # XXX Consider a way of pushing this into the validator classes.

	    # Look for and process boolean special forms.

	    # Insert implied boolean flag value.
	    #
	    # --foo    non-boolean-value ==> --foo YES non-boolean-value
	    # --no-foo non-boolean-value ==> --foo NO  non-boolean-value

	    # Invert meaning of option.
	    # --no-foo YES ==> --foo NO
	    # --no-foo NO  ==> --foo YES

	    # Take implied or explicit value.
	    if {![$queue size] || ![string is boolean -strict [$queue peek]]} {
		set value yes
	    } else {
		# queue size && boolean
		set value [$queue get]
	    }

	    # Invert meaning, if so requested.
	    if {[string match --no-* $flag]} {
		set value [expr {!$value}]
	    }
	} else {
	    # Everything else has no special forms. The option's value
	    # is required here.
	    if {![$queue size]} { config missingOptionValue $flag }
	    set value [$queue get]
	}

	my set $value
	return
    }

    method Take {queue} {
	debug.cmdr/parameter {threshold $mythreshold}

	if {$mythreshold >= 0} {
	    # Choose by checking argument count against a threshold.

	    # For this to work correctly we now have to process all
	    # the remaining options first. Except for list
	    # arguments. These are last, and thus will always
	    # take whatever where is. Ok, we pass on an empty
	    # queue.

	    if {$myislist} {
		if {[$queue size]} {
		    debug.cmdr/parameter {list, taken}
		    return 1
		} else {
		    debug.cmdr/parameter {list, empty, pass}
		    return 0
		}
	    }

	    config parse-options

	    if {[$queue size] <= $mythreshold} {
		debug.cmdr/parameter {Q[$queue size] <= T$mythreshold: pass}
		# Not enough values left, pass.
		return 0
	    }
	    debug.cmdr/parameter {Q[$queue size] >  T$mythreshold: taken}
	    return 1
	} elseif {[$queue size]} {
	    debug.cmdr/parameter {validate ([$queue peek])}
	    # Choose by peeking at and validating the front value.
	    # Note: We may not have a front value!
	    set take [my accept [$queue peek]]
	    debug.cmdr/parameter {= [expr {$take ? "taken" : "pass"}]}
	    return $take
	} else {
	    # peek+test mode, nothing to peek at, pass.
	    debug.cmdr/parameter {no argument, pass}
	    return 0
	}
	debug.cmdr/parameter {should not be reached}
	return -code error -errorcode {CMDR PARAMETER INTERNAL} \
	    "Should not be reached"
    }

    # # ## ### ##### ######## #############
    ## APIs for use in the actual command called by the private
    ## containing the cmdr::config holding this value.
    #
    # - retrieve user string
    # - retrieve validated value, internal representation.
    # - query if a value is defined.

    method string {} {
	if {!$myhasstring} {
	    my undefined!
	}
	return $mystring
    }

    method set? {} {
	return $myhasstring
    }

    method value {} {
	debug.cmdr/parameter {}

	# Pull interaction suppression into the scope, and reset for
	# future calls. Suppression is a one-shot thing.
	set stopinteraction $mystopinteraction
	set mystopinteraction no

	# compute argument value if any, cache result.

	# Calculate value, from most prefered to least
	#
	# (0) Cache valid ?
	#     => Return
	#
	# (1) User entered value ?
	#     => Is string rep. Validate and transform to int. rep.
	#
	# (2) Generation command ?
	#     => Run, result is the int. rep. No validation, nor transform.
	#
	# (3) Default value ?
	#     => Take. It is int. rep. No validation, nor transform.
	#
	# (4) Interactive entry possible ? (general config, plus per value)
	#     Enter (string rep): validate and transform
	#     - mini shell - ^C abort
	#     - completion => Validator API
	#
	# (5) Optional ?
	#     => It is ok to not have the value. Return empty string.
	#     This should not be possible actually, because of [R12],
	#     [C5], and [C6].
	#
	#
	# (6) FAIL. 

	if {$myhasvalue} {
	    debug.cmdr/parameter {/cached ==> ($myvalue)}
	    return $myvalue
	}

	# Do not run the whole value generation a second time, when
	# the first already failed.
	if {$myisundefined} {
	    my undefined!
	}

	# Note that myvalidate and mygenerate are executed in this
	# scope, which implies the parameter instance namespace, which
	# implies access to the 'config' command, and thus the other
	# parameters. IOW, parameter generation and/or validation can
	# use the value of other parameters for their work. Catching
	# infinite loops so created are outside the scope of this
	# code.

	if {$myhasstring} {
	    debug.cmdr/parameter {/user}
	    # Specified on command line, string rep. Validate and
	    # transform to the int. rep.
	    #
	    # See "FillMissingValidation" on why we always have a
	    # validator command.

	    if {$myislist} {
		# Treat user-specified value as list and validate each
		# element.
		set myvalue {}
		foreach v $mystring {
		    lappend myvalue [{*}$myvalidate validate [self] $v]
		}
	    } else {
		set myvalue [{*}$myvalidate validate [self] $mystring]
	    }

	    debug.cmdr/parameter {/user ==> ($myvalue)}
	    my Value: $myvalue
	}

	if {!$stopinteraction && $myinteractive && [cmdr interactive?]} {
	    # Interaction.
	    debug.cmdr/parameter {/interact begin}
	    my interact

	    debug.cmdr/parameter {/interact ==> ($myvalue)}
	    return $myvalue
	}

	if {[llength $mygenerate]} {
	    # Generation callback. Result is int. rep.
	    debug.cmdr/parameter {/generate begin}
	    set v [{*}$mygenerate [self]]
	    debug.cmdr/parameter {/generate ==> ($v)}
	    my Value: $v
	}

	if {$myhasdefault} {
	    debug.cmdr/parameter {/default ==> ($mydefault)}
	    # A declared default value is the int. rep. No validation,
	    # no transform. Set it directly.
	    my Value: $mydefault
	}

	if {!$myisrequired} {
	    debug.cmdr/parameter {/optional, empty}
	    # Hardwired default int. rep if all else failed.
	    my Value: {}
	}

	debug.cmdr/parameter {undefined!}
	my undefined!
    }

    method interact {{prompt {}}} {
	debug.cmdr/parameter {}
	# Note: ^C for prompt aborts system.
	#       ^C for list aborts loop, but not system.
	# Details below.

	if {$prompt eq {}} {
	    set prompt $myprompt
	}

	if {$myislist} {
	    debug.cmdr/parameter {/list}
	    # Prompt for a list of values. We loop until the user
	    # aborted. The latter aborts just the loop. Completion
	    # is done through the chosen validation type. Invalid
	    # values are reported and ignored.
	    set continue 1

	    set thestringlist {}
	    set thevaluelist {}

	    puts $prompt
	    flush stdout

	    while {$continue} {
		debug.cmdr/parameter {/enter}
		#set continue 0
		try {
		    set thestring [linenoise prompt \
				       -prompt "  Item [llength $thevaluelist]> " \
				       -complete [::list {*}$myvalidate complete [self]]]
		} on error {e o} {
		    debug.cmdr/parameter {trapped $e}
		    debug.cmdr/parameter {options $o}

		    if {$e eq "aborted"} {
			set continue 0
		    } else {
			return {*}$o $e
		    }
		}
		if {!$continue} {
		    debug.cmdr/parameter {/break on ^C}
		    break
		}

		if {$thestring eq {}} {
		    debug.cmdr/parameter {/break on empty input}
		    # Plain enter. Nothing entered. Treat as abort.
		    break
		}

		set take 1
		try {
		    set thevalue [{*}$myvalidate validate [self] $thestring]
		} trap {CMDR VALIDATE} {e o} {
		    set take 0
		    puts "$e, ignored"
		}
		if {$take} {
		    debug.cmdr/parameter {/keep $thevalue}
		    lappend thestringlist $thestring
		    lappend thevaluelist  $thevalue
		}
	    }

	    # Inlined 'set' and 'Value:'. Modified to suit.
	    set     myhasstring yes
	    lappend mystring    {*}$thestringlist
	    set     myhasvalue  yes
	    lappend myvalue     {*}$thevaluelist

	} else {
	    debug.cmdr/parameter {/single}
	    # Prompt for a single value. We loop until a valid
	    # value was entered, or the user aborted. The latter
	    # aborts the whole operation. Completion is done through
	    # the chosen validation type.
	    set continue 1
	    while {$continue} {
		set abort 0
		set continue 0
		try {
		    set thestring [linenoise prompt \
				       -prompt $prompt \
				       -complete [::list {*}$myvalidate complete [self]]]
		} on error {e o} {
		    debug.cmdr/parameter {trapped $e}
		    debug.cmdr/parameter {options $o}

		    if {$e eq "aborted"} {
			debug.cmdr/parameter {/abort}
			# prevent system from taking which does not exist
			set abort 1
		    } else {
			# rethrow any other error
			return {*}$o $e
		    }
		}

		if {$abort} {
		    debug.cmdr/parameter {/break on ^C}
		    my undefined!
		}

		try {
		    set thevalue [{*}$myvalidate validate [self] $thestring]
		} trap {CMDR VALIDATE} {e o} {
		    debug.cmdr/parameter {trap $e}
		    puts "$e, ignored"
		    set continue 1
		}
	    }

	    # Inlined 'set'. Modified to suit. No locking, nor lock
	    # check, nor forgetting, except release of a previous value.

	    set myhasstring yes
	    set mystring    $thestring
	    if {$myhasvalue} { my ValueRelease $myvalue }
	    my Value: $thevalue
	}
	return
    }

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

    method undefined! {} {
	set myisundefined yes
	debug.cmdr/parameter {}
	return -code error \
	    -errorcode {CMDR PARAMETER UNDEFINED} \
	    "Undefined: $myname"
    }

    method Value: {v} {
	debug.cmdr/parameter {}
	if {[llength $mywhencomplete]} {
	    {*}$mywhencomplete [self] $v
	}
	set myvalue $v
	set myhasvalue yes

	# Return value, abort caller!
	return -code return $myvalue
    }

    method ValueRelease {value} {
	debug.cmdr/parameter {}
	# The validation type knows how to fully clean up the
	# value it returned during validation (See methods
	# 'value' and 'Take' (mode peek+test)).

	if {$myislist} {
	    foreach v $myvalue {
		{*}$myvalidate release [self] $v
	    }
	} else {
	    {*}$myvalidate release [self] $myvalue
	}
	return
    }

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

    variable myname mylabel mydescription \
	myisordered myiscmdline myislist myisrequired \
	myinteractive myprompt mydefault myhasdefault \
	mywhencomplete mywhenset mygenerate myvalidate \
	myflags mythreshold myhasstring mystring \
	myhasvalue myvalue mylocker mystopinteraction \
	myisdocumented myonlypresence myisdefered \
	myisundefined mynopromote

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::parameter 1.0

Added support/pkgIndex.tcl.



























>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13

package ifneeded cmdr                   1 [list source [file join $dir cmdr.tcl]]
package ifneeded cmdr::actor            1 [list source [file join $dir actor.tcl]]
package ifneeded cmdr::config           1 [list source [file join $dir config.tcl]]
package ifneeded cmdr::help             1 [list source [file join $dir help.tcl]]
package ifneeded cmdr::help::json       1 [list source [file join $dir help_json.tcl]]
package ifneeded cmdr::help::sql        1 [list source [file join $dir help_sql.tcl]]
package ifneeded cmdr::officer          1 [list source [file join $dir officer.tcl]]
package ifneeded cmdr::parameter        1 [list source [file join $dir parameter.tcl]]
package ifneeded cmdr::private          1 [list source [file join $dir private.tcl]]
package ifneeded cmdr::util             1 [list source [file join $dir util.tcl]]
package ifneeded cmdr::validate         1 [list source [file join $dir validate.tcl]]
package ifneeded cmdr::validate::common 1 [list source [file join $dir vcommon.tcl]]

Added support/private.tcl.

























































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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
169
170
171
172
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Private - Command execution. Simple case.
##                  An actor.

## - Privates know to do one thing, exactly, and nothing more.
##   They can process their command line to extract/validate
##   the inputs they need for their action from the arguments.

# @@ Meta Begin
# Package cmdr::private 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary Single command handling, options, and arguments.
# Meta description 'cmdr::private's know to do one thing, exactly,
# Meta description and nothing more. They can process their command
# Meta description line to extract/validate the inputs they need
# Meta description for their action from the arguments.
# Meta subject {command line} arguments options
# Meta require TclOO
# Meta require cmdr::actor
# Meta require cmdr::config
# Meta require debug
# Meta require debug::caller
# Meta require {Tcl 8.5-}
# Meta require {oo::util 1.2}
# @@ Meta End

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

package require Tcl 8.5
package require debug
package require debug::caller
package require TclOO
package require oo::util 1.2 ;# link helper
package require cmdr::actor
package require cmdr::config

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

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

# # ## ### ##### ######## ############# #####################
## Definition - Single purpose command.

oo::class create ::cmdr::private {
    superclass ::cmdr::actor
    # # ## ### ##### ######## #############
    ## Lifecycle.

    # argument specification + callback performing the action.
    # callback takes dictionary containing the actual arguments
    constructor {super name arguments cmdprefix} {
	debug.cmdr/private {}
	next

	my super: $super
	my name:  $name

	set myarguments $arguments
	set mycmd       $cmdprefix
	set myinit      0
	set myhandler   {}
	return
    }

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

    method ehandler {cmd} {
	debug.cmdr/private {}
	set myhandler $cmd
	return
    }

    # # ## ### ##### ######## #############
    ## Internal. Argument processing. Defered until required.
    ## Core setup code runs only once.

    method Setup {} {
	# Process myarguments only once.
	if {$myinit} return
	debug.cmdr/private {}
	set myinit 1

	# Create and fill the parameter collection
	set myconfig [cmdr::config create config [self] $myarguments]
	return
    }

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

    method do {args} {
	debug.cmdr/private {}
	my Setup

	if {[llength $myhandler]} {
	    # The handler is expected to have a try/finally construct
	    # which captures all of interest.
	    {*}$myhandler {
		my Run $args
	    }
	} else {
	    my Run $args
	}
    }

    method Run {words} {
	debug.cmdr/private {}
	debug.cmdr/private {parse}
	try {
	    config parse {*}$words
	} trap {CMDR CONFIG WRONG-ARGS NOT-ENOUGH} {e o} {
	    # Prevent interaction if globally suppressed, or just for
	    # this actor.
	    if {![cmdr interactive?] ||
		![config interactive]} {
		return {*}$o $e
	    }
	    if {![config interact]} return
	}

	debug.cmdr/private {complete values}

	# Define all parameters now, resolving defaults, validating
	# the values, etc. Except for the 'defered' parameters. By
	# default this are only the 'state' parameters.
	config force

	debug.cmdr/private {execute}
	# Call actual command, hand it the filled configuration.
	{*}$mycmd $myconfig 
    }

    method help {{prefix {}}} {
	debug.cmdr/private {}
	my Setup
	# help    = dict (name -> command)
	# command = dict ('action'    -> cmdprefix
	#                 ... see config help ...)
	#if {![my documented]} { return {} }

	set help [linsert [config help] end action $mycmd]
	return [dict create $prefix $help]
    }

    method complete-words {parse} {
	debug.cmdr/private {} 10
	my Setup
	return [my completions $parse [config complete-words $parse]]
    }

    # Redirect anything not known to the parameter collection.
    method unknown {m args} {
	debug.cmdr/private {}
	my Setup
	config $m {*}$args
    }

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

    variable myarguments mycmd myinit myconfig myhandler

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::private 1.0

Added support/util.tcl.



















































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Util - General utilities

# @@ Meta Begin
# Package cmdr::util 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Internal. General utilities.
# Meta description Internal. General utilities.
# Meta subject {command line}
# Meta require {Tcl 8.5-}
# Meta require textutil::adjust
# Meta require debug
# Meta require debug::caller
# @@ Meta End

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

package require Tcl 8.5
package require debug
package require debug::caller

# # ## ### ##### ######## ############# #####################
## Definition

namespace eval ::cmdr {
    namespace export util
    namespace ensemble create
}

namespace eval ::cmdr::util {
    namespace export padr dictsort
    namespace ensemble create
}

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

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

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

proc ::cmdr::util::padr {list} {
    debug.cmdr/util {}
    if {[llength $list] <= 1} {
	return $list
    }
    set maxl 0
    foreach str $list {
	set l [string length $str]
	if {$l <= $maxl} continue
	set maxl $l
    }
    set res {}
    foreach str $list { lappend res [format "%-*s" $maxl $str] }
    return $res
}

proc ::cmdr::util::dictsort {dict} {
    set r {}
    foreach k [lsort -dict [dict keys $dict]] {
	lappend r $k [dict get $dict $k]
    }
    return $r
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::util 1.0

Added support/validate.tcl.











































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
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
314
315
316
317
318
319
320
321
322
323
324
325
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Validate - Definition of core validation classes.

# @@ Meta Begin
# Package cmdr::validate 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Standard validation types for parameters.
# Meta description Standard validation types for parameters.
# Meta subject {command line}
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# @@ Meta End

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

package require Tcl 8.5
package require cmdr::validate::common
package require debug
package require debug::caller

# # ## ### ##### ######## ############# #####################
## Definition

namespace eval ::cmdr {
    namespace export validate
    namespace ensemble create
}

namespace eval ::cmdr::validate {
    namespace export boolean integer identity pass str \
	rfile rwfile rdirectory rwdirectory rpath rwpath
    #namespace ensemble create

    # For external v-types relying on them here.
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-enum
}

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

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

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

namespace eval ::cmdr::validate::boolean {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-enum
}

proc ::cmdr::validate::boolean::release  {p x} { return }
proc ::cmdr::validate::boolean::default  {p}  {
    debug.cmdr/validate {}
    return no
}

proc ::cmdr::validate::boolean::complete {p x} {
    debug.cmdr/validate {} 10
    return [complete-enum {yes no false true on off 0 1} 1 $x]
}

proc ::cmdr::validate::boolean::validate {p x} {
    debug.cmdr/validate {}
    if {[string is boolean -strict $x]} {
	# Double inverse keeps value, and makes it canonical.
	return [expr {!!$x}]
    }
    fail $p BOOLEAN "a boolean" $x
}

# # ## ### ##### ######## ############# #####################
## Any integer

namespace eval ::cmdr::validate::integer {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
}

proc ::cmdr::validate::integer::release  {p x} { return }
proc ::cmdr::validate::integer::default  {p}  {
    debug.cmdr/validate {}
    return 0
}
proc ::cmdr::validate::integer::complete {p x} {
    debug.cmdr/validate {} 10
    return {}
}
proc ::cmdr::validate::integer::validate {p x} {
    debug.cmdr/validate {}
    if {[string is integer -strict $x]} { return $x }
    fail $p INTEGER "an integer" $x
}

# # ## ### ##### ######## ############# #####################
## Any string

namespace eval ::cmdr::validate::identity {
    namespace export default validate complete release
    namespace ensemble create
}

proc ::cmdr::validate::identity::release  {p x} { return }
proc ::cmdr::validate::identity::default  {p}   { debug.cmdr/validate {}    ; return {} }
proc ::cmdr::validate::identity::complete {p x} { debug.cmdr/validate {} 10 ; return {} }
proc ::cmdr::validate::identity::validate {p x} { debug.cmdr/validate {}    ; return $x }

# # ## ### ##### ######## ############# #####################
## Any string, alternate name

namespace eval ::cmdr::validate::pass {
    namespace export default validate complete release
    namespace ensemble create
}

proc ::cmdr::validate::pass::release  {p x} { return }
proc ::cmdr::validate::pass::default  {p}   {debug.cmdr/validate {}    ; return {} }
proc ::cmdr::validate::pass::complete {p x} {debug.cmdr/validate {} 10 ; return {} }
proc ::cmdr::validate::pass::validate {p x} {debug.cmdr/validate {}    ; return $x }

# # ## ### ##### ######## ############# #####################
## Any string, alternate name, the second

namespace eval ::cmdr::validate::str {
    namespace export default validate complete release
    namespace ensemble create
}

proc ::cmdr::validate::str::release  {p x} { return }
proc ::cmdr::validate::str::default  {p}   { debug.cmdr/validate {}    ; return {} }
proc ::cmdr::validate::str::complete {p x} { debug.cmdr/validate {} 10 ; return {} }
proc ::cmdr::validate::str::validate {p x} { debug.cmdr/validate {}    ; return $x }

# # ## ### ##### ######## ############# #####################
## File, existing and readable

namespace eval ::cmdr::validate::rfile {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rfile::release  {p x} { return }
proc ::cmdr::validate::rfile::default  {p}   { return {} }
proc ::cmdr::validate::rfile::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rfile::Ok $x
}
proc ::cmdr::validate::rfile::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RFILE "an existing readable file" $x
}

proc ::cmdr::validate::rfile::Ok {path} {
    if {![file exists   $path]} {return 0}
    if {![file isfile   $path]} {return 0}
    if {![file readable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## File, existing and read/writable

namespace eval ::cmdr::validate::rwfile {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rwfile::release  {p x} { return }
proc ::cmdr::validate::rwfile::default  {p}   { return {} }
proc ::cmdr::validate::rwfile::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rwfile::Ok $x
}
proc ::cmdr::validate::rwfile::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RWFILE "an existing read/writable file" $x
}

proc ::cmdr::validate::rwfile::Ok {path} {
    if {![file exists   $path]} {return 0}
    if {![file isfile   $path]} {return 0}
    if {![file readable $path]} {return 0}
    if {![file writable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Directory, existing and readable.

namespace eval ::cmdr::validate::rdirectory {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rdirectory::release  {p x} { return }
proc ::cmdr::validate::rdirectory::default  {p}   { return {} }
proc ::cmdr::validate::rdirectory::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rdirectory::Ok $x
}

proc ::cmdr::validate::rdirectory::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RDIRECTORY "an existing readable directory" $x
}

proc ::cmdr::validate::rdirectory::Ok {path} {
    if {![file exists      $path]} {return 0}
    if {![file isdirectory $path]} {return 0}
    if {![file readable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Directory, existing and read/writable.

namespace eval ::cmdr::validate::rwdirectory {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rwdirectory::release  {p x} { return }
proc ::cmdr::validate::rwdirectory::default  {p}   { return {} }
proc ::cmdr::validate::rwdirectory::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rwdirectory::Ok $x
}

proc ::cmdr::validate::rwdirectory::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RWDIRECTORY "an existing read/writeable directory" $x
}

proc ::cmdr::validate::rwdirectory::Ok {path} {
    if {![file exists      $path]} {return 0}
    if {![file isdirectory $path]} {return 0}
    if {![file readable    $path]} {return 0}
    if {![file writable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Any path, existing and readable.

namespace eval ::cmdr::validate::rpath {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rpath::release  {p x} { return }
proc ::cmdr::validate::rpath::default  {p}   { return {} }
proc ::cmdr::validate::rpath::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rpath::Ok $x
}

proc ::cmdr::validate::rpath::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RPATH "an existing readable path" $x
}

proc ::cmdr::validate::rpath::Ok {path} {
    if {![file exists      $path]} {return 0}
    if {![file isdirectory $path]} {return 0}
    if {![file readable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Any path, existing and read/writable.

namespace eval ::cmdr::validate::rwpath {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rwpath::release  {p x} { return }
proc ::cmdr::validate::rwpath::default  {p}   { return {} }
proc ::cmdr::validate::rwpath::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rwpath::Ok $x
}

proc ::cmdr::validate::rwpath::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RWPATH "an existing read/writeable path" $x
}

proc ::cmdr::validate::rwpath::Ok {path} {
    if {![file exists      $path]} {return 0}
    if {![file readable    $path]} {return 0}
    if {![file writable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::validate 1.0
return

Added support/vcommon.tcl.



































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Validate - Common utility commands.

# @@ Meta Begin
# Package cmdr::validate::common 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Utilities for validation types.
# Meta description Utilities for validation types.
# Meta subject {command line} {parameter validation}
# Meta subject {validation type} {type checking}
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# @@ Meta End

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

package require Tcl 8.5
package require debug
package require debug::caller

# # ## ### ##### ######## ############# #####################
## Definition

namespace eval ::cmdr {
    namespace export validate
    namespace ensemble create
}

namespace eval ::cmdr::validate {
    namespace export common
    namespace ensemble create
}

namespace eval ::cmdr::validate::common {
    namespace export fail complete-enum complete-glob
    namespace ensemble create
}

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

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

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

proc ::cmdr::validate::common::fail {p code type x} {
    debug.cmdr/validate/common {}

    # Determine type of p: state, option, or input.  Use this to
    # choose a proper identifying string in the generated message.

    set ptype [$p type]

    if {$ptype eq "option"} {
	set name [$p flag]
    } else {
	set name [$p label]
    }
    return -code error -errorcode [list CMDR VALIDATE {*}$code] \
	"Expected $type for $ptype \"$name\", got \"$x\""
}

proc ::cmdr::validate::common::complete-enum {choices nocase buffer} {
    # As a helper function for command completion printing anything
    # here would mix with the output of linenoise. Do that only on
    # explicit request (level 10).
    debug.cmdr/validate/common {} 10

    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
    }

    debug.cmdr/validate/common {= [join $candidates "\n= "]} 10
    return $candidates
}

proc ::cmdr::validate::common::complete-glob {filter buffer} {
    debug.cmdr/validate/common {} 10

    # Treat everything in the buffer as literal prefix.
    # Disable all glob special characters.
    regsub -all {(.)} $buffer {\\\1} buffer

    set candidates {}
    foreach path [glob -nocomplain ${buffer}*] {
	if {![{*}$filter $path]} continue
	lappend candidates $path
    }

    debug.cmdr/validate/common {= [join $candidates "\n= "]} 10
    return $candidates
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::validate::common 1.0
return