Ticket UUID: | 28e817872c863a183e5cde1d4b09d3d3288dde5c | |||
Title: | Improved history module of Tklib | |||
Type: | Bug | Version: | 0.1 | |
Submitter: | anonymous | Created on: | 2016-10-15 17:07:27 | |
Subsystem: | (unused) | Assigned To: | ||
Priority: | 5 Medium | Severity: | Minor | |
Status: | Closed | Last Modified: | 2016-10-18 05:08:04 | |
Resolution: | Not Applicable Here | Closed By: | aku | |
Closed on: | 2016-10-18 05:08:04 | |||
Description: |
I have made two improvements to the history module: 1. Avoid multiple add of same text to the entry history 2. Fixed weird behavior at the end of the history list: I had to press two times the up arrow in order to get the previous list value. Here is the modified code. I hope it will find it's way into the next release. # history.tcl -- # # Provides a history mechanism for entry widgets # # Copyright (c) 2005 Aaron Faupell <[email protected]> # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: history.tcl,v 1.4 2005/08/25 03:36:58 andreas_kupries Exp $ package require Tk package provide history 0.1 namespace eval history { bind History <Up> {::history::up %W} bind History <Down> {::history::down %W} } proc ::history::init {w {len 30}} { variable history variable prefs set bt [bindtags $w] if {[lsearch $bt History] > -1} { error "$w already has a history" } if {[set i [lsearch $bt $w]] < 0} { error "cant find $w in bindtags" } bindtags $w [linsert $bt [expr {$i + 1}] History] array set history [list $w,list {} $w,cur 0] set prefs(maxlen,$w) $len return $w } proc ::history::remove {w} { variable history variable prefs set bt [bindtags $w] if {[set i [lsearch $bt History]] < 0} { error "$w has no history" } bindtags $w [lreplace $bt $i $i] unset prefs(maxlen,$w) history($w,list) history($w,cur) } proc ::history::add {w line} { variable history variable prefs if {$history($w,cur) > 0 && [lindex $history($w,list) $history($w,cur)] == $line} { set history($w,list) [lreplace $history($w,list) $history($w,cur) $history($w,cur)] } set idx [lsearch -dictionary $history($w,list) $line] if {$idx>=0} { set $history($w,list) [lreplace $history($w,list) $idx $idx] } set history($w,list) [linsert $history($w,list) 0 $line] set history($w,list) [lrange $history($w,list) 0 $prefs(maxlen,$w)] set history($w,cur) 0 } proc ::history::up {w} { variable history if {[lindex $history($w,list) [expr {$history($w,cur) + 1}]] != ""} { if {$history($w,cur) == 0} { set history($w,tmp) [$w get] } $w delete 0 end incr history($w,cur) $w insert end [lindex $history($w,list) $history($w,cur)] } else { alert $w } } proc ::history::down {w} { variable history if {$history($w,cur) != 0} { $w delete 0 end if {$history($w,cur) == 0} { $w insert end $history($w,tmp) set history($w,cur) 0 } else { incr history($w,cur) -1 $w insert end [lindex $history($w,list) $history($w,cur)] } } else { alert $w } } proc ::history::get {w} { variable history return $history($w,list) } proc ::history::clear {w} { variable history set history($w,cur) 0 set history($w,list) {} unset -nocomplain history($w,tmp) } proc ::history::configure {w option {value {}}} { variable history variable prefs switch -exact -- $option { length { if {$value == ""} { return $prefs(maxlen,$w) } if {![string is integer -strict $value]} { error "length must be an integer" } set prefs(maxlen,$w) $value } alert { if {$value == ""} { return [info body ::history::alert] } proc ::history::alert w $value } default { error "unknown option $option" } } } proc ::history::alert {w} {bell} | |||
User Comments: |
aku added on 2016-10-18 05:08:04:
This does not belong to the Tcllib tracker. Moved to the Tklib tracker. Ref: http://core.tcl.tk/tklib/tktview/5e324065bfb46f73dcbaa6ef1c7cc24890968602 |