cmdr
Check-in [6163942da7]
Not logged in

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

Overview
Comment:Merged trunk extensions.
Timelines: family | ancestors | descendants | both | more-vtypes
Files: files | file ages | folders
SHA1:6163942da7e6010bef421e7ef15bf9c82738643a
User & Date: aku 2014-04-22 06:55:23
Context
2014-04-22
06:56
Merged branch back, making the channel v-types official. check-in: c7a27f1422 user: aku tags: trunk
06:55
Merged trunk extensions. Closed-Leaf check-in: 6163942da7 user: aku tags: more-vtypes
2014-04-16
19:46
cmdr::validate::common - Added commands to generate more specific error messages, while still general - From stackato client. Bumped version to 1.2. check-in: 8e18e110df user: andreask tags: trunk
2014-03-13
18:36
cmdr::validate - Replaced all uses of "OkDir" with the shared "ok-directory". Changed the "rw*" types to allow missing file/dir/path like the "w*" types.. Fixed the fail messages for "wfile" and "wchan". check-in: 62fbd92a1b user: andreask tags: more-vtypes
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to actor.tcl.

49
50
51
52
53
54
55




56
57
58
59
60
61
62
...
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
...
309
310
311
312
313
314
315
316
    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).
................................................................................
    }

    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.
................................................................................

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::actor 1.1







>
>
>
>







 







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







 







|
>







 







|
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
...
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
...
341
342
343
344
345
346
347
348
    constructor {} {
	debug.cmdr/actor {}
	set myname        {}
	set mydescription {}
	set mydocumented  yes
	set mysuper       {}
	set mystore       {}

	set myhistory     {} ; # History handler, reporting commands just about
	#                      # to be executed, and other events related to
	#                      # history management.
	return
    }

    # # ## ### ##### ######## #############
    ## Public API: Common actor attributes and behaviour
    ## - Name.
    ## - Description (help information).
................................................................................
    }

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

    method unset-all {key} {
	debug.cmdr/actor {}
	dict unset mystore $key
	if {$mysuper eq {}} return
	$mysuper unset-all $key
	return
    }

    method history-via {cmd} {
	debug.cmdr/actor {}
	set myhistory $cmd
	return
    }

    method history-setup {} {
	debug.cmdr/actor {}
	if {![llength $myhistory]} {return {}}
	return [{*}$myhistory initialize [self]]
    }

    method history-add {cmd} {
	debug.cmdr/actor {}
	if {![llength $myhistory]} return
	{*}$myhistory add [string trim $cmd]
	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 myhistory

    # # ## ### ##### ######## #############
    ## 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.
................................................................................

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::actor 1.2

Changes to doc/parts/ex_alias_backend.inc.

62
63
64
65
66
67
68

69

70
	manager remove $name
	say [color green "Successfully unaliased '$name'"]
    }
    return
}

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

package provide foo::backend::alias 0

}]







>
|
>

62
63
64
65
66
67
68
69
70
71
72
	manager remove $name
	say [color green "Successfully unaliased '$name'"]
    }
    return
}

# # ## ### ##### ######## ############# #####################
package provide \
	foo::backend::alias 0
# 2 lines, hidden from kettle scanner.
}]

Changes to embedded/man/files/cmdr_dsl.n.

444
445
446
447
448
449
450

451

452
453
454
455
456
457
458
	manager remove $name
	say [color green "Successfully unaliased '$name'"]
    }
    return
}

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

package provide foo::backend::alias 0


.CE
.SH "LANGUAGE REFERENCE"
With the examples behind us we can now go and specify the entire
specification language\&. If you have skipped here on first reading,
ignoring the examples, please go back and read them first\&.
.PP







>
|
>







444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
	manager remove $name
	say [color green "Successfully unaliased '$name'"]
    }
    return
}

# # ## ### ##### ######## ############# #####################
package provide \
        foo::backend::alias 0
# 2 lines, hidden from kettle scanner.

.CE
.SH "LANGUAGE REFERENCE"
With the examples behind us we can now go and specify the entire
specification language\&. If you have skipped here on first reading,
ignoring the examples, please go back and read them first\&.
.PP

Changes to embedded/www/doc/files/cmdr_dsl.html.

