cmdr
Check-in [639bdf2ae3]
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 hooks for history mgmt, plus helper package to the system. Known issue: *prefix* handling for recursion (aliases).
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 639bdf2ae3ff8651960437620e9648ffcbff2117
User & Date: andreask 2014-04-15 19:42:42
Context
2014-04-15
19:56
Cross-reference usage of *prefix* in actors. Extended actor base to allow complete clearance of a common block along a chain of actors up to the root. check-in: 576b7640c7 user: andreask tags: trunk
19:42
Added hooks for history mgmt, plus helper package to the system. Known issue: *prefix* handling for recursion (aliases). check-in: 639bdf2ae3 user: andreask tags: trunk
19:30
help - Switched to method "extend" over "learn" to define the command, simpler. check-in: 4add0ceabc user: andreask tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to actor.tcl.

    49     49       constructor {} {
    50     50   	debug.cmdr/actor {}
    51     51   	set myname        {}
    52     52   	set mydescription {}
    53     53   	set mydocumented  yes
    54     54   	set mysuper       {}
    55     55   	set mystore       {}
           56  +
           57  +	set myhistory     {} ; # History handler, reporting commands just about
           58  +	#                      # to be executed, and other events related to
           59  +	#                      # history management.
    56     60   	return
    57     61       }
    58     62   
    59     63       # # ## ### ##### ######## #############
    60     64       ## Public API: Common actor attributes and behaviour
    61     65       ## - Name.
    62     66       ## - Description (help information).
................................................................................
   178    182       }
   179    183   
   180    184       method unset {key} {
   181    185   	debug.cmdr/actor {}
   182    186   	dict unset mystore $key
   183    187   	return
   184    188       }
          189  +
          190  +    method history-via {cmd} {
          191  +	debug.cmdr/actor {}
          192  +	set myhistory $cmd
          193  +	return
          194  +    }
          195  +
          196  +    method history-setup {} {
          197  +	debug.cmdr/actor {}
          198  +	if {![llength $myhistory]} {return {}}
          199  +	return [{*}$myhistory initialize [self]]
          200  +    }
          201  +
          202  +    method history-add {cmd} {
          203  +	debug.cmdr/actor {}
          204  +	if {![llength $myhistory]} return
          205  +	{*}$myhistory add [string trim $cmd]
          206  +	return
          207  +    }
   185    208   
   186    209       # # ## ### ##### ######## #############
   187    210       ## Public APIs:
   188    211       ## Overridden by sub-classes.
   189    212   
   190    213       # - Perform an action.
   191    214       # - Return help information about the action.
................................................................................
   192    215   
   193    216       method do   {args} {}
   194    217       method help {{prefix {}}} {}
   195    218   
   196    219       ##
   197    220       # # ## ### ##### ######## #############
   198    221   
   199         -    variable myname mydescription mydocumented mysuper mystore
          222  +    variable myname mydescription mydocumented \
          223  +	mysuper mystore myhistory
   200    224   
   201    225       # # ## ### ##### ######## #############
   202    226       ## Helper methods common to command completion in actors.
   203    227   
   204    228       method Quote {word} {
   205    229   	# Check if word contains special characters, and quote it to
   206    230   	# prevent special interpretation of these characters, if so.
................................................................................
   309    333   
   310    334       ##
   311    335       # # ## ### ##### ######## #############
   312    336   }
   313    337   
   314    338   # # ## ### ##### ######## ############# #####################
   315    339   ## Ready
   316         -package provide cmdr::actor 1.1
          340  +package provide cmdr::actor 1.2

