Tk Library Source Code

View Ticket
Login
Ticket UUID: 5e324065bfb46f73dcbaa6ef1c7cc24890968602
Title: Improved history module of Tklib
Type: Patch Version: 0.1
Submitter: aku Created on: 2016-10-18 05:06:17
Subsystem: A Category Is Missing Assigned To: nobody
Priority: 5 Medium Severity: Minor
Status: Open Last Modified: 2016-10-18 05:06:17
Resolution: None Closed By: nobody
    Closed on:
Description:
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}