blob: 0c379041304cc2692375a4bc94c44de3134b8076 (
plain)
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
package require Tclpd 0.2.3
package require TclpdLib 0.19
package require base64
pd::guiproc ::tclpd_console_exec {cmd} {
if {$cmd eq {}} {return}
global tclpd_console_hist
global tclpd_console_histp
if {$cmd ne [lindex $tclpd_console_hist end]} {
lappend tclpd_console_hist $cmd
set tclpd_console_histp [expr {[llength $tclpd_console_hist]-1}]
}
.pdwindow.tcl.tclpd.entry delete 0 end
# encode message in base64 to prevent escaping and other FUDI annoyances
set cmd [::base64::encode $cmd]
set max_line_length 1024
while {$cmd ne {}} {
set line [string range $cmd 0 [expr $max_line_length - 1]]
set cmd [string range $cmd $max_line_length end]
::pdsend "$::tclpd_console base64data $line"
}
::pdsend "$::tclpd_console base64data -"
}
pd::guiproc ::tclpd_console_history {dir} {
global tclpd_console_hist
global tclpd_console_histp
incr tclpd_console_histp $dir
set l [llength $tclpd_console_hist]
if {$tclpd_console_histp < 0} {set tclpd_console_histp 0}
if {$tclpd_console_histp >= $l} {set tclpd_console_histp [expr {$l-1}]}
.pdwindow.tcl.tclpd.entry delete 0 end
.pdwindow.tcl.tclpd.entry insert 0 \
[lindex $tclpd_console_hist $tclpd_console_histp]
}
proc tclpd-console::constructor {self} {
if {[info exist ::tclpd-console::loaded]} {
return -code error "only one instance of tclpd-console allowed"
}
set ::tclpd-console::loaded 1
set ::${self}_loaded 1
pd_bind [tclpd_get_instance_pd $self] [gensym $self]
sys_gui "set ::tclpd_console $self"
sys_gui {
set ::tclpd_console_hist {}
set ::tclpd_console_histp {}
package require base64
set w .pdwindow.tcl.tclpd
frame $w -borderwidth 0
pack $w -side bottom -fill x
label $w.label -text [_ "tclpd: "] -anchor e
pack $w.label -side left
entry $w.entry -width 200 \
-exportselection 1 -insertwidth 2 -insertbackground blue \
-textvariable ::tclpd_cmd -font {$::font_family 12}
pack $w.entry -side left -fill x
bind $w.entry <$::modifier-Key-a> "%W selection range 0 end; break"
bind $w.entry <Return> {::tclpd_console_exec $::tclpd_cmd}
set bgrule {[lindex {#FFF0F0 #FFFFFF} [info complete $::tclpd_cmd]]}
bind $w.entry <KeyRelease> "$w.entry configure -background $bgrule"
bind $w.entry <Up> "::tclpd_console_history -1"
bind $w.entry <Down> "::tclpd_console_history 1"
bind .pdwindow.text <Key-Tab> "focus $w.entry; break"
after idle .pdwindow.text.internal yview end
}
# make puts print into pdwindow
if {[info procs puts_tclpd_console] eq {}} {
rename puts puts_tclpd_console
proc ::puts {args} {
if {[llength $args] == 1} {
uplevel "pd::post $args"
} else {
uplevel "puts_tclpd_console $args"
}
}
}
}
proc tclpd-console::destructor {self} {
if {[set ::${self}_loaded]} {
sys_gui { destroy .pdwindow.tcl.tclpd ; unset ::tclpd_console }
pd_unbind [tclpd_get_instance_pd $self] [gensym $self]
# restore original puts
if {[info procs puts_tclpd_console] ne {}} {
rename puts_tclpd_console puts
}
}
unset ::tclpd-console::loaded
unset ::${self}_loaded
}
proc tclpd-console::0_base64data {self data} {
if {[llength $data] != 2 || [lindex $data 0] ne {symbol}} {
return -code error "malformed arguments: $data"
}
global tclpd_console_buf
set data [lindex $data 1]
set op [string index $data 0]
if {$op eq "-"} {
set cmd [::base64::decode $tclpd_console_buf]
set tclpd_console_buf {}
pd::post [concat % $cmd]
set result [uplevel #0 $cmd]
if {$result ne {}} {pd::post $result}
#sys_gui "tk_messageBox -message {Result:\n$result}"
} else {
append tclpd_console_buf $data
}
}
pd::class tclpd-console -noinlet 1
|