Added history.tcl.

            1  +## -*- tcl -*-
            2  +# # ## ### ##### ######## ############# #####################
            3  +## CMDR - History - Utility package commands.
            4  +
            5  +# @@ Meta Begin
            6  +# Package cmdr::history 0
            7  +# Meta author   {Andreas Kupries}
            8  +# Meta location https://core.tcl.tk/akupries/cmdr
            9  +# Meta platform tcl
           10  +# Meta summary     Utilities to support an external history
           11  +# Meta description Utilities to support an external history
           12  +# Meta subject {command line} history {external history}
           13  +# Meta subject {save history} {load history}
           14  +# Meta require {Tcl 8.5-}
           15  +# Meta require fileutil
           16  +# Meta require debug
           17  +# Meta require debug::caller
           18  +# @@ Meta End
           19  +
           20  +# # ## ### ##### ######## ############# #####################
           21  +## Requisites
           22  +
           23  +package require Tcl 8.5
           24  +package require fileutil
           25  +package require debug
           26  +package require debug::caller
           27  +
           28  +# # ## ### ##### ######## ############# #####################
           29  +## Definition
           30  +
           31  +namespace eval ::cmdr {
           32  +    namespace export history
           33  +    namespace ensemble create
           34  +}
           35  +
           36  +namespace eval ::cmdr::history {
           37  +    namespace export attach saveto
           38  +    namespace ensemble create
           39  +
           40  +    # Path to the file the history is stored in.
           41  +    # The default value shown below disables history.
           42  +    variable file {}
           43  +
           44  +    # State information about the history subsystem.
           45  +    variable loaded  0 ; # Boolean: Has the history file been loaded yet ?
           46  +    variable limit   0 ; # What are the limits on commands to be saved ? (0 = unlimited)
           47  +    variable cache  {} ; # In-memory list of the saved commands for easier limit handling.
           48  +}
           49  +
           50  +# Helper ensemble.
           51  +namespace eval ::cmdr::history::mgr {
           52  +    namespace ensemble create -map {
           53  +	initialize ::cmdr::history::Init
           54  +	add        ::cmdr::history::Add
           55  +    }
           56  +}
           57  +
           58  +# # ## ### ##### ######## ############# #####################
           59  +
           60  +debug define cmdr/history
           61  +debug level  cmdr/history
           62  +debug prefix cmdr/history {[debug caller] | }
           63  +
           64  +# # ## ### ##### ######## ############# #####################
           65  +
           66  +proc ::cmdr::history::saveto {path} {
           67  +    debug.cmdr/history {}
           68  +    variable file $path
           69  +    return
           70  +}
           71  +
           72  +proc ::cmdr::history::attach {actor} {
           73  +    debug.cmdr/history {}
           74  +    # cmdr shandler to use.
           75  +    # The actor is the officer to extend.
           76  +
           77  +    # (***) Detect recursive entry through the extend statements
           78  +    # below. Use this to make 'history list' the default of the whole
           79  +    # history officer. And, of course, prevent infinite recursion.
           80  +
           81  +    if {[$actor name] eq "history"} {
           82  +	$actor learn {default list}
           83  +	return
           84  +    }
           85  +
           86  +    # (1) Intercept dispatch and record all user commands.
           87  +    #
           88  +    # Note how this is NOT attached to the history officer itself.
           89  +    # Execution of history management commands is not recorded in the
           90  +    # history.
           91  +    #
           92  +    # Note also that it is attached to all privates of any officer we
           93  +    # attach to.
           94  +
           95  +    $actor history-via ::cmdr::history::mgr
           96  +    foreach a [$actor children] {
           97  +	$a history-via ::cmdr::history::mgr
           98  +    }
           99  +
          100  +    # (2) Extend the root officer, and only the root, with a
          101  +    #     subordinate officer and privates providing access to the
          102  +    #     history management here.
          103  +
          104  +    # FUTURE: Limit amount of saved commands.
          105  +    # FUTURE: Automatic loading of saved history into the
          106  +    # FUTURE: toplevel officer. (dhandler sub-methods?)
          107  +    # FUTURE: History redo commands.
          108  +
          109  +    if {[$actor root] != $actor} return
          110  +
          111  +    $actor extend {history list} {
          112  +	section Introspection {Command history}
          113  +	description {
          114  +	    Show the saved history of commands.
          115  +	}
          116  +	input n {
          117  +	    Show the last n history entries.
          118  +	    Default is to show all.
          119  +	} {
          120  +	    optional
          121  +	    default 0
          122  +	    validate integer
          123  +	}
          124  +    } ::cmdr::history::Show
          125  +    # This recurses into 'attach' through the automatic inheritance of
          126  +    # the shandler. See (***) above for the code intercepting the
          127  +    # recursion and preventing it from becoming infinite.
          128  +
          129  +    $actor extend {history clear} {
          130  +	section Introspection {Command history}
          131  +	description {
          132  +	    Clear the saved history.
          133  +	}
          134  +    } ::cmdr::history::Clear
          135  +
          136  +    $actor extend {history limit} {
          137  +	section Introspection {Command history}
          138  +	section Introspection
          139  +	description {
          140  +	    Limit the size of the history.
          141  +	    If no limit is specified the current limit is shown.
          142  +	}
          143  +	input n {
          144  +	    The number of commands to limit the history to.
          145  +	    A value <= 0 disables all limits.
          146  +	    Default is unlimited.
          147  +	} {
          148  +	    optional
          149  +	    default 0
          150  +	    validate integer
          151  +	}
          152  +    } ::cmdr::history::Limit
          153  +
          154  +    return
          155  +}
          156  +
          157  +# # ## ### ##### ######## ############# #####################
          158  +## Handler invoked by the main framework when an officer starts
          159  +## an interactive shell.
          160  +
          161  +proc ::cmdr::history::Init {actor} {
          162  +    debug.cmdr/history {}
          163  +    Load
          164  +
          165  +    # Non-root actors and shell do not have access to the full history.
          166  +    if {[$actor root] != $actor} {
          167  +	return {}
          168  +    }
          169  +
          170  +    # Root actor gets access the saved history
          171  +    variable cache
          172  +    return  $cache
          173  +}
          174  +
          175  +# # ## ### ##### ######## ############# #####################
          176  +## Handler invoked by the main framework to save commands
          177  +## just before they are run.
          178  +
          179  +proc ::cmdr::history::Add {command} {
          180  +    debug.cmdr/history {}
          181  +    Load
          182  +
          183  +    # Extend history
          184  +    variable cache
          185  +    lappend  cache $command
          186  +
          187  +    # And save it, possibly limiting the number of entries.
          188  +    if {[Restrict]} {
          189  +	SaveAll
          190  +    } else {
          191  +	SaveLast
          192  +    }
          193  +    return
          194  +}
          195  +
          196  +proc ::cmdr::history::Restrict {} {
          197  +    variable limit
          198  +    debug.cmdr/history {limit = $limit}
          199  +
          200  +    # No limits, nothing to do.
          201  +    if {$limit <= 0} {
          202  +	debug.cmdr/history {/no limit}
          203  +	return 0
          204  +    }
          205  +
          206  +    variable cache
          207  +    debug.cmdr/history {cache len = [llength $cache]}
          208  +
          209  +    set delta [expr {[llength $cache] - $limit}]
          210  +
          211  +    debug.cmdr/history {delta = $delta}
          212  +
          213  +    # Amount of history is still under the imposed limit, nothing to do.
          214  +    if {$delta < 0} {
          215  +	debug.cmdr/history {Under limit by [expr {- $delta}]}
          216  +	return 0
          217  +    }
          218  +
          219  +    # Throw the <delta> oldest entries out
          220  +    set cache [lrange $cache $delta end]
          221  +
          222  +    debug.cmdr/history {cache len = [llength $cache]}
          223  +    return 1
          224  +}
          225  +
          226  +proc ::cmdr::history::SaveLast {} {
          227  +    debug.cmdr/history {}
          228  +    variable file
          229  +    variable cache
          230  +
          231  +    debug.cmdr/history {file      = $file}
          232  +    debug.cmdr/history {cache len = [llength $cache]}
          233  +
          234  +    fileutil::appendToFile $file [lindex $cache end]\n
          235  +    return
          236  +}
          237  +
          238  +proc ::cmdr::history::SaveAll {} {
          239  +    debug.cmdr/history {}
          240  +
          241  +    variable limit
          242  +    variable cache
          243  +    variable file
          244  +
          245  +    debug.cmdr/history {file      = $file}
          246  +    debug.cmdr/history {limit     = $limit}
          247  +    debug.cmdr/history {cache len = [llength $cache]}
          248  +
          249  +    if {$limit > 0} {
          250  +	set prefix "#limit=$limit\n"
          251  +    } else {
          252  +	set prefix ""
          253  +    }
          254  +
          255  +    debug.cmdr/history {prefix    = ($prefix)}
          256  +
          257  +    fileutil::writeFile $file "$prefix[join $cache \n]\n"
          258  +    return
          259  +}
          260  +
          261  +proc ::cmdr::history::Load {} {
          262  +    CheckActive
          263  +
          264  +    variable loaded
          265  +    if {$loaded} return
          266  +    set loaded 1
          267  +
          268  +    variable file
          269  +    variable limit
          270  +    variable cache
          271  +
          272  +    if {![file exists $file]} {
          273  +	# Initial memory defaults for cache and limit are good.
          274  +	return
          275  +    }
          276  +
          277  +    # We have a saved history, pull it in.
          278  +    set lines [split [string trimright [fileutil::cat $file]] \n]
          279  +
          280  +    # Detect and strip a leading limit clause from the contents.
          281  +    if {[regexp "#limit=(\\d+)\$" [lindex $lines 0] -> plimit]} {
          282  +	set limit $plimit
          283  +	set lines [lrange $lines 1 end]
          284  +    }
          285  +
          286  +    set cache $lines
          287  +    return
          288  +}
          289  +
          290  +proc ::cmdr::history::CheckActive {} {
          291  +    variable file
          292  +    if {$file ne {}} return
          293  +
          294  +    # No location to save to nor load from, abort request/caller.
          295  +    # Abort caller.
          296  +    return -code error \
          297  +	-errorcode {CMDR HISTORY NO-FILE} \
          298  +	"No history file specified"
          299  +}
          300  +
          301  +# # ## ### ##### ######## ############# #####################
          302  +## Backend management actions.
          303  +
          304  +proc ::cmdr::history::Show {config} {
          305  +    debug.cmdr/history {}
          306  +    Load
          307  +
          308  +    variable cache
          309  +
          310  +    set off [$config @n]
          311  +    if {$off <= 0} {
          312  +	# Show entire cache.
          313  +	# Start numbering at 1.
          314  +
          315  +	set show $cache
          316  +	set num  1
          317  +    } else {
          318  +	# Partial history, show n last elements.
          319  +	incr off -1
          320  +	set show [lrange $cache end-$off end]
          321  +	set num  [expr {[llength $cache] - $off}]
          322  +    }
          323  +
          324  +    variable cache
          325  +    set nlen [string length [llength $cache]]
          326  +    foreach line $show {
          327  +	puts " [format %${nlen}s $num] $line"
          328  +	incr num
          329  +    }
          330  +    return
          331  +}
          332  +
          333  +proc ::cmdr::history::Clear {config} {
          334  +    debug.cmdr/history {}
          335  +    Load
          336  +
          337  +    # Clear in-memory, and then external
          338  +    variable cache {}
          339  +    SaveAll
          340  +    return
          341  +}
          342  +
          343  +proc ::cmdr::history::Limit {config} {
          344  +    debug.cmdr/history {}
          345  +    Load
          346  +
          347  +    variable limit
          348  +
          349  +    if {![$config @n set?]} {
          350  +	# Show current limit
          351  +	puts $limit
          352  +	return
          353  +    }
          354  +
          355  +    # Retrieve the new limit, apply it to the in-memory history, and
          356  +    # at last refresh the external state.
          357  +    debug.cmdr/history {current = $limit}
          358  +    set new [$config @n]
          359  +    if {$new < 0 } { set new 0 }
          360  +
          361  +    debug.cmdr/history {new     = $new}
          362  +
          363  +    if {$new == $limit} {
          364  +	puts {No change}
          365  +	return
          366  +    }
          367  +
          368  +    set limit $new
          369  +    Restrict
          370  +    SaveAll
          371  +
          372  +    puts "Changed limit to $new"
          373  +    return
          374  +}
          375  +
          376  +# # ## ### ##### ######## ############# #####################
          377  +## Ready
          378  +package provide cmdr::history 0
          379  +return

