Overview
Artifact ID: | 5f27c8b0058baffb84c9ed343188d5a8ccb65ebd |
---|---|
Ticket: | 5e324065bfb46f73dcbaa6ef1c7cc24890968602
Improved history module of Tklib |
User & Date: | aku 2016-10-18 05:06:17 |
Changes
- assignee changed to: "nobody"
- closer changed to: "nobody"
- cmimetype changed to: "text/plain"
- comment changed to:
I have made two improvements to the history module: 1. Avoid multiple add of same text to the entry history 2. Fixed weird behaviour 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}
- foundin changed to: "0.1"
- is_private changed to: "0"
- login: "aku"
- priority changed to: "5 Medium"
- private_contact changed to: "dac83924bb70a68f6807871ce80578576828377e"
- resolution changed to: "None"
- severity changed to: "Minor"
- status changed to: "Open"
- submitter changed to: "aku"
- subsystem changed to: "A Category Is Missing"
- title changed to: "Improved history module of Tklib"
- type changed to: "Patch"