1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
# history.tcl --
#
# Provides a history mechanism for entry widgets
#
# Copyright (c) 2005 Aaron Faupell <afaupell@users.sourceforge.net>
#
# 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 -1]
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) > -1 && [lindex $history($w,list) $history($w,cur)] == $line} {
set history($w,list) [lreplace $history($w,list) $history($w,cur) $history($w,cur)]
}
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) -1
}
proc ::history::up {w} {
variable history
if {[lindex $history($w,list) [expr {$history($w,cur) + 1}]] != ""} {
if {$history($w,cur) == -1} {
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) != -1} {
$w delete 0 end
if {$history($w,cur) == 0} {
$w insert end $history($w,tmp)
set history($w,cur) -1
} 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) -1
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}
|