291
292
293
294
295
296
297

298

299
300
301
302
303
304
305
    } else {
	manager remove $name
	say [color green "Successfully unaliased '$name'"]
    }
    return
}
# # ## ### ##### ######## ############# #####################

package provide foo::backend::alias 0

</pre>
</div>
</div>
<div id="section4" class="section"><h2><a name="section4">Language Reference</a></h2>
<p>With the examples behind us we can now go and specify the entire
specification language. If you have skipped here on first reading,
ignoring the examples, please go back and read them first.</p>







>
|
>







291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
    } else {
	manager remove $name
	say [color green &quot;Successfully unaliased '$name'&quot;]
    }
    return
}
# # ## ### ##### ######## ############# #####################
package provide \
        foo::backend::alias 0
# 2 lines, hidden from kettle scanner.
</pre>
</div>
</div>
<div id="section4" class="section"><h2><a name="section4">Language Reference</a></h2>
<p>With the examples behind us we can now go and specify the entire
specification language. If you have skipped here on first reading,
ignoring the examples, please go back and read them first.</p>

Changes to help.tcl.

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
	    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 {
	section *AutoGenerated*
	description {
	    Retrieve help for a command or command set.
	    Without arguments help for all commands is given.
	    The default format is --full.
	}
	@options@
................................................................................
	    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]







<

|







 







|







102
103
104
105
106
107
108

109
110
111
112
113
114
115
116
117
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
	    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]


    $actor extend help [string map $map {
	section *AutoGenerated*
	description {
	    Retrieve help for a command or command set.
	    Without arguments help for all commands is given.
	    The default format is --full.
	}
	@options@
................................................................................
	    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 }
    }] [list ::cmdr::help::auto-help $actor]
    return
}

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

    set width  [$config @width]

Added history.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
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - History - Utility package commands.

# @@ Meta Begin
# Package cmdr::history 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Utilities to support an external history
# Meta description Utilities to support an external history
# Meta subject {command line} history {external history}
# Meta subject {save history} {load history}
# Meta require {Tcl 8.5-}
# Meta require fileutil
# Meta require debug
# Meta require debug::caller
# @@ Meta End

# Limits 'n'
# < 0 | History on.  Keep everything 
# = 0 | History off. Keep nothing.
# > 0 | History on.  Keep last n entries.

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

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

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

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

namespace eval ::cmdr::history {
    namespace export attach save-to initial-limit
    namespace ensemble create

    # Path to the file the history is stored in.
    # The default value shown below disables history.
    variable file {}

    # State information about the history subsystem.
    variable loaded  0 ; # Boolean: Has the history file been loaded yet ?
    variable limit  -1 ; # Limits. Default: active, no limits.
    variable cache  {} ; # In-memory list of the saved commands for easier limit handling.
}

# Helper ensemble.
namespace eval ::cmdr::history::mgr {
    namespace ensemble create -map {
	initialize ::cmdr::history::Init
	add        ::cmdr::history::Add
    }
}

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

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

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

proc ::cmdr::history::save-to {path} {
    debug.cmdr/history {}
    variable file $path
    return
}

proc ::cmdr::history::initial-limit {new} {
    debug.cmdr/history {}
    variable limit $new
    return
}

