cmdr
Check-in [16470ccbc4]
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 tclconference@googlegroups.com
or submit via the online form by Sep 9.

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

Overview
Comment:Tweaks to the history mgmt: Documented semantics of limits. Nicer output on changes and current. Allow application to overide initial default limits. Ensure saving of initial limits on first use.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:16470ccbc4540c91efdc06cec9bca1dae2ace20e
User & Date: andreask 2014-04-15 20:45:12
Context
2014-04-15
21:04
Fixed multi-section help setup of the limit command. check-in: abb1eb8115 user: andreask tags: trunk
20:45
Tweaks to the history mgmt: Documented semantics of limits. Nicer output on changes and current. Allow application to overide initial default limits. Ensure saving of initial limits on first use. check-in: 16470ccbc4 user: andreask tags: trunk
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to history.tcl.

13
14
15
16
17
18
19





20
21
22
23
24
25
26
..
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
59
60
61
62
63
64
65
66
67
68
69
70






71
72
73
74
75
76
77
...
138
139
140
141
142
143
144
145
146

147
148
149
150
151
152
153
154
155
156
...
176
177
178
179
180
181
182




183
184
185
186
187
188
189
...
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213

214
215
216
217
218
219
220
221
222
223
224
225
226
...
242
243
244
245
246
247
248


249

250
251
252
253
254
255


256

257
258
259
260
261
262
263
264
...
267
268
269
270
271
272
273


274
275
276
277
278
279
280
281
282
283


284
285

286




287
288
289
290
291
292
293
...
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
# Meta subject {save history} {load history}
# Meta require {Tcl 8.5-}
# Meta require fileutil
# Meta require debug
# Meta require debug::caller
# @@ Meta End






# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require fileutil
package require debug
package require debug::caller
................................................................................

namespace eval ::cmdr {
    namespace export history
    namespace ensemble create
}

namespace eval ::cmdr::history {
    namespace export attach saveto
    namespace ensemble create

    # Path to the file the history is stored in.
    # The default value shown below disables history.
    variable file {}

    # State information about the history subsystem.
    variable loaded  0 ; # Boolean: Has the history file been loaded yet ?
    variable limit   0 ; # What are the limits on commands to be saved ? (0 = unlimited)
    variable cache  {} ; # In-memory list of the saved commands for easier limit handling.
}

# Helper ensemble.
namespace eval ::cmdr::history::mgr {
    namespace ensemble create -map {
	initialize ::cmdr::history::Init
................................................................................

debug define cmdr/history
debug level  cmdr/history
debug prefix cmdr/history {[debug caller] | }

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

proc ::cmdr::history::saveto {path} {
    debug.cmdr/history {}
    variable file $path
    return
}







proc ::cmdr::history::attach {actor} {
    debug.cmdr/history {}
    # cmdr shandler to use.
    # The actor is the officer to extend.

    # (***) Detect recursive entry through the extend statements
................................................................................
	section Introspection
	description {
	    Limit the size of the history.
	    If no limit is specified the current limit is shown.
	}
	input n {
	    The number of commands to limit the history to.
	    A value <= 0 disables all limits.
	    Default is unlimited.

	} {
	    optional
	    default 0
	    validate integer
	}
    } ::cmdr::history::Limit

