blob: b3fb08d8771d8ae41073ef545c4d4c38d15ff40e (
plain) (
blame)
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
|
################################################
# Define some TCL debug procedures.
################################################
set tcl_up 0
proc tclCommandClear {widget args} { send tclEntry set string "" }
proc tclCommandExecute {widget args} { send server [send tclEntry {get string}]
}
proc tclCommand {widget mode command args} { send server $command }
proc tclClose {widget args} { tclPanel }
proc tclOpen args \
{
global tcl_up
send tcl_panel map
set tcl_up 1
}
proc tclPanel args \
{
global tcl_up
if {$tcl_up} {
send tcl_panel unmap
set tcl_up 0
} else {
send tcl_panel map
set tcl_up 1
}
}
send tclClear addCallback tclCommandClear
send tclExecute addCallback tclCommandExecute
send tclEntry addCallback tclCommand
send tclDismiss addCallback tclClose
|