proc ::cmdr::history::attach {actor} {
    debug.cmdr/history {}
    # cmdr shandler to use.
    # The actor is the officer to extend.

    # (***) Detect recursive entry through the extend statements
    # below. Use this to make 'history list' the default of the whole
    # history officer. And, of course, prevent infinite recursion.

    if {[$actor name] eq "history"} {
	$actor learn {default list}
	return
    }

    # (1) Intercept dispatch and record all user commands.
    #
    # Note how this is NOT attached to the history officer itself.
    # Execution of history management commands is not recorded in the
    # history.
    #
    # Note also that it is attached to all privates of any officer we
    # attach to.

    $actor history-via ::cmdr::history::mgr
    foreach a [$actor children] {
	$a history-via ::cmdr::history::mgr
    }

    # (2) Extend the root officer, and only the root, with a
    #     subordinate officer and privates providing access to the
    #     history management here.

    # FUTURE: Limit amount of saved commands.
    # FUTURE: Automatic loading of saved history into the
    # FUTURE: toplevel officer. (dhandler sub-methods?)
    # FUTURE: History redo commands.

    if {[$actor root] != $actor} return

    $actor extend {history list} {
	section Introspection {Command history}
	description {
	    Show the saved history of commands.
	}
	input n {
	    Show the last n history entries.
	    Default is to show all.
	} {
	    optional
	    default 0
	    validate integer
	}
    } ::cmdr::history::Show
    # This recurses into 'attach' through the automatic inheritance of
    # the shandler. See (***) above for the code intercepting the
    # recursion and preventing it from becoming infinite.

    $actor extend {history clear} {
	section Introspection {Command history}
	description {
	    Clear the saved history.
	}
    } ::cmdr::history::Clear

    $actor extend {history limit} {
	section Introspection {Command history}
	description {
	    Limit the size of the history.
	    If no limit is specified the current limit is shown.
	}
	input n {
	    The number of commands to limit the history to.
	    For a value > 0 we keep that many commands in the history.
	    For a value < 0 we keep all commands, i.e. unlimited history.
	    For a value = 0 we keep nothing, i.e. no history.
	} {
	    optional
	    default -1
	    validate integer
	}
    } ::cmdr::history::Limit

    return
}

# # ## ### ##### ######## ############# #####################
## Handler invoked by the main framework when an officer starts
## an interactive shell.

proc ::cmdr::history::Init {actor} {
    debug.cmdr/history {}
    Load

    # Non-root actors and shell do not have access to the full history.
    if {[$actor root] != $actor} {
	return {}
    }

    # Root actor gets access the saved history
    variable cache
    return  $cache
}

# # ## ### ##### ######## ############# #####################
## Handler invoked by the main framework to save commands
## just before they are run.

proc ::cmdr::history::Add {command} {
    debug.cmdr/history {}
    Load

    # Shortcircuit if we are not keeping any history.
    variable limit
    if {$limit == 0} return

    # Extend history
    variable cache
    lappend  cache $command

    # And save it, possibly limiting the number of entries.
    if {[Restrict]} {
	SaveAll
    } else {
	SaveLast
    }
    return
}

proc ::cmdr::history::Restrict {} {
    variable limit
    debug.cmdr/history {limit = $limit}

    # There are no limits set, there is nothing to do.
    if {$limit < 0} {
	debug.cmdr/history {/no limit}
	return 0
    }

    variable cache
    debug.cmdr/history {cache len = [llength $cache]}

    set delta [expr {[llength $cache] - $limit}]

    debug.cmdr/history {delta = $delta}

    # The stored amount of history is still under the imposed limit,
    # so there is nothing to do.
    if {$delta < 0} {
	debug.cmdr/history {Under limit by [expr {- $delta}]}
	return 0
    }

    # Throw the <delta> oldest entries out. This may be all.
    set cache [lrange $cache $delta end]

    debug.cmdr/history {cache len = [llength $cache]}
    return 1
}

proc ::cmdr::history::SaveLast {} {
    debug.cmdr/history {}
    variable file
    variable cache

    debug.cmdr/history {file      = $file}
    debug.cmdr/history {cache len = [llength $cache]}

    fileutil::appendToFile $file [lindex $cache end]\n
    return
}

proc ::cmdr::history::SaveAll {} {
    debug.cmdr/history {}

    variable limit
    variable cache
    variable file

    debug.cmdr/history {file      = $file}
    debug.cmdr/history {limit     = $limit}
    debug.cmdr/history {cache len = [llength $cache]}

    set contents ""

    if {$limit >= 0} {
	# We need a marker for limited and disabled history.
	append contents "#limit=$limit\n"
    }

    if {[llength $cache]} {
	append contents "[join $cache \n]\n"
    }

    fileutil::writeFile $file $contents
    return
}

