Tk Library Source Code

Ticket Change Details
Login
Overview

Artifact ID: 5f27c8b0058baffb84c9ed343188d5a8ccb65ebd
Ticket: 5e324065bfb46f73dcbaa6ef1c7cc24890968602
Improved history module of Tklib
User & Date: aku 2016-10-18 05:06:17
Changes

  1. assignee changed to: "nobody"
  2. closer changed to: "nobody"
  3. cmimetype changed to: "text/plain"
  4. 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}
    
  5. foundin changed to: "0.1"
  6. is_private changed to: "0"
  7. login: "aku"
  8. priority changed to: "5 Medium"
  9. private_contact changed to: "dac83924bb70a68f6807871ce80578576828377e"
  10. resolution changed to: "None"
  11. severity changed to: "Minor"
  12. status changed to: "Open"
  13. submitter changed to: "aku"
  14. subsystem changed to: "A Category Is Missing"
  15. title changed to: "Improved history module of Tklib"
  16. type changed to: "Patch"