cmdr
Check-in [465f1bd7c6]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Extended DSL for privates with command to record category/section information for help. Extended the help system with a by-category format, and made it default when not looking for a specific command. ATTENTION: The API between help core and formats did change, the root actor of the command tree is now supplied. New common block *category-order* to declare a bespoke ordering of categories.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 465f1bd7c669a9c5466a4a8e99956bcf26b1ee63
User & Date: andreask 2013-10-16 19:20:57
References
2013-10-18
00:30
Fix internal help usage, bug due to internal API change by [465f1bd7c6] and not updating all users. check-in: 3e6bd33d6d user: andreask tags: trunk
Context
2013-10-16
19:21
Bumped cmdr version to 0.5 check-in: 41becb3194 user: andreask tags: trunk
19:20
Extended DSL for privates with command to record category/section information for help. Extended the help system with a by-category format, and made it default when not looking for a specific command. ATTENTION: The API between help core and formats did change, the root actor of the command tree is now supplied. New common block *category-order* to declare a bespoke ordering of categories. check-in: 465f1bd7c6 user: andreask tags: trunk
17:06
Fixed bug in lappend for common blocks. Was not appending, but overwriting with last :( check-in: e8833211e0 user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to config.tcl.

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
...
174
175
176
177
178
179
180

181
182
183
184
185
186
187
...
195
196
197
198
199
200
201
202

203
204
205
206
207
208
209
...
480
481
482
483
484
485
486






487
488
489
490
491
492
493
...
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
	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 myinforce no

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


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

	# Auto inherit common options, state, arguments.
	# May not be defined.
	catch { use *all* }
................................................................................
	    # in interactive mode we skip all the aliases.
	    if {($mode eq "interact") &&
		![$para primary $o]} continue
	    dict set options $o [$para description $o]
	}

	set arguments $myargs


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

	return [dict create \
		    desc       [context description] \
		    options    $options \
		    arguments  $arguments \
		    states     $states \
		    parameters $parameters]

    }

    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 Interactive {} {
	debug.cmdr/config {}
	set myinteractive 1
	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.
................................................................................
    }

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

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

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

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






|
|
|
|
|
|
>
|









|
>







 







>







 







|
>







 







>
>
>
>
>
>







 







|







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
...
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
...
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
...
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
...
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
	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* }
................................................................................
	    # in interactive mode we skip all the aliases.
	    if {($mode eq "interact") &&
		![$para primary $o]} continue
	    dict set options $o [$para description $o]
	}

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

	return [dict create \
		    desc       [context description] \
		    options    $options \
		    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 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.
................................................................................
    }

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

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

Changes to help.tcl.

41
42
43
44
45
46
47
48
49
50
51
52
53
54









55
56
57
58
59
60
61
..
68
69
70
71
72
73
74
75

76
77
78
79
80
81
82
...
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
...
227
228
229
230
231
232
233

234
235
236
237
238
239
240
241
242
...
253
254
255
256
257
258
259

260
261
262
263
264
265
266
267
268
...
290
291
292
293
294
295
296





































































































































297
298
299
300
301
302
303
namespace eval ::cmdr {
    namespace export help
    namespace ensemble create
}

namespace eval ::cmdr::help {
    namespace export query 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.

    set n -1
    foreach word $words {
................................................................................
		-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 help $words]

}

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

proc ::cmdr::help::auto {actor} {
    debug.cmdr/help {}
    # Generate a standard help command for any actor, and add it dynamically.
................................................................................
    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 list
	}
    }

    puts [format $format $width [DictSort [query $actor $words]]]
    return
}

proc ::cmdr::help::DictSort {dict} {
    set r {}
    foreach k [lsort -dict [dict keys $dict]] {
	lappend r $k [dict get $dict $k]
................................................................................
    }
    return $r
}

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

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



}

# Alternate formats:
# List
# Short

# ... entirely different formats (json, .rst, docopts, ...)

#




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

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

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


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

    # help = dict (name -> command)
    set result {}
    dict for {cmd desc} $help {
	lappend result [List $width $cmd $desc]
    }
................................................................................
    lappend lines \
	[string trimright \
	     "    [join $name] [HasOptions $options][Arguments $arguments $parameters]"]
    return [join $lines \n]
}

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


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

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

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






































































































































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






|






>
>
>
>
>
>
>
>
>







 







|
>







 







|



|







 







|

>
>
>





>

>


>
>
>
|







 







>

|







 







>

|







 







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







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
..
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
...
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
...
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
...
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
...
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
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 {
................................................................................
		-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.
................................................................................
    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 [DictSort [query $actor $words]]]
    return
}

proc ::cmdr::help::DictSort {dict} {
    set r {}
    foreach k [lsort -dict [dict keys $dict]] {
	lappend r $k [dict get $dict $k]
................................................................................
    }
    return $r
}

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

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

    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
	}

	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 cmds
    #parray subs

    # II. Order the main categories. Allow for user influences.

    # IIa. Natural order first.
    set categories [lsort -dict -unique $subc()]

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

    # 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 $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 {![info exists subc($path)]} return

    # Print the sub-categories, if any.
    foreach c [lsort -dict -unique $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]]

Changes to help_json.tcl.

38
39
40
41
42
43
44


45
46
47
48
49
50
51
52
53
54
55
56
## Definition

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

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


}

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

proc ::cmdr::help::format::json {width help} {
    debug.cmdr/help/json {}
    # help = dict (name -> command)
    set dict {}
    dict for {cmd desc} $help {
	lappend dict $cmd [JSON $desc]
    }
    return [json::write object {*}$dict]






>
>




|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
## 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)
    set dict {}
    dict for {cmd desc} $help {
	lappend dict $cmd [JSON $desc]
    }
    return [json::write object {*}$dict]

Changes to help_sql.tcl.

36
37
38
39
40
41
42


43
44
45
46
47
48
49
50
51
52
53
54
## Definition

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

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


}

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

proc ::cmdr::help::format::sql {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)






>
>




|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
## 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)