Changes to officer.tcl.

    80     80   	set myactions   $actions ; # Action spec for future initialization
    81     81   	set myinit      no       ; # Dispatch map will be initialized lazily
    82     82   	set mymap       {}       ; # Action map starts knowing nothing
    83     83   	set mypmap      {}       ; # Ditto for the map of action abbreviations.
    84     84   	set mycommands  {}       ; # Ditto
    85     85   	set myccommands {}       ; # Ditto, derived cache, see method CCommands.
    86     86   	set mychildren  {}       ; # List of created subordinates.
    87         -	set myhandler   {}
           87  +	set myhandler   {}       ; # Handler around cmd parsing and execution.
           88  +	set myshandler  {}       ; # Setup handler, run after regular object
           89  +	#                          # initialization from its definition.
    88     90   	return
    89     91       }
    90     92   
    91     93       # # ## ### ##### ######## #############
    92     94   
    93     95       method ehandler {cmd} {
    94     96   	debug.cmdr/officer {}
    95     97   	set myhandler $cmd
    96     98   	return
    97     99       }
          100  +
          101  +    method shandler {cmd} {
          102  +	debug.cmdr/officer {}
          103  +	set myshandler $cmd
          104  +	return
          105  +    }
    98    106   
    99    107       # # ## ### ##### ######## #############
   100    108       ## Public API. (Introspection, mostly).
   101    109       ## - Determine set of known actions.
   102    110       ## - Determine default action.
   103    111       ## - Determine handler for an action.
   104    112   