proc ::cmdr::history::Load {} {
    CheckActive

    variable loaded
    if {$loaded} return
    set loaded 1

    variable file
    variable limit
    variable cache

    if {![file exists $file]} {
	# Initial memory defaults for cache and limit are good.
	# Write the latter to external to keep it properly.
	SaveAll
	return
    }

    # We have a saved history, pull it in.
    set lines [split [string trimright [fileutil::cat $file]] \n]

    # Detect and strip a leading limit clause from the contents.
    if {[regexp "#limit=(\\d+)\$" [lindex $lines 0] -> plimit]} {
	set lines [lrange $lines 1 end]
    } else {
	set plimit -1
    }

    set limit $plimit
    set cache $lines
    # Apply the limit clause if the user tried to circumvent it by
    # manually extending the history. Any changes we had to make are
    # saved back.
    if {[Restrict]} SaveAll
    return
}

proc ::cmdr::history::CheckActive {} {
    variable file
    if {$file ne {}} return

    # No location to save to nor load from, abort request/caller.
    # Abort caller.
    return -code error \
	-errorcode {CMDR HISTORY NO-FILE} \
	"No history file specified"
}

# # ## ### ##### ######## ############# #####################
## Backend management actions.

proc ::cmdr::history::Show {config} {
    debug.cmdr/history {}
    Load

    variable cache

    set off [$config @n]
    if {$off <= 0} {
	# Show entire cache.
	# Start numbering at 1.

	set show $cache
	set num  1
    } else {
	# Partial history, show n last elements.
	incr off -1
	set show [lrange $cache end-$off end]
	set num  [expr {[llength $cache] - $off}]
    }

    variable cache
    set nlen [string length [llength $cache]]
    foreach line $show {
	puts " [format %${nlen}s $num] $line"
	incr num
    }
    return
}

proc ::cmdr::history::Clear {config} {
    debug.cmdr/history {}
    Load

    # Clear in-memory, and then external
    variable cache {}
    SaveAll
    return
}

proc ::cmdr::history::Limit {config} {
    debug.cmdr/history {}
    Load

    variable limit

    if {![$config @n set?]} {
	# Show current limit
	puts [Describe]
	return
    }

    # Retrieve the new limit, apply it to the in-memory history, and
    # at last refresh the external state.
    debug.cmdr/history {current = $limit}
    set new [$config @n]
    if {$new < 0 } {
	set new -1
    }

    debug.cmdr/history {new     = $new}

    if {$new == $limit} {
	puts {No change}
	return
    }

    set limit $new
    Restrict
    SaveAll

    puts "Changed limit to: [Describe]"
    return
}

proc ::cmdr::history::Describe {} {
    variable limit
    if {$limit < 0} {
	return "Keep an unlimited history"
    } elseif {$limit == 0} {
	return "Keep no history (off)"
    } elseif {$limit == 1} {
	return "Keep one entry"
    } else {
	return "Keep $limit entries"
    }
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::history 0
return

Changes to officer.tcl.

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
...
123
124
125
126
127
128
129

130









131
132
133
134
135
136
137
138
139
140
141
142
...
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
...
229
230
231
232
233
234
235

236
237
238
239
240
241
242
...
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
...
336
337
338
339
340
341
342


343









344
345
346
347
348
349
350
...
365
366
367
368
369
370
371

372
373
374
375
376
377
378
...
425
426
427
428
429
430
431

432
433
434
435
436
437
438
...
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685

	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.

................................................................................
	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 find {words} {
	# Resolve chain of words (command name path) to the actor
	# responsible for that command, starting from the current
	# actor.  This is very much a convenience method built on top
	# of lookup (see above).
................................................................................
	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 {
		    section *AutoGenerated*
		    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}
................................................................................
    }

    # 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]
	    return [my Private $cmd $arguments $action]
	}

................................................................................
	# 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 $handler
    }

    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} \
................................................................................
	    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 {}
................................................................................
	    # interactively.

	    debug.cmdr/officer {shell}

	    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

	    debug.cmdr/officer {/done shell}
	    return
................................................................................
		debug.cmdr/officer {/default}

		[my lookup [my default]] do {*}$args
		debug.cmdr/officer {/done default}
		return
	    }


	    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 {
................................................................................
	}
	return $help
    }

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

    variable myinit myactions mymap mycommands myccommands mychildren \
	myreplexit myhandler

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::officer 1.2







>



|
>
>










>
>
>
>
>
>







 







>
|
>
>
>
>
>
>
>
>
>
|
|
|
<
<







 







<
|
|
|
|
|
|
|
|
>
>
>
>
>













