cmdr
Check-in [3230322f4d]
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:Added processing of options to officers. Note that this needs an updated tokenizer from Tcllib. Otherwise the main shell will treat cmd options as options of the tokenizer procedure itself, which breaks it. Help handling and generation is the only TODO left.
Timelines: family | ancestors | descendants | both | global-options
Files: files | file ages | folders
SHA1: 3230322f4d2bbce1c09646a7cf69f05e780fd468
User & Date: andreask 2014-08-22 23:22:12
Context
2014-08-25
23:08
Merge fixes from trunk. check-in: 7d15626394 user: andreask tags: global-options
2014-08-22
23:22
Added processing of options to officers. Note that this needs an updated tokenizer from Tcllib. Otherwise the main shell will treat cmd options as options of the tokenizer procedure itself, which breaks it. Help handling and generation is the only TODO left. check-in: 3230322f4d user: andreask tags: global-options
2014-08-21
01:29
Started implementation of "global" options (and state) associated with officers and inherited to subordinates. Another way of sharing common options (like --debug, --trace, and the like) without cluttering command definitions via *all*. This commit has the specification changes done. Not yet done are recognition during cmdline processing, nor the needed changes to get uncluttered help output, nor the extended help output for officers. check-in: d1d45c1de3 user: andreask tags: global-options
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to NOTES.

    28     28   
    29     29   (2) Processing
    30     30   **	(a)	Setup of officers and privates imports the parameters
    31     31   		of their direct superior officer. As that officer
    32     32   		in turn imported from their own superior all global
    33     33   		options automatically spread down the entire tree.
    34     34   
    35         -TODO	(b)	Cmdline processing in officers is extended to check
           35  +**	(b)	Cmdline processing in officers is extended to check
    36     36   		for options and handle them if known, or throw an
    37     37   		error if not.
    38     38   
    39     39   (3) Help
    40     40   TODO	(a)	Imported parameters of an officer or private are
    41     41   		excluded from the generated help.
    42     42   
    43     43   TODO	(b)	The help structure is extended so that officers can
    44     44   		declare the options they understand.