................................................................................
   197    205   	if {![my has help]} {
   198    206   	    cmdr help auto [self]
   199    207   	}
   200    208   
   201    209   	# Auto-create an 'exit' command when possible, i.e not in
   202    210   	# conflict with a user-specified command.
   203    211   	if {![my has exit]} {
   204         -	    my learn {
   205         -		private exit {
   206         -		    section *AutoGenerated*
   207         -		    description {
   208         -			Exit the shell.
   209         -			No-op if not in a shell.
   210         -		    }
   211         -		} [mymethod shell-exit]
   212         -	    }
          212  +	    my extend exit {
          213  +		section *AutoGenerated*
          214  +		description {
          215  +		    Exit the shell.
          216  +		    No-op if not in a shell.
          217  +		}
          218  +	    } [mymethod shell-exit]
          219  +	}
          220  +
          221  +	# Invoke the user-specified hook for extending a newly-made
          222  +	# officer, if any.
          223  +	if {[llength $myshandler]} {
          224  +	    {*}$myshandler [self]
   213    225   	}
   214    226   	return
   215    227       }
   216    228   
   217    229       method learn {script} {
   218    230   	debug.cmdr/officer {}
   219    231   	# Make the DSL commands directly available. Note that
   220    232   	# "description:" and "common" are superclass methods, and
   221    233   	# renamed to their DSL counterparts. The others are unexported
   222    234   	# instance methods of this class.
   223    235   
   224    236   	link \
   225    237   	    {ehandler    ehandler} \
          238  +	    {shandler    shandler} \
   226    239   	    {private     Private} \
   227    240   	    {officer     Officer} \
   228    241   	    {default     Default} \
   229    242   	    {alias       Alias} \
   230    243   	    {description description:} \
   231    244   	    undocumented \
   232    245   	    {common      set}
................................................................................
   238    251       }
   239    252   
   240    253       # Convenience method for dynamically creating a command hierarchy.
   241    254       # Command specified as path, intermediate officers are generated
   242    255       # automatically as needed.
   243    256   
   244    257       method extend {path arguments action} {
          258  +	debug.cmdr/officer {}
   245    259   	if {[llength $path] == 1} {
   246    260   	    # Reached the bottom of the recursion.
   247    261   	    # Generate the private handling arguments and action.
   248    262   	    set cmd [lindex $path 0]
   249    263   	    return [my Private $cmd $arguments $action]
   250    264   	}
   251    265   
................................................................................
   312    326   	# Note: By placing the subordinate objects into the officer's
   313    327   	# namespace they will be automatically destroyed with the
   314    328   	# officer itself. No special code for cleanup required.
   315    329   
   316    330   	set handler [self namespace]::${what}_$name
   317    331   	cmdr::$what create $handler [self] $name {*}$args
   318    332   
   319         -	# Propagate error handler.
          333  +	# Propagate error and setup handlers.
   320    334   	$handler ehandler $myhandler
          335  +	$handler shandler $myshandler
   321    336   
   322    337   	lappend mychildren $handler
   323    338   
   324    339   	my Def $name $handler
   325    340   	return $handler
   326    341       }
   327    342   
