cmdr
Check-in [a190c9c157]
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 the json format with better section information, and outer structure. Version bumped to 0.9
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a190c9c15783ff6b5c497f06818a4f107d18ae4e
User & Date: andreask 2013-10-31 00:43:42
Context
2013-10-31
00:48
Fix oops, forgotten update of by-category for the new helper procedures. check-in: 0a71af63c2 user: andreask tags: trunk, v0.9
00:43
Extended the json format with better section information, and outer structure. Version bumped to 0.9 check-in: a190c9c157 user: andreask tags: trunk
2013-10-29
16:31
Incomplete [d04e732ab1], extended the config, missed the help code :(. Now fixed. check-in: f453a7ed65 user: andreask tags: trunk, v0.8
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to actor.tcl.

309
310
311
312
313
314
315
316
    ##
    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::actor 0.8






|
309
310
311
312
313
314
315
316
    ##
    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::actor 0.9

Changes to cmdr.tcl.

71
72
73
74
75
76
77
78
proc ::cmdr::interactive? {} {
    variable interactive
    return  $interactive
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr 0.8






|
71
72
73
74
75
76
77
78
proc ::cmdr::interactive? {} {
    variable interactive
    return  $interactive
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr 0.9

Changes to config.tcl.

1350
1351
1352
1353
1354
1355
1356
1357
    }

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::config 0.8






|
1350
1351
1352
1353
1354
1355
1356
1357
    }

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::config 0.9

Changes to help.tcl.

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
...
490
491
492
493
494
495
496
497
















































































498
499
500
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::HasOptions {options} {
    if {[dict size $options]} {
	return "\[OPTIONS\] "
    } else {
	return {}
    }
}

















































































# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help 0.8






|
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<







 








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


|
318
319
320
321
322
323
324
325


326





















327





























328











329
330
331
332
333
334
335
...
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
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::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 0.9

Changes to help_json.tcl.

47
48
49
50
51
52
53


54
55
56
57












58


59
60
61
62
63
























64
65
66
67
68
69
70
}

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

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]


}

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

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

























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






>
>




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





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







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
}

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

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

Changes to officer.tcl.

612
613
614
615
616
617
618
619
	myreplexit myhandler

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::officer 0.8






|
612
613
614
615
616
617
618
619
	myreplexit myhandler

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::officer 0.9

Changes to parameter.tcl.

1139
1140
1141
1142
1143
1144
1145
1146
	myisdocumented myonlypresence myisdefered

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::parameter 0.8






|
1139
1140
1141
1142
1143
1144
1145
1146
	myisdocumented myonlypresence myisdefered

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::parameter 0.9

Changes to private.tcl.

165
166
167
168
169
170
171
172
    variable myarguments mycmd myinit myconfig myhandler

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::private 0.8






|
165
166
167
168
169
170
171
172
    variable myarguments mycmd myinit myconfig myhandler

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::private 0.9

Changes to util.tcl.

58
59
60
61
62
63
64
65
    set res {}
    foreach str $list { lappend res [format "%-*s" $maxl $str] }
    return $res
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::util 0.8






|
58
59
60
61
62
63
64
65
    set res {}
    foreach str $list { lappend res [format "%-*s" $maxl $str] }
    return $res
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::util 0.9

Changes to validate.tcl.

317
318
319
320
321
322
323
324
325
    if {![file readable    $path]} {return 0}
    if {![file writable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::validate 0.8
return






|

317
318
319
320
321
322
323
324
325
    if {![file readable    $path]} {return 0}
    if {![file writable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::validate 0.9
return

Changes to vcommon.tcl.

105
106
107
108
109
110
111
112
113
    debug.cmdr/validate/common {= [join $candidates "\n= "]} 10
    return $candidates
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::validate::common 0.8
return






|

105
106
107
108
109
110
111
112
113
    debug.cmdr/validate/common {= [join $candidates "\n= "]} 10
    return $candidates
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::validate::common 0.9
return