Changes to config.tcl.

    85     85   
    86     86       forward context context
    87     87   
    88     88       # Make self accessible.
    89     89       method self {} { self }
    90     90   
    91     91       constructor {context spec {super {}}} {
    92         -	debug.cmdr/config {[context fullname]}
           92  +	debug.cmdr/config {owner=([$context fullname])}
    93     93   
    94     94   	classvariable ourinteractive
    95     95   	if {![info exists ourinteractive]} { set ourinteractive 0 }
    96     96   
    97     97   	classvariable ourdisplay
    98     98   	if {[info exists ourdisplay]} {
    99     99   	    set mydisplay $ourdisplay
................................................................................
   148    148   		# Swallow possibility of a misisng *all*.
   149    149   	    }
   150    150   	    eval $spec
   151    151   	    debug.cmdr/config {==== eval spec done =====}
   152    152   	}
   153    153   
   154    154   	# Postprocessing
   155         -
   156         -	my SetThresholds
   157         -	my UniquePrefixes
   158         -	my CompletionGraph
          155  +	my complete-definitions
   159    156   
   160    157   	set mypq [struct::queue P] ;# actual parameters
   161    158   	if {[llength $myargs]} {
   162    159   	    set myaq [struct::queue A] ;# formal argument parameters
   163    160   	}
   164    161   	return
   165    162       }
          163  +
          164  +    method complete-definitions {} {
          165  +	debug.cmdr/config {}
          166  +	my SetThresholds
          167  +	my UniquePrefixes
          168  +	my CompletionGraph
          169  +	return
          170  +    }
   166    171   
   167    172       method help {{mode public}} {
   168    173   	debug.cmdr/config {}
   169    174   	# command   = dict ('desc'       -> description
   170    175   	#                   'options'    -> options
   171    176   	#                   'arguments'  -> arguments
   172    177   	#                   'parameters' -> parameters)
................................................................................
   871    876   	    return
   872    877   	}
   873    878   	P put {*}$arguments
   874    879   
   875    880   	debug.cmdr/config {done}
   876    881   	return
   877    882       }
          883  +
          884  +    method parse-head-options {args} {
          885  +	debug.cmdr/config {}
          886  +
          887  +	# - Reset the state values (we might be in an interactive shell, multiple commands).
          888  +	# - Stash the parameters into a queue for processing.
          889  +	# - Stash the (ordered) arguments into a second queue.
          890  +	# - Operate on parameter and arg queues until empty,
          891  +	#   dispatching the words to handlers as needed.
          892  +
          893  +	if {![llength $args]} { return {} }
          894  +
          895  +	my reset
          896  +	P clear
          897  +	P put {*}$args
          898  +
          899  +	debug.cmdr/config {options only}
          900  +	while {[P size]} {
          901  +	    set word [P peek]
          902  +	    debug.cmdr/config {[P size] ? $word}
          903  +	    if {![string match -* $word]} break
          904  +	    my ProcessOption
          905  +	}
          906  +	# Non-option found, or end of words reached.
          907  +	# Return the remainder.
          908  +	set n [P size]
          909  +	if {!$n} {
          910  +	    return {}
          911  +	} elseif {$n == 1} {
          912  +	    return [list [P get]]
          913  +	} else {
          914  +	    return [P get $n]
          915  +	}
          916  +    }
   878    917   
   879    918       method parse {args} {
   880    919   	debug.cmdr/config {}
   881    920   
   882    921   	# - Reset the state values (we might be in an interactive shell, multiple commands).
   883    922   	# - Stash the parameters into a queue for processing.
   884    923   	# - Stash the (ordered) arguments into a second queue.
................................................................................
  1004   1043   
  1005   1044       method ProcessOption {} {
  1006   1045   	debug.cmdr/config {}
  1007   1046   	# Get option. Do special handling.
  1008   1047   	# Non special option gets dispatched to handler (cmdr::parameter instance).
  1009   1048   	# The handler is responsible for retrieved the option's value.
  1010   1049   	set option [P get]
         1050  +	debug.cmdr/config {taking ($option)}
  1011   1051   
  1012   1052   	# Handle general special forms:
  1013   1053   	#
  1014   1054   	# --foo=bar ==> --foo bar
  1015   1055   	# -f=bar    ==> -f bar
  1016   1056   
  1017   1057   	if {[regexp {^(-[^=]+)=(.*)$} $option --> option value]} {
  1018   1058   	    P unget $value
  1019   1059   	}
         1060  +
         1061  +	debug.cmdr/config {having ($option)}
  1020   1062   
  1021   1063   	# Validate existence of the option
  1022   1064   	if {![dict exists $myfullopt $option]} {
  1023   1065   	    my raise "Unknown option $option" \
  1024   1066   		CMDR CONFIG BAD OPTION
  1025   1067   	}
  1026   1068   

Changes to officer.tcl.

    22     22   # Meta require cmdr::private
    23     23   # Meta require debug
    24     24   # Meta require debug::caller
    25     25   # Meta require linenoise::facade
    26     26   # Meta require try
    27     27   # Meta require {Tcl 8.5-}
    28     28   # Meta require {oo::util 1.2}
    29         -# Meta require {string::token::shell 1.1}
           29  +# Meta require {string::token::shell 1.2}
    30     30   # @@ Meta End
    31     31   
    32     32   # # ## ### ##### ######## ############# #####################
    33     33   ## Requisites
    34     34   
    35     35   package require Tcl 8.5
    36     36   package require debug
    37     37   package require debug::caller
    38     38   package require linenoise::facade
    39         -package require string::token::shell 1.1
           39  +package require string::token::shell 1.2
    40     40   package require try
    41     41   package require TclOO
    42     42   package require oo::util 1.2 ;# link helper.
    43     43   package require cmdr::actor
    44     44   package require cmdr::private
    45     45   package require cmdr::help
    46     46   package require cmdr::config
................................................................................
   209    209   	set super [my super]
   210    210   	if {$super ne {}} {
   211    211   	    set super [$super config]
   212    212   	}
   213    213   
   214    214   	set myconfig [cmdr::config create config [self] {} $super]
   215    215   	my learn $myactions
          216  +	$myconfig complete-definitions
   216    217   
   217    218   	# Auto-create a 'help' command when possible, i.e not in
   218    219   	# conflict with a user-specified command.
   219    220   	if {![my has help]} {
   220    221   	    cmdr help auto [self]
   221    222   	}
   222    223   
................................................................................
   452    453   	set reset 0
   453    454   	if {![my exists *command*]} {
   454    455   	    # Prevent handling of application-specific options here.
   455    456   	    my set *command* -- $args
   456    457   	    set reset 1
   457    458   	}
   458    459   	try {
          460  +	    # Process any options we may find. The first non-option
          461  +	    # will be the command to dispatch on.
          462  +	    set arg [config parse-head-options {*}$args]
          463  +
   459    464   	    # Empty command. Delegate to the default, if we have any.
   460    465   	    # Otherwise fail.
   461    466   	    if {![llength $args]} {
   462    467   		if {[my hasdefault]} {
   463    468   		    return [[my lookup [my default]] do]
   464    469   		}
   465    470   		return -code error -errorcode {CMDR DO EMPTY} \
................................................................................
   533    538   
   534    539   	if {$cmd eq ".exit"} {
   535    540   	    # See method 'shell-exit' as well, and 'Setup' for
   536    541   	    # the auto-creation of an 'exit' command when possible,
   537    542   	    # i.e not in conflict with a user-specified command.
   538    543   	    set myreplexit 1 ; return
   539    544   	}
   540         -	my Do {*}[string token shell $cmd]
          545  +	my Do {*}[string token shell -- $cmd]
   541    546       }
   542    547   
   543    548       method report {what data} {
   544    549   	debug.cmdr/officer {}
   545    550   	switch -exact -- $what {
   546    551   	    ok {
   547    552   		if {$data eq {}} return