cmdr
Check-in [c6dc11d2a1]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Extended debug narrative at method returns.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:c6dc11d2a1a48b97b5021f53365ecc4b28bfdc5a
User & Date: andreask 2014-02-17 20:19:24
Context
2014-02-17
20:20
Tweak to default format selection of help, use "short" for interior nodes. check-in: ac17c7fb74 user: andreask tags: trunk
20:19
Extended debug narrative at method returns. check-in: c6dc11d2a1 user: andreask tags: trunk
2014-02-13
05:39
Extended the set of common validation types, added "percent" (double limited to [0,100]). Updated documentation. check-in: 49d0a10137 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to officer.tcl.

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

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







>
>








>
>




>
>







 







>
>


>
>








>
>
|
>
>







 







>
>







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

	    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
	}

	my Do {*}$args

	debug.cmdr/officer {/done}
	return
    }

    # Internal. Actual dispatch. Shared by main entry and shell.
    method Do {args} {
	debug.cmdr/officer {}
	set reset 0
................................................................................
	    }

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

	    # Delegate to the handler for a known command.
	    if {[my Known $cmd]} {
		debug.cmdr/officer {/known $cmd}

		my lappend *prefix* $cmd
		[my lookup $cmd] do {*}$remainder

		debug.cmdr/officer {/done known}
		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.
		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 {
	    if {$reset} {
		my unset *command*
	    }
	    my unset *prefix*
	}

	debug.cmdr/officer {/done}
    }

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

    method prompt1   {}     { return "[my fullname] > " }
    method prompt2   {}     { error {Continuation lines are not supported} }

Changes to private.tcl.

65
66
67
68
69
70
71





72
73
74
75
76
77
78
...
120
121
122
123
124
125
126

127
128
129
130
131
132
133
...
147
148
149
150
151
152
153


154
155
156
157
158
159
160
	set mycmd       $cmdprefix
	set myinit      0
	set myhandler   {}
	return
    }

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






    method find {words} {
	my internal_find $words {}
    }

    method internal_find {words prefix} {
	if {![llength $words]} {
................................................................................
	    # 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
................................................................................
	# 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







>
>
>
>
>







 







>







 







>
>







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
...
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
...
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
	set mycmd       $cmdprefix
	set myinit      0
	set myhandler   {}
	return
    }

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

    method children {} {
	debug.cmdr/private {}
	return {}
    }

    method find {words} {
	my internal_find $words {}
    }

    method internal_find {words prefix} {
	if {![llength $words]} {
................................................................................
	    # which captures all of interest.
	    {*}$myhandler {
		my Run $args
	    }
	} else {
	    my Run $args
	}
	debug.cmdr/private {/done}
    }

    method Run {words} {
	debug.cmdr/private {}
	debug.cmdr/private {parse}
	try {
	    config parse {*}$words
................................................................................
	# 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 

	debug.cmdr/private {/done}
    }

    method help {{prefix {}}} {
	debug.cmdr/private {}
	my Setup
	# help    = dict (name -> command)
	# command = dict ('action'    -> cmdprefix