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
|
# A frame, scrollbar, and text
frame .eval
set _t [text .eval.t -width 40 -height 15 -yscrollcommand {.eval.s set}]
scrollbar .eval.s -command {.eval.t yview}
pack .eval.s -side left -fill y
pack .eval.t -side right -fill both -expand true
pack .eval -fill both -expand true
# Insert the prompt and initialize the limit mark
.eval.t insert insert "Tcl eval log\n"
set prompt "tcl> "
.eval.t insert insert $prompt
.eval.t mark set limit insert
.eval.t mark gravity limit left
focus .eval.t
# Keybindings that limit input and eval things
bind .eval.t <Return> { _Eval .eval.t ; break }
bind .eval.t <Any-Key> {
if [%W compare insert < limit] {
%W mark set insert end
}
}
bind .eval.t <BackSpace> {
if {[%W tag nextrange sel 1.0 end] != ""} {
%W delete sel.first sel.last
} elseif [%W compare insert > limit] {
%W delete insert-1c
%W see insert
}
break
}
bindtags .eval.t {.eval.t Text all}
proc _Eval { t } {
global prompt
set command [$t get limit end]
if [info complete $command] {
$t insert insert \n
$t mark set limit insert
set err [catch {uplevel #0 $command} result]
if {[string length $result] > 0} {
$t insert insert $result\n
}
$t insert insert $prompt
$t see insert
$t mark set limit insert
return
} else {
$t insert insert \n
}
}
rename puts putsSystem
proc puts args {
if {[llength $args] > 3} {
error "invalid arguments"
}
set newline "\n"
if {[string match "-nonewline" [lindex $args 0]]} {
set newline ""
set args [lreplace $args 0 0]
}
if {[llength $args] == 1} {
set chan stdout
set string [lindex $args 0]$newline
} else {
set chan [lindex $args 0]
set string [lindex $args 1]$newline
}
if [regexp (stdout|stderr) $chan] {
.eval.t mark gravity limit right
.eval.t insert limit $string
.eval.t see limit
.eval.t mark gravity limit left
} else {
putsSystem -nonewline $chan $string
}
}
|