................................................................................
   392    407   	    # interactively.
   393    408   
   394    409   	    debug.cmdr/officer {shell}
   395    410   
   396    411   	    set shell [linenoise::facade new [self]]
   397    412   	    set myreplexit 0 ; # Initialize stop signal, no stopping
   398    413   	    $shell history 1
          414  +	    $shell history= [my history-setup]
   399    415   	    [my root] set *in-shell* true
   400    416   	    $shell repl
   401    417   	    [my root] set *in-shell* false
   402    418   	    $shell destroy
   403    419   
   404    420   	    debug.cmdr/officer {/done shell}
   405    421   	    return
................................................................................
   698    714   	}
   699    715   	return $help
   700    716       }
   701    717   
   702    718       # # ## ### ##### ######## #############
   703    719   
   704    720       variable myinit myactions mymap mycommands myccommands mychildren \
   705         -	myreplexit myhandler mypmap
          721  +	myreplexit myhandler mypmap myshandler
   706    722   
   707    723       # # ## ### ##### ######## #############
   708    724   }
   709    725   
   710    726   # # ## ### ##### ######## ############# #####################
   711    727   ## Ready
   712         -package provide cmdr::officer 1.2
          728  +package provide cmdr::officer 1.3

Changes to private.tcl.

    94     94       # # ## ### ##### ######## #############
    95     95   
    96     96       method ehandler {cmd} {
    97     97   	debug.cmdr/private {}
    98     98   	set myhandler $cmd
    99     99   	return
   100    100       }
          101  +
          102  +    method shandler {cmd} {
          103  +	debug.cmdr/private {}
          104  +	# Privates have no setup handler/hook.
          105  +	# Ignoring the inherited definition.
          106  +	return
          107  +    }
   101    108   
   102    109       # # ## ### ##### ######## #############
   103    110       ## Internal. Argument processing. Defered until required.
   104    111       ## Core setup code runs only once.
   105    112   
   106    113       method Setup {} {
   107    114   	# Process myarguments only once.
................................................................................
   111    118   
   112    119   	# Create and fill the parameter collection
   113    120   	set myconfig [cmdr::config create config [self] $myarguments]
   114    121   	return
   115    122       }
   116    123   
   117    124       # # ## ### ##### ######## #############
          125  +
          126  +    method FullCmd {cmd} {
          127  +	if {[catch {
          128  +	    set prefix "[my get *prefix*] "
          129  +	}]} { set prefix "" }
          130  +	return $prefix$cmd
          131  +    }
   118    132   
   119    133       method do {args} {
   120    134   	debug.cmdr/private {}
   121    135   	my Setup
          136  +
          137  +	my history-add [my FullCmd $args]
   122    138   
   123    139   	if {[llength $myhandler]} {
   124    140   	    # The handler is expected to have a try/finally construct
   125    141   	    # which captures all of interest.
   126    142   	    {*}$myhandler {
   127    143   		my Run $args
   128    144   	    }
................................................................................
   191    207       variable myarguments mycmd myinit myconfig myhandler
   192    208   
   193    209       # # ## ### ##### ######## #############
   194    210   }
   195    211   
   196    212   # # ## ### ##### ######## ############# #####################
   197    213   ## Ready
   198         -package provide cmdr::private 1.1
          214  +package provide cmdr::private 1.2