>







 







>







 







|

>










|

>
>
>
>
>
>
>







 







>
>
|
>
>
>
>
>
>
>
>
>







 







>







 







>







 







|






|
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
...
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
...
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
...
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
...
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
...
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
...
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
...
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
...
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729

	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 mypmap      {}       ; # Ditto for the map of action abbreviations.
	set mycommands  {}       ; # Ditto
	set myccommands {}       ; # Ditto, derived cache, see method CCommands.
	set mychildren  {}       ; # List of created subordinates.
	set myhandler   {}       ; # Handler around cmd parsing and execution.
	set myshandler  {}       ; # Setup handler, run after regular object
	#                          # initialization from its definition.
	return
    }

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

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

    method shandler {cmd} {
	debug.cmdr/officer {}
	set myshandler $cmd
	return
    }

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

................................................................................
	my Setup
	return [dict get $mymap default]
    }

    method lookup {name} {
	debug.cmdr/officer {}
	my Setup
	# An exact action name has priority over any prefixes.
	if {[dict exists $mymap a,$name]} {
	    return [dict get $mymap a,$name]
	}
	# Accept any unique prefix.
	if {
	    [dict exists $mypmap $name] &&
	    ([llength [set hl [dict get $mypmap $name]]] == 1)
	} {
	    return [lindex $hl 0]
	}
	return -code error \
	    -errorcode [list CMDR ACTION UNKNOWN $name] \
	    "Expected action name, got \"$name\""


    }

    method find {words} {
	# Resolve chain of words (command name path) to the actor
	# responsible for that command, starting from the current
	# actor.  This is very much a convenience method built on top
	# of lookup (see above).
................................................................................
	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 extend exit {
		section *AutoGenerated*
		description {
		    Exit the shell.
		    No-op if not in a shell.
		}
	    } [mymethod shell-exit]
	}

	# Invoke the user-specified hook for extending a newly-made
	# officer, if any.
	if {[llength $myshandler]} {
	    {*}$myshandler [self]
	}
	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} \
	    {shandler    shandler} \
	    {private     Private} \
	    {officer     Officer} \
	    {default     Default} \
	    {alias       Alias} \
	    {description description:} \
	    undocumented \
	    {common      set}
................................................................................
    }

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

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

................................................................................
	# 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 and setup handlers.
	$handler ehandler $myhandler
	$handler shandler $myshandler

	lappend mychildren $handler

	my Def $name $handler
	return $handler
    }

    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

	# Update the map of action prefixes
	set prefix {}
	foreach c [split $name {}] {
	    append prefix $c
	    dict lappend mypmap $prefix $handler
	}
	return
    }

    method ValidateAsUnknown {name} {
	debug.cmdr/officer {}
	if {![dict exists $mymap a,$name]} return
	return -code error -errorcode {CMDR ACTION KNOWN} \
................................................................................
	    return -code error -errorcode {CMDR ACTION NO-LAST} \
		"Cannot be used as first command"
	}
	return [dict get $mymap last]
    }

    method Known {name} {
	debug.cmdr/officer {}
	# Known exact action is good
	if {[dict exists $mymap a,$name]} { return 1 }
	debug.cmdr/officer {no action, maybe prefix}
	# Unknown prefix is bad
	if {![dict exists $mypmap $name]} { return 0 }
	debug.cmdr/officer {prefix, maybe ambiguous}
	# As is an ambiguous prefix
	if {[llength [dict get $mypmap $name]] > 1} { return 0 }
	debug.cmdr/officer {unique prefix}
	# Known unique prefix is good.
	return 1
    }

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

    method do {args} {
	debug.cmdr/officer {}
................................................................................
	    # interactively.

	    debug.cmdr/officer {shell}

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

	    debug.cmdr/officer {/done shell}
	    return
................................................................................
		debug.cmdr/officer {/default}

		[my lookup [my default]] do {*}$args
		debug.cmdr/officer {/done default}
		return
	    }

	    # See also private::FullCmd
	    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 {
................................................................................
	}
	return $help
    }

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

    variable myinit myactions mymap mycommands myccommands mychildren \
	myreplexit myhandler mypmap myshandler

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::officer 1.3

Changes to private.tcl.

