- merge v0.01 --> Añadido fileselector - Añadidas fuentes de Gem y Pure Data - pix2jpg incluído en Gem. Archivos de construcción de Gem modificados. - Añadido fichero ompiling.txt con instrucciones de compilación
95 lines
3.1 KiB
Tcl
95 lines
3.1 KiB
Tcl
# Copyright (c) 2002-2012 krzYszcz and others.
|
|
# For information on usage and redistribution, and for a DISCLAIMER OF ALL
|
|
# WARRANTIES, see the file, "LICENSE.txt," in this distribution. */
|
|
|
|
# pdtk_textwindow - a window containing scrollable text for "qlist" and
|
|
# "textfile" objects - later the latter might get renamed just "text"
|
|
|
|
# this is adapted from krzYszcz's code for coll in cyclone
|
|
|
|
package provide pdtk_textwindow 0.1
|
|
|
|
# these procs are currently all in the global namespace because they're
|
|
# called from pd.
|
|
|
|
proc pdtk_textwindow_open {name geometry title font} {
|
|
if {[winfo exists $name]} {
|
|
$name.text delete 1.0 end
|
|
} else {
|
|
toplevel $name
|
|
wm title $name $title
|
|
wm geometry $name $geometry
|
|
wm protocol $name WM_DELETE_WINDOW \
|
|
[concat pdtk_textwindow_close $name 1]
|
|
bind $name <<Modified>> "pdtk_textwindow_dodirty $name"
|
|
text $name.text -relief raised -bd 2 \
|
|
-font [get_font_for_size $font] \
|
|
-yscrollcommand "$name.scroll set" -background white
|
|
scrollbar $name.scroll -command "$name.text yview"
|
|
pack $name.scroll -side right -fill y
|
|
pack $name.text -side left -fill both -expand 1
|
|
bind $name.text <$::modifier-Key-s> "pdtk_textwindow_send $name"
|
|
}
|
|
}
|
|
|
|
proc pdtk_textwindow_dodirty {name} {
|
|
if {[catch {$name.text edit modified} dirty]} {set dirty 1}
|
|
set title [wm title $name]
|
|
set dt [string equal -length 1 $title "*"]
|
|
if {$dirty} {
|
|
if {$dt == 0} {wm title $name *$title}
|
|
} else {
|
|
if {$dt} {wm title $name [string range $title 1 end]}
|
|
}
|
|
}
|
|
|
|
proc pdtk_textwindow_setdirty {name flag} {
|
|
if {[winfo exists $name]} {
|
|
catch {$name.text edit modified $flag}
|
|
}
|
|
}
|
|
|
|
proc pdtk_textwindow_doclose {name} {
|
|
destroy $name
|
|
pdsend [concat $name signoff]
|
|
}
|
|
|
|
proc pdtk_textwindow_append {name contents} {
|
|
if {[winfo exists $name]} {
|
|
$name.text insert end $contents
|
|
}
|
|
}
|
|
|
|
proc pdtk_textwindow_send {name} {
|
|
if {[winfo exists $name]} {
|
|
pdsend [concat $name clear]
|
|
for {set i 1} \
|
|
{[$name.text compare $i.end < end]} \
|
|
{incr i 1} {
|
|
set lin [$name.text get $i.0 $i.end]
|
|
if {$lin != ""} {
|
|
regsub -all \; $lin " \\; " tmplin
|
|
regsub -all \, $tmplin " \\, " lin
|
|
pdsend [concat $name addline $lin]
|
|
}
|
|
}
|
|
}
|
|
pdtk_textwindow_setdirty $name 0
|
|
}
|
|
|
|
proc pdtk_textwindow_close {name ask} {
|
|
if {[winfo exists $name]} {
|
|
if {[catch {$name.text edit modified} dirty]} {set dirty 1}
|
|
if {$ask && $dirty} {
|
|
set title [wm title $name]
|
|
if {[string equal -length 1 $title "*"]} {
|
|
set title [string range $title 1 end]
|
|
}
|
|
set answer [tk_messageBox \-type yesnocancel \
|
|
\-icon question \
|
|
\-message [concat Save changes to \"$title\"?]]
|
|
if {$answer == "yes"} {pdtk_textwindow_send $name}
|
|
if {$answer != "cancel"} {pdsend [concat $name close]}
|
|
} else {pdsend [concat $name close]}
|
|
}
|
|
}
|