    return
}

................................................................................
## Handler invoked by the main framework to save commands
## just before they are run.

proc ::cmdr::history::Add {command} {
    debug.cmdr/history {}
    Load





    # Extend history
    variable cache
    lappend  cache $command

    # And save it, possibly limiting the number of entries.
    if {[Restrict]} {
	SaveAll
................................................................................
    return
}

proc ::cmdr::history::Restrict {} {
    variable limit
    debug.cmdr/history {limit = $limit}

    # No limits, nothing to do.
    if {$limit <= 0} {
	debug.cmdr/history {/no limit}
	return 0
    }

    variable cache
    debug.cmdr/history {cache len = [llength $cache]}

    set delta [expr {[llength $cache] - $limit}]

    debug.cmdr/history {delta = $delta}

    # Amount of history is still under the imposed limit, nothing to do.

    if {$delta < 0} {
	debug.cmdr/history {Under limit by [expr {- $delta}]}
	return 0
    }

    # Throw the <delta> oldest entries out
    set cache [lrange $cache $delta end]

    debug.cmdr/history {cache len = [llength $cache]}
    return 1
}

proc ::cmdr::history::SaveLast {} {
................................................................................
    variable cache
    variable file

    debug.cmdr/history {file      = $file}
    debug.cmdr/history {limit     = $limit}
    debug.cmdr/history {cache len = [llength $cache]}



    if {$limit > 0} {

	set prefix "#limit=$limit\n"
    } else {
	set prefix ""
    }

    debug.cmdr/history {prefix    = ($prefix)}




    fileutil::writeFile $file "$prefix[join $cache \n]\n"
    return
}

proc ::cmdr::history::Load {} {
    CheckActive

    variable loaded
................................................................................

    variable file
    variable limit
    variable cache

    if {![file exists $file]} {
	# Initial memory defaults for cache and limit are good.


	return
    }

    # We have a saved history, pull it in.
    set lines [split [string trimright [fileutil::cat $file]] \n]

    # Detect and strip a leading limit clause from the contents.
    if {[regexp "#limit=(\\d+)\$" [lindex $lines 0] -> plimit]} {
	set limit $plimit
	set lines [lrange $lines 1 end]


    }


    set cache $lines




    return
}

proc ::cmdr::history::CheckActive {} {
    variable file
    if {$file ne {}} return

................................................................................
    debug.cmdr/history {}
    Load

    variable limit

    if {![$config @n set?]} {
	# Show current limit
	puts $limit
	return
    }

    # Retrieve the new limit, apply it to the in-memory history, and
    # at last refresh the external state.
    debug.cmdr/history {current = $limit}
    set new [$config @n]
    if {$new < 0 } { set new 0 }



    debug.cmdr/history {new     = $new}

    if {$new == $limit} {
	puts {No change}
	return
    }

    set limit $new
    Restrict
    SaveAll

    puts "Changed limit to $new"
    return
}














# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::history 0
return







>
>
>
>
>







 







|








|







 







|




>
>
>
>
>
>







 







|
|
>


|







 







>
>
>
>







 







|
|











|
>





|







 







>
>
|
>
|
<
<


<
>
>
|
>
|







 







>
>








<

>
>


>

>
>
>
>







 







|







|
>
>












|


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





13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
..
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
..
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
...
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
...
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
...
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
...
259
260
261
262
263
264
265
266
267
268
269
270


271
272

273
274
275
276
277
278
279
280
281
282
283
284
...
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303

304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
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
# Meta subject {save history} {load history}
# Meta require {Tcl 8.5-}
# Meta require fileutil
# Meta require debug
# Meta require debug::caller
# @@ Meta End

# Limits 'n'
# < 0 | History on.  Keep everything 
# = 0 | History off. Keep nothing.
# > 0 | History on.  Keep last n entries.

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require fileutil
package require debug
package require debug::caller
................................................................................

namespace eval ::cmdr {
    namespace export history
    namespace ensemble create
}

namespace eval ::cmdr::history {
    namespace export attach save-to initial-limit
    namespace ensemble create

    # Path to the file the history is stored in.
    # The default value shown below disables history.
    variable file {}

    # State information about the history subsystem.
    variable loaded  0 ; # Boolean: Has the history file been loaded yet ?
    variable limit  -1 ; # Limits. Default: active, no limits.
    variable cache  {} ; # In-memory list of the saved commands for easier limit handling.
}

# Helper ensemble.
namespace eval ::cmdr::history::mgr {
    namespace ensemble create -map {
	initialize ::cmdr::history::Init
................................................................................

debug define cmdr/history
debug level  cmdr/history
debug prefix cmdr/history {[debug caller] | }

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

proc ::cmdr::history::save-to {path} {
    debug.cmdr/history {}
    variable file $path
    return
}

proc ::cmdr::history::initial-limit {new} {
    debug.cmdr/history {}
    variable limit $new
    return
}

proc ::cmdr::history::attach {actor} {
    debug.cmdr/history {}
    # cmdr shandler to use.
    # The actor is the officer to extend.

    # (***) Detect recursive entry through the extend statements
................................................................................
	section Introspection
	description {
	    Limit the size of the history.
	    If no limit is specified the current limit is shown.
	}
	input n {
	    The number of commands to limit the history to.
	    For a value > 0 we keep that many commands in the history.
	    For a value < 0 we keep all commands, i.e. unlimited history.
	    For a value = 0 we keep nothing, i.e. no history.
	} {
	    optional
	    default -1
	    validate integer
	}
    } ::cmdr::history::Limit

    return
}

................................................................................
## Handler invoked by the main framework to save commands
## just before they are run.

proc ::cmdr::history::Add {command} {
    debug.cmdr/history {}
    Load

    # Shortcircuit if we are not keeping any history.
    variable limit
    if {$limit == 0} return

    # Extend history
    variable cache
    lappend  cache $command

    # And save it, possibly limiting the number of entries.
    if {[Restrict]} {
	SaveAll
................................................................................
    return
}

proc ::cmdr::history::Restrict {} {
    variable limit
    debug.cmdr/history {limit = $limit}

    # There are no limits set, there is nothing to do.
    if {$limit < 0} {
	debug.cmdr/history {/no limit}
	return 0
    }

    variable cache
    debug.cmdr/history {cache len = [llength $cache]}

    set delta [expr {[llength $cache] - $limit}]

    debug.cmdr/history {delta = $delta}

    # The stored amount of history is still under the imposed limit,
    # so there is nothing to do.
    if {$delta < 0} {
	debug.cmdr/history {Under limit by [expr {- $delta}]}
	return 0
    }

    # Throw the <delta> oldest entries out. This may be all.
    set cache [lrange $cache $delta end]

    debug.cmdr/history {cache len = [llength $cache]}
    return 1
}

proc ::cmdr::history::SaveLast {} {
................................................................................
    variable cache
    variable file

    debug.cmdr/history {file      = $file}
    debug.cmdr/history {limit     = $limit}
    debug.cmdr/history {cache len = [llength $cache]}

    set contents ""

    if {$limit >= 0} {
	# We need a marker for limited and disabled history.
	append contents "#limit=$limit\n"


    }


    if {[llength $cache]} {
	append contents "[join $cache \n]\n"
    }

    fileutil::writeFile $file $contents
    return
}

proc ::cmdr::history::Load {} {
    CheckActive

    variable loaded
................................................................................

    variable file
    variable limit
    variable cache

    if {![file exists $file]} {
	# Initial memory defaults for cache and limit are good.
	# Write the latter to external to keep it properly.
	SaveAll
	return
    }

    # We have a saved history, pull it in.
    set lines [split [string trimright [fileutil::cat $file]] \n]

    # Detect and strip a leading limit clause from the contents.
    if {[regexp "#limit=(\\d+)\$" [lindex $lines 0] -> plimit]} {

	set lines [lrange $lines 1 end]
    } else {
	set plimit -1
    }

    set limit $plimit
    set cache $lines
    # Apply the limit clause if the user tried to circumvent it by
    # manually extending the history. Any changes we had to make are
    # saved back.
    if {[Restrict]} SaveAll
    return
}

proc ::cmdr::history::CheckActive {} {
    variable file
    if {$file ne {}} return

................................................................................
    debug.cmdr/history {}
    Load

    variable limit

    if {![$config @n set?]} {
	# Show current limit
	puts [Describe]
	return
    }

    # Retrieve the new limit, apply it to the in-memory history, and
    # at last refresh the external state.
    debug.cmdr/history {current = $limit}
    set new [$config @n]
    if {$new < 0 } {
	set new -1
    }

    debug.cmdr/history {new     = $new}

    if {$new == $limit} {
	puts {No change}
	return
    }

    set limit $new
    Restrict
    SaveAll

    puts "Changed limit to: [Describe]"
    return
}

proc ::cmdr::history::Describe {} {
    variable limit
    if {$limit < 0} {
	return "Keep an unlimited history"
    } elseif {$limit == 0} {
	return "Keep no history (off)"
    } elseif {$limit == 1} {
	return "Keep one entry"
    } else {
	return "Keep $limit entries"
    }
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::history 0
return