94
95
96
97
98
99
100







101
102
103
104
105
106
107
...
111
112
113
114
115
116
117








118
119
120
121


122
123
124
125
126
127
128
...
191
192
193
194
195
196
197
198
    # # ## ### ##### ######## #############

    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.
................................................................................

	# 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
	    }
................................................................................
    variable myarguments mycmd myinit myconfig myhandler

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::private 1.1







>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>




>
>







 







|
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
...
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
...
208
209
210
211
212
213
214
215
    # # ## ### ##### ######## #############

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

    method shandler {cmd} {
	debug.cmdr/private {}
	# Privates have no setup handler/hook.
	# Ignoring the inherited definition.
	return
    }

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

    method Setup {} {
	# Process myarguments only once.
................................................................................

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

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

    method FullCmd {cmd} {
	# See also officer::Do
	if {[catch {
	    set prefix "[my get *prefix*] "
	}]} { set prefix "" }
	return $prefix$cmd
    }

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

	my history-add [my FullCmd $args]

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

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::private 1.2

Changes to validate.tcl.

94
95
96
97
98
99
100




101


102
103
104
105
106
107
108
}
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 double

namespace eval ::cmdr::validate::double {







>
>
>
>
|
>
>







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
}
proc ::cmdr::validate::integer::complete {p x} {
    debug.cmdr/validate {} 10
    return {}
}
proc ::cmdr::validate::integer::validate {p x} {
    debug.cmdr/validate {}

    # While we accept integers in octal and hex we convert them into
    # proper decimals for internal use, as our standard
    # representation.
    if {[string is integer -strict $x]} {
	return [format %d $x]
    }
    fail $p INTEGER "an integer" $x
}

# # ## ### ##### ######## ############# #####################
## Any double

namespace eval ::cmdr::validate::double {

Changes to vcommon.tcl.

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

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

namespace eval ::cmdr::validate::common {

    namespace export fail complete-enum complete-glob ok-directory


    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








>
|
>
>










>

|
>


<
<
>
>

<
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|

|

<
<

>
>







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

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

namespace eval ::cmdr::validate::common {
    namespace export \
	complete-enum complete-glob ok-directory \
	fail fail-unknown-thing fail-known-thing \
	p-name lead-in
    namespace ensemble create
}

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

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

# # ## ### ##### ######## ############# #####################
## Different forms of validation failure messages

proc ::cmdr::validate::common::fail {p code type x {context {}}} {
    # Generic failure: "Expected foo, got x".
    debug.cmdr/validate/common {}



    append msg "Expected $type for [$p type] \"[p-name $p]\"$context,"
    append msg " got \"$x\""


    return -code error -errorcode [list CMDR VALIDATE {*}$code] $msg
}

proc ::cmdr::validate::common::fail-unknown-thing {p code type x {context {}}} {
    # Specific failure for a named thing: Expected existence, found it missing.
    debug.cmdr/validate/common {}

    append msg "Found a problem with [$p type] \"[p-name $p]\":"
    append msg " [lead-in $type] \"$x\" does not exist$context."
    append msg " Please use a different value."

    return -code error -errorcode [list CMDR VALIDATE {*}$code] $msg
}

proc ::cmdr::validate::common::fail-known-thing {p code type x {context {}}} {
    # Specific failure for a named thing: Expected non-existence, found a definition.
    debug.cmdr/validate/common {}

    append msg "Found a problem with [$p type] \"[p-name $p]\":"
    append msg " [lead-in $type] named \"$x\" already exists$context."
    append msg " Please use a different name."

    return -code error -errorcode [list CMDR VALIDATE {*}$code] $msg
}

# # ## ### ##### ######## ############# #####################
## Support commands for construction of messages.

proc ::cmdr::validate::common::lead-in {type} {
    if {[string match {A *}  $type] ||
	[string match {An *} $type]} {
	set lead {}
    } elseif {[string match {[aeiouAEIOU]*} $type]} {
	set lead {An }
    } else {
	set lead {A }
    }
    return $lead$type
}

proc ::cmdr::validate::common::p-name {p} {
    if {[$p type] eq "option"} {
	return [$p flag]
    } else {
	return [$p label]
    }


}

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

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