aboutsummaryrefslogtreecommitdiff
path: root/pd/tcl
diff options
context:
space:
mode:
authorHans-Christoph Steiner <eighthave@users.sourceforge.net>2011-10-09 16:36:37 +0000
committerHans-Christoph Steiner <eighthave@users.sourceforge.net>2011-10-09 16:36:37 +0000
commit21c068f1916330e90f814bed461fe0821d1665ec (patch)
tree949b73696fff09a44b8d3eb01b70bae7174cbd14 /pd/tcl
parentbf8ced1efe1a032342e864edc635fa4e2676670d (diff)
checked in pd-0.43-0.src.tar.gz
svn path=/trunk/; revision=15557
Diffstat (limited to 'pd/tcl')
-rw-r--r--pd/tcl/AppMain.tcl9
-rw-r--r--pd/tcl/Makefile.am16
-rw-r--r--pd/tcl/apple_events.tcl50
-rw-r--r--pd/tcl/dialog_array.tcl21
-rw-r--r--pd/tcl/dialog_audio.tcl251
-rw-r--r--pd/tcl/dialog_canvas.tcl26
-rw-r--r--pd/tcl/dialog_data.tcl53
-rw-r--r--pd/tcl/dialog_find.tcl145
-rw-r--r--pd/tcl/dialog_font.tcl61
-rw-r--r--pd/tcl/dialog_gatom.tcl26
-rw-r--r--pd/tcl/dialog_iemgui.tcl105
-rw-r--r--pd/tcl/dialog_message.tcl85
-rw-r--r--pd/tcl/dialog_midi.tcl15
-rw-r--r--pd/tcl/dialog_path.tcl70
-rw-r--r--pd/tcl/dialog_startup.tcl96
-rw-r--r--pd/tcl/helpbrowser.tcl272
-rw-r--r--pd/tcl/opt_parser.tcl40
-rw-r--r--pd/tcl/pd-gui.tcl506
-rwxr-xr-xpd/tcl/pd.icobin0 -> 25214 bytes
-rw-r--r--pd/tcl/pd_bindings.tcl303
-rw-r--r--pd/tcl/pd_connect.tcl28
-rw-r--r--pd/tcl/pd_menucommands.tcl217
-rw-r--r--pd/tcl/pd_menus.tcl447
-rw-r--r--pd/tcl/pdtk_canvas.tcl333
-rw-r--r--pd/tcl/pdtk_text.tcl53
-rw-r--r--pd/tcl/pdwindow.tcl391
-rw-r--r--pd/tcl/pkgIndex.tcl7
-rw-r--r--pd/tcl/scrollbox.tcl191
-rw-r--r--pd/tcl/scrollboxwindow.tcl94
-rw-r--r--pd/tcl/wheredoesthisgo.tcl119
30 files changed, 2985 insertions, 1045 deletions
diff --git a/pd/tcl/AppMain.tcl b/pd/tcl/AppMain.tcl
index b170c6f5..7c68a9d0 100644
--- a/pd/tcl/AppMain.tcl
+++ b/pd/tcl/AppMain.tcl
@@ -3,17 +3,8 @@
# other configuration, like when 'pd' launches Wish.app or when 'pd' is using
# an X11 wish on Mac OS X. GNU/Linux and Windows will never use this file.
-
-puts --------------------------AppMain.tcl-----------------------------------
-catch {console show}
-
package require apple_events
-puts "AppMain.tcl"
-puts "argv0: $argv0"
-puts "executable: [info nameofexecutable]"
-puts "argc: $argc argv: $argv"
-
# TODO is there anything useful to do with the psn (Process Serial Number)?
if {[string first "-psn" [lindex $argv 0]] == 0} {
set argv [lrange $argv 1 end]
diff --git a/pd/tcl/Makefile.am b/pd/tcl/Makefile.am
new file mode 100644
index 00000000..65780ebf
--- /dev/null
+++ b/pd/tcl/Makefile.am
@@ -0,0 +1,16 @@
+AUTOMAKE_OPTIONS = foreign
+
+SUFFIXES = .tcl
+
+# we want these in the dist tarball
+#EXTRA_DIST = CHANGELOG.txt notes.txt makefile.mingw
+
+
+bin_SCRIPTS = pd-gui.tcl
+
+libpdtcldir = $(pkglibdir)/tcl
+dist_libpdtcl_SCRIPTS = pd-gui.tcl
+dist_libpdtcl_DATA = apple_events.tcl dialog_canvas.tcl dialog_gatom.tcl dialog_path.tcl pd_bindings.tcl pd_menus.tcl pdwindow.tcl scrollboxwindow.tcl AppMain.tcl dialog_data.tcl dialog_iemgui.tcl dialog_startup.tcl pd_connect.tcl pdtk_array.tcl pkgIndex.tcl wheredoesthisgo.tcl dialog_array.tcl dialog_find.tcl dialog_message.tcl helpbrowser.tcl pdtk_canvas.tcl pkg_mkIndex.tcl dialog_audio.tcl dialog_font.tcl dialog_midi.tcl opt_parser.tcl pd_menucommands.tcl pdtk_text.tcl scrollbox.tcl pd.ico
+
+etags: TAGS
+ etags --append --language=none --regex="/proc[ \t]+\([^ \t]+\)/\1/" *.tcl
diff --git a/pd/tcl/apple_events.tcl b/pd/tcl/apple_events.tcl
index cfc92982..0311add7 100644
--- a/pd/tcl/apple_events.tcl
+++ b/pd/tcl/apple_events.tcl
@@ -1,53 +1,65 @@
package provide apple_events 0.1
+package require pdwindow
package require wheredoesthisgo
# from http://wiki.tcl.tk/12987
set ::tk::mac::CGAntialiasLimit 0 ;# min line thickness to anti-alias (default: 3)
-set ::tk::mac::antialiasedtext 1 ;# enable/disable anti-aliased text
+set ::tk::mac::antialiasedtext 1 ;# enable anti-aliased text
# kAEOpenDocuments
proc ::tk::mac::OpenDocument {args} {
- foreach filename $args {
- puts "open_file $filename"
- open_file $filename
+ foreach filename $args {
+ if {$::done_init} {
+ open_file $filename
+ } else {
+ lappend ::filestoopen_list $filename
+ }
}
set ::pd_menucommands::menu_open_dir [file dirname $filename]
}
# kEventAppHidden
-proc ::tk::mac::OnHide {} {
- # TODO
+proc ::tk::mac::OnHide {args} {
+ ::pdwindow::verbose 1 "::tk::mac::OnHide $args +++++++++++++++++++++"
}
# kEventAppShown
-proc ::tk::mac::OnShow {} {
- # TODO
+proc ::tk::mac::OnShow {args} {
+ ::pdwindow::verbose 1 "::tk::mac::OnShow $args +++++++++++++++++++++"
+}
+
+# open About Pd... in Tk/Cocoa
+proc tkAboutDialog {} {
+ menu_aboutpd
}
# kAEShowPreferences
-proc ::tk::mac::ShowPreferences {} {
- menu_preferences_dialog
+proc ::tk::mac::ShowPreferences {args} {
+ ::pdwindow::verbose 1 "::tk::mac::ShowPreferences $args ++++++++++++"
+ pdsend "pd start-path-dialog"
}
# kAEQuitApplication
-#proc ::tk::mac::Quit {} {
-# # TODO sort this out... how to quit pd-gui after sending the message
-# puts stderr "Custom exit proc"
-# pdsend "pd verifyquit"
+proc ::tk::mac::Quit {args} {
+ pdsend "pd verifyquit"
+}
+
+# on Tk/Cocoa, override the Apple Help menu
+#proc tk::mac::ShowHelp {args} {
#}
# these I gleaned by reading the source (tkMacOSXHLEvents.c)
proc ::tk::mac::PrintDocument {args} {
- # TODO what's $mytoplevel here?. I am guessing args would be the same as
- # ::tk::mac::OpenDocument
- #menu_print $mytoplevel
+ menu_print $::focused_window
}
-proc ::tk::mac::OpenApplication {} {
+proc ::tk::mac::OpenApplication {args} {
+ ::pdwindow::verbose 1 "::tk::mac::OpenApplication $args ++++++++++++"
}
-proc ::tk::mac::ReopenApplication {} {
+proc ::tk::mac::ReopenApplication {args} {
+ ::pdwindow::verbose 1 "::tk::mac::ReopenApplication $args ++++++++++"
}
diff --git a/pd/tcl/dialog_array.tcl b/pd/tcl/dialog_array.tcl
index 87b2de8c..0f2696d2 100644
--- a/pd/tcl/dialog_array.tcl
+++ b/pd/tcl/dialog_array.tcl
@@ -239,7 +239,6 @@ proc ::dialog_array::ok {mytoplevel} {
}
proc ::dialog_array::pdtk_array_dialog {mytoplevel name size flags newone} {
-puts "::dialog_array::pdtk_array_dialog {$mytoplevel $name $size $flags $newone}"
if {[winfo exists $mytoplevel]} {
wm deiconify $mytoplevel
raise $mytoplevel
@@ -262,7 +261,11 @@ puts "::dialog_array::pdtk_array_dialog {$mytoplevel $name $size $flags $newone}
proc ::dialog_array::create_dialog {mytoplevel newone} {
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Array Properties"]
- if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
+ wm group $mytoplevel .
+ wm resizable $mytoplevel 0 0
+ wm transient $mytoplevel $::focused_window
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "array"
frame $mytoplevel.name
@@ -315,14 +318,16 @@ proc ::dialog_array::create_dialog {mytoplevel newone} {
}
# end jsarlo
frame $mytoplevel.buttonframe
- pack $mytoplevel.buttonframe -side bottom -fill x -pady 2m
+ pack $mytoplevel.buttonframe -side bottom -expand 1 -fill x -pady 2m
button $mytoplevel.buttonframe.cancel -text [_ "Cancel"] \
-command "::dialog_array::cancel $mytoplevel"
- if {$newone == 0} {button $mytoplevel.buttonframe.apply -text [_ "Apply"] \
- -command "::dialog_array::apply $mytoplevel"}
+ pack $mytoplevel.buttonframe.cancel -side left -expand 1 -fill x -padx 10
+ if {$newone == 0 && $::windowingsystem ne "aqua"} {
+ button $mytoplevel.buttonframe.apply -text [_ "Apply"] \
+ -command "::dialog_array::apply $mytoplevel"
+ pack $mytoplevel.buttonframe.apply -side left -expand 1 -fill x -padx 10
+ }
button $mytoplevel.buttonframe.ok -text [_ "OK"]\
-command "::dialog_array::ok $mytoplevel"
- pack $mytoplevel.buttonframe.cancel -side left -expand 1
- if {$newone == 0} {pack $mytoplevel.buttonframe.apply -side left -expand 1}
- pack $mytoplevel.buttonframe.ok -side left -expand 1
+ pack $mytoplevel.buttonframe.ok -side left -expand 1 -fill x -padx 10
}
diff --git a/pd/tcl/dialog_audio.tcl b/pd/tcl/dialog_audio.tcl
index 1025f66e..56f18f45 100644
--- a/pd/tcl/dialog_audio.tcl
+++ b/pd/tcl/dialog_audio.tcl
@@ -4,19 +4,20 @@ namespace eval ::dialog_audio:: {
namespace export pdtk_audio_dialog
}
-# TODO this panel really needs some reworking, it works but the code is
-# very unreadable
+# TODO this panel really needs some reworking, it works but the code is very
+# unreadable. The panel could look a lot better too, like using menubuttons
+# instead of regular buttons with tk_popup for pulldown menus.
####################### audio dialog ##################3
-proc ::dialog_audio::apply {id} {
+proc ::dialog_audio::apply {mytoplevel} {
global audio_indev1 audio_indev2 audio_indev3 audio_indev4
global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4
global audio_inenable1 audio_inenable2 audio_inenable3 audio_inenable4
global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4
global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4
global audio_outenable1 audio_outenable2 audio_outenable3 audio_outenable4
- global audio_sr audio_advance audio_callback
+ global audio_sr audio_advance audio_callback audio_blocksize
pdsend "pd audio-dialog \
$audio_indev1 \
@@ -37,16 +38,17 @@ proc ::dialog_audio::apply {id} {
[expr $audio_outchan4 * ( $audio_outenable4 ? 1 : -1 ) ]\
$audio_sr \
$audio_advance \
- $audio_callback"
+ $audio_callback \
+ $audio_blocksize"
}
-proc ::dialog_audio::cancel {id} {
- pdsend "$id cancel"
+proc ::dialog_audio::cancel {mytoplevel} {
+ pdsend "$mytoplevel cancel"
}
-proc ::dialog_audio::ok {id} {
- ::dialog_audio::apply $id
- ::dialog_audio::cancel $id
+proc ::dialog_audio::ok {mytoplevel} {
+ ::dialog_audio::apply $mytoplevel
+ ::dialog_audio::cancel $mytoplevel
}
# callback from popup menu
@@ -78,18 +80,19 @@ proc audio_popup {name buttonname varname devlist} {
# opening several devices; if not, we get an extra button to turn longform
# on and restart the dialog.
-proc ::dialog_audio::pdtk_audio_dialog {id indev1 indev2 indev3 indev4 \
+proc ::dialog_audio::pdtk_audio_dialog {mytoplevel \
+ indev1 indev2 indev3 indev4 \
inchan1 inchan2 inchan3 inchan4 \
outdev1 outdev2 outdev3 outdev4 \
outchan1 outchan2 outchan3 outchan4 sr advance multi callback \
- longform} {
+ longform blocksize} {
global audio_indev1 audio_indev2 audio_indev3 audio_indev4
global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4
global audio_inenable1 audio_inenable2 audio_inenable3 audio_inenable4
global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4
global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4
global audio_outenable1 audio_outenable2 audio_outenable3 audio_outenable4
- global audio_sr audio_advance audio_callback
+ global audio_sr audio_advance audio_callback audio_blocksize
global audio_indevlist audio_outdevlist
global pd_indev pd_outdev
global audio_longform
@@ -125,174 +128,196 @@ proc ::dialog_audio::pdtk_audio_dialog {id indev1 indev2 indev3 indev4 \
set audio_sr $sr
set audio_advance $advance
set audio_callback $callback
-
- toplevel $id
- wm title $id [_ "Audio Settings"]
- if {$::windowingsystem eq "aqua"} {$id configure -menu .menubar}
- ::pd_bindings::dialog_bindings $id "audio"
-
- frame $id.buttonframe
- pack $id.buttonframe -side bottom -fill x -pady 2m
- button $id.buttonframe.cancel -text [_ "Cancel"]\
- -command "::dialog_audio::cancel $id"
- button $id.buttonframe.apply -text [_ "Apply"]\
- -command "::dialog_audio::apply $id"
- button $id.buttonframe.ok -text [_ "OK"]\
- -command "::dialog_audio::ok $id"
- button $id.buttonframe.save -text [_ "Save all settings"]\
- -command "::dialog_audio::apply $id \; pdsend \"pd save-preferences\""
- pack $id.buttonframe.cancel $id.buttonframe.apply $id.buttonframe.ok \
- $id.buttonframe.save -side left -expand 1
+ set audio_blocksize $blocksize
+
+ toplevel $mytoplevel -class DialogWindow
+ wm title $mytoplevel [_ "Audio Settings"]
+ wm group $mytoplevel .
+ wm resizable $mytoplevel 0 0
+ wm transient $mytoplevel
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 10 -pady 5
+ ::pd_bindings::dialog_bindings $mytoplevel "audio"
+ # not all Tcl/Tk versions or platforms support -topmost, so catch the error
+ catch {wm attributes $mytoplevel -topmost 1}
+
+ frame $mytoplevel.buttonframe
+ pack $mytoplevel.buttonframe -side bottom -fill x -pady 2m
+ button $mytoplevel.buttonframe.cancel -text [_ "Cancel"]\
+ -command "::dialog_audio::cancel $mytoplevel"
+ pack $mytoplevel.buttonframe.cancel -side left -expand 1 -fill x -padx 15
+ button $mytoplevel.buttonframe.apply -text [_ "Apply"]\
+ -command "::dialog_audio::apply $mytoplevel"
+ pack $mytoplevel.buttonframe.apply -side left -expand 1 -fill x -padx 15
+ button $mytoplevel.buttonframe.ok -text [_ "OK"] \
+ -command "::dialog_audio::ok $mytoplevel"
+ pack $mytoplevel.buttonframe.ok -side left -expand 1 -fill x -padx 15
+
+ button $mytoplevel.saveall -text [_ "Save All Settings"]\
+ -command "::dialog_audio::apply $mytoplevel; pdsend {pd save-preferences}"
+ pack $mytoplevel.saveall -side bottom -expand 1 -pady 5
# sample rate and advance
- frame $id.srf
- pack $id.srf -side top
+ frame $mytoplevel.srf
+ pack $mytoplevel.srf -side top
- label $id.srf.l1 -text [_ "Sample rate:"]
- entry $id.srf.x1 -textvariable audio_sr -width 7
- label $id.srf.l2 -text [_ "Delay (msec):"]
- entry $id.srf.x2 -textvariable audio_advance -width 4
- pack $id.srf.l1 $id.srf.x1 $id.srf.l2 $id.srf.x2 -side left
+ label $mytoplevel.srf.l1 -text [_ "Sample rate:"]
+ entry $mytoplevel.srf.x1 -textvariable audio_sr -width 7
+ label $mytoplevel.srf.l2 -text [_ "Delay (msec):"]
+ entry $mytoplevel.srf.x2 -textvariable audio_advance -width 4
+
+ label $mytoplevel.srf.l3 -text [_ "Block size:"]
+ tk_optionMenu $mytoplevel.srf.x3 audio_blocksize 64 128 256 512 1024 2048
+
+ pack $mytoplevel.srf.l1 $mytoplevel.srf.x1 $mytoplevel.srf.l2 \
+ $mytoplevel.srf.x2 $mytoplevel.srf.l3 $mytoplevel.srf.x3 -side left
if {$audio_callback >= 0} {
- checkbutton $id.srf.x3 -variable audio_callback \
+ checkbutton $mytoplevel.srf.x4 -variable audio_callback \
-text [_ "Use callbacks"] -anchor e
- pack $id.srf.x3 -side left
+ pack $mytoplevel.srf.x4 -side left
}
# input device 1
- frame $id.in1f
- pack $id.in1f -side top
+ frame $mytoplevel.in1f
+ pack $mytoplevel.in1f -side top
- checkbutton $id.in1f.x0 -variable audio_inenable1 \
+ checkbutton $mytoplevel.in1f.x0 -variable audio_inenable1 \
-text [_ "Input device 1:"] -anchor e
- button $id.in1f.x1 -text [lindex $audio_indevlist $audio_indev1] \
- -command [list audio_popup $id $id.in1f.x1 audio_indev1 $audio_indevlist]
- label $id.in1f.l2 -text [_ "Channels:"]
- entry $id.in1f.x2 -textvariable audio_inchan1 -width 3
- pack $id.in1f.x0 $id.in1f.x1 $id.in1f.l2 $id.in1f.x2 -side left -fill x
+ button $mytoplevel.in1f.x1 -text [lindex $audio_indevlist $audio_indev1] \
+ -command [list audio_popup $mytoplevel $mytoplevel.in1f.x1 audio_indev1 $audio_indevlist]
+ label $mytoplevel.in1f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.in1f.x2 -textvariable audio_inchan1 -width 3
+ pack $mytoplevel.in1f.x0 $mytoplevel.in1f.x1 $mytoplevel.in1f.l2 \
+ $mytoplevel.in1f.x2 -side left -fill x
# input device 2
if {$longform && $multi > 1 && [llength $audio_indevlist] > 1} {
- frame $id.in2f
- pack $id.in2f -side top
+ frame $mytoplevel.in2f
+ pack $mytoplevel.in2f -side top
- checkbutton $id.in2f.x0 -variable audio_inenable2 \
+ checkbutton $mytoplevel.in2f.x0 -variable audio_inenable2 \
-text [_ "Input device 2:"] -anchor e
- button $id.in2f.x1 -text [lindex $audio_indevlist $audio_indev2] \
- -command [list audio_popup $id $id.in2f.x1 audio_indev2 \
+ button $mytoplevel.in2f.x1 -text [lindex $audio_indevlist $audio_indev2] \
+ -command [list audio_popup $mytoplevel $mytoplevel.in2f.x1 audio_indev2 \
$audio_indevlist]
- label $id.in2f.l2 -text [_ "Channels:"]
- entry $id.in2f.x2 -textvariable audio_inchan2 -width 3
- pack $id.in2f.x0 $id.in2f.x1 $id.in2f.l2 $id.in2f.x2 -side left -fill x
+ label $mytoplevel.in2f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.in2f.x2 -textvariable audio_inchan2 -width 3
+ pack $mytoplevel.in2f.x0 $mytoplevel.in2f.x1 $mytoplevel.in2f.l2 \
+ $mytoplevel.in2f.x2 -side left -fill x
}
# input device 3
if {$longform && $multi > 1 && [llength $audio_indevlist] > 2} {
- frame $id.in3f
- pack $id.in3f -side top
+ frame $mytoplevel.in3f
+ pack $mytoplevel.in3f -side top
- checkbutton $id.in3f.x0 -variable audio_inenable3 \
+ checkbutton $mytoplevel.in3f.x0 -variable audio_inenable3 \
-text [_ "Input device 3:"] -anchor e
- button $id.in3f.x1 -text [lindex $audio_indevlist $audio_indev3] \
- -command [list audio_popup $id $id.in3f.x1 audio_indev3 \
+ button $mytoplevel.in3f.x1 -text [lindex $audio_indevlist $audio_indev3] \
+ -command [list audio_popup $mytoplevel $mytoplevel.in3f.x1 audio_indev3 \
$audio_indevlist]
- label $id.in3f.l2 -text [_ "Channels:"]
- entry $id.in3f.x2 -textvariable audio_inchan3 -width 3
- pack $id.in3f.x0 $id.in3f.x1 $id.in3f.l2 $id.in3f.x2 -side left
+ label $mytoplevel.in3f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.in3f.x2 -textvariable audio_inchan3 -width 3
+ pack $mytoplevel.in3f.x0 $mytoplevel.in3f.x1 $mytoplevel.in3f.l2 $mytoplevel.in3f.x2 -side left
}
# input device 4
if {$longform && $multi > 1 && [llength $audio_indevlist] > 3} {
- frame $id.in4f
- pack $id.in4f -side top
+ frame $mytoplevel.in4f
+ pack $mytoplevel.in4f -side top
- checkbutton $id.in4f.x0 -variable audio_inenable4 \
+ checkbutton $mytoplevel.in4f.x0 -variable audio_inenable4 \
-text [_ "Input device 4:"] -anchor e
- button $id.in4f.x1 -text [lindex $audio_indevlist $audio_indev4] \
- -command [list audio_popup $id $id.in4f.x1 audio_indev4 \
+ button $mytoplevel.in4f.x1 -text [lindex $audio_indevlist $audio_indev4] \
+ -command [list audio_popup $mytoplevel $mytoplevel.in4f.x1 audio_indev4 \
$audio_indevlist]
- label $id.in4f.l2 -text [_ "Channels:"]
- entry $id.in4f.x2 -textvariable audio_inchan4 -width 3
- pack $id.in4f.x0 $id.in4f.x1 $id.in4f.l2 $id.in4f.x2 -side left
+ label $mytoplevel.in4f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.in4f.x2 -textvariable audio_inchan4 -width 3
+ pack $mytoplevel.in4f.x0 $mytoplevel.in4f.x1 $mytoplevel.in4f.l2 \
+ $mytoplevel.in4f.x2 -side left
}
# output device 1
- frame $id.out1f
- pack $id.out1f -side top
+ frame $mytoplevel.out1f
+ pack $mytoplevel.out1f -side top
- checkbutton $id.out1f.x0 -variable audio_outenable1 \
+ checkbutton $mytoplevel.out1f.x0 -variable audio_outenable1 \
-text [_ "Output device 1:"] -anchor e
if {$multi == 0} {
- label $id.out1f.l1 \
+ label $mytoplevel.out1f.l1 \
-text [_ "(same as input device) .............. "]
} else {
- button $id.out1f.x1 -text [lindex $audio_outdevlist $audio_outdev1] \
- -command [list audio_popup $id $id.out1f.x1 audio_outdev1 \
+ button $mytoplevel.out1f.x1 -text [lindex $audio_outdevlist $audio_outdev1] \
+ -command [list audio_popup $mytoplevel $mytoplevel.out1f.x1 audio_outdev1 \
$audio_outdevlist]
}
- label $id.out1f.l2 -text [_ "Channels:"]
- entry $id.out1f.x2 -textvariable audio_outchan1 -width 3
+ label $mytoplevel.out1f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.out1f.x2 -textvariable audio_outchan1 -width 3
if {$multi == 0} {
- pack $id.out1f.x0 $id.out1f.l1 $id.out1f.x2 -side left -fill x
+ pack $mytoplevel.out1f.x0 $mytoplevel.out1f.l1 $mytoplevel.out1f.x2 -side left -fill x
} else {
- pack $id.out1f.x0 $id.out1f.x1 $id.out1f.l2 $id.out1f.x2 -side left -fill x
+ pack $mytoplevel.out1f.x0 $mytoplevel.out1f.x1 $mytoplevel.out1f.l2\
+ $mytoplevel.out1f.x2 -side left -fill x
}
# output device 2
if {$longform && $multi > 1 && [llength $audio_outdevlist] > 1} {
- frame $id.out2f
- pack $id.out2f -side top
+ frame $mytoplevel.out2f
+ pack $mytoplevel.out2f -side top
- checkbutton $id.out2f.x0 -variable audio_outenable2 \
+ checkbutton $mytoplevel.out2f.x0 -variable audio_outenable2 \
-text [_ "Output device 2:"] -anchor e
- button $id.out2f.x1 -text [lindex $audio_outdevlist $audio_outdev2] \
+ button $mytoplevel.out2f.x1 -text [lindex $audio_outdevlist $audio_outdev2] \
-command \
- [list audio_popup $id $id.out2f.x1 audio_outdev2 $audio_outdevlist]
- label $id.out2f.l2 -text [_ "Channels:"]
- entry $id.out2f.x2 -textvariable audio_outchan2 -width 3
- pack $id.out2f.x0 $id.out2f.x1 $id.out2f.l2 $id.out2f.x2 -side left
+ [list audio_popup $mytoplevel $mytoplevel.out2f.x1 audio_outdev2 $audio_outdevlist]
+ label $mytoplevel.out2f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.out2f.x2 -textvariable audio_outchan2 -width 3
+ pack $mytoplevel.out2f.x0 $mytoplevel.out2f.x1 $mytoplevel.out2f.l2\
+ $mytoplevel.out2f.x2 -side left
}
# output device 3
if {$longform && $multi > 1 && [llength $audio_outdevlist] > 2} {
- frame $id.out3f
- pack $id.out3f -side top
+ frame $mytoplevel.out3f
+ pack $mytoplevel.out3f -side top
- checkbutton $id.out3f.x0 -variable audio_outenable3 \
+ checkbutton $mytoplevel.out3f.x0 -variable audio_outenable3 \
-text [_ "Output device 3:"] -anchor e
- button $id.out3f.x1 -text [lindex $audio_outdevlist $audio_outdev3] \
+ button $mytoplevel.out3f.x1 -text [lindex $audio_outdevlist $audio_outdev3] \
-command \
- [list audio_popup $id $id.out3f.x1 audio_outdev3 $audio_outdevlist]
- label $id.out3f.l2 -text [_ "Channels:"]
- entry $id.out3f.x2 -textvariable audio_outchan3 -width 3
- pack $id.out3f.x0 $id.out3f.x1 $id.out3f.l2 $id.out3f.x2 -side left
+ [list audio_popup $mytoplevel $mytoplevel.out3f.x1 audio_outdev3 $audio_outdevlist]
+ label $mytoplevel.out3f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.out3f.x2 -textvariable audio_outchan3 -width 3
+ pack $mytoplevel.out3f.x0 $mytoplevel.out3f.x1 $mytoplevel.out3f.l2 \
+ $mytoplevel.out3f.x2 -side left
}
# output device 4
if {$longform && $multi > 1 && [llength $audio_outdevlist] > 3} {
- frame $id.out4f
- pack $id.out4f -side top
+ frame $mytoplevel.out4f
+ pack $mytoplevel.out4f -side top
- checkbutton $id.out4f.x0 -variable audio_outenable4 \
+ checkbutton $mytoplevel.out4f.x0 -variable audio_outenable4 \
-text [_ "Output device 4:"] -anchor e
- button $id.out4f.x1 -text [lindex $audio_outdevlist $audio_outdev4] \
+ button $mytoplevel.out4f.x1 -text [lindex $audio_outdevlist $audio_outdev4] \
-command \
- [list audio_popup $id $id.out4f.x1 audio_outdev4 $audio_outdevlist]
- label $id.out4f.l2 -text [_ "Channels:"]
- entry $id.out4f.x2 -textvariable audio_outchan4 -width 3
- pack $id.out4f.x0 $id.out4f.x1 $id.out4f.l2 $id.out4f.x2 -side left
+ [list audio_popup $mytoplevel $mytoplevel.out4f.x1 audio_outdev4 $audio_outdevlist]
+ label $mytoplevel.out4f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.out4f.x2 -textvariable audio_outchan4 -width 3
+ pack $mytoplevel.out4f.x0 $mytoplevel.out4f.x1 $mytoplevel.out4f.l2 \
+ $mytoplevel.out4f.x2 -side left
}
# if not the "long form" but if "multi" is 2, make a button to
# restart with longform set.
if {$longform == 0 && $multi > 1} {
- frame $id.longbutton
- pack $id.longbutton -side top
- button $id.longbutton.b -text [_ "Use multiple devices"] \
+ frame $mytoplevel.longbutton
+ pack $mytoplevel.longbutton -side top
+ button $mytoplevel.longbutton.b -text [_ "Use multiple devices"] \
-command {pdsend "pd audio-properties 1"}
- pack $id.longbutton.b
+ pack $mytoplevel.longbutton.b
}
- $id.srf.x1 select from 0
- $id.srf.x1 select adjust end
- focus $id.srf.x1
+ $mytoplevel.srf.x1 select from 0
+ $mytoplevel.srf.x1 select adjust end
+ focus $mytoplevel.srf.x1
}
diff --git a/pd/tcl/dialog_canvas.tcl b/pd/tcl/dialog_canvas.tcl
index 06444807..ea3f5d65 100644
--- a/pd/tcl/dialog_canvas.tcl
+++ b/pd/tcl/dialog_canvas.tcl
@@ -104,7 +104,6 @@ proc ::dialog_canvas::pdtk_canvas_dialog {mytoplevel xscale yscale graphmeflags
} else {
create_dialog $mytoplevel
}
- puts "canvas_dialog $mytoplevel"
switch -- $graphmeflags {
0 {
$mytoplevel.parent.graphme deselect
@@ -119,7 +118,7 @@ proc ::dialog_canvas::pdtk_canvas_dialog {mytoplevel xscale yscale graphmeflags
$mytoplevel.parent.graphme select
$mytoplevel.parent.hidetext select
} default {
- pdtk_post "Warning: unknown graphme flags received in pdtk_canvas_dialog"
+ ::pdwindow::error [_ "WARNING: unknown graphme flags received in pdtk_canvas_dialog"]
}
}
@@ -131,8 +130,8 @@ proc ::dialog_canvas::pdtk_canvas_dialog {mytoplevel xscale yscale graphmeflags
$mytoplevel.range.y.to_entry insert 0 $yto
$mytoplevel.range.x.size_entry insert 0 $xsize
$mytoplevel.range.y.size_entry insert 0 $ysize
- $mytoplevel.range.x.margin_entry insert 0 $xsize
- $mytoplevel.range.y.margin_entry insert 0 $ysize
+ $mytoplevel.range.x.margin_entry insert 0 $xmargin
+ $mytoplevel.range.y.margin_entry insert 0 $ymargin
::dialog_canvas::checkcommand $mytoplevel
}
@@ -140,7 +139,11 @@ proc ::dialog_canvas::pdtk_canvas_dialog {mytoplevel xscale yscale graphmeflags
proc ::dialog_canvas::create_dialog {mytoplevel} {
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Canvas Properties"]
- if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
+ wm group $mytoplevel .
+ wm resizable $mytoplevel 0 0
+ wm transient $mytoplevel $::focused_window
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "canvas"
labelframe $mytoplevel.scale -text [_ "Scale"] -borderwidth 1
@@ -201,13 +204,16 @@ proc ::dialog_canvas::create_dialog {mytoplevel} {
-side left
frame $mytoplevel.buttons
- pack $mytoplevel.buttons -side bottom -fill x -pady 2m
+ pack $mytoplevel.buttons -side bottom -fill x -expand 1 -pady 2m
button $mytoplevel.buttons.cancel -text [_ "Cancel"] \
-command "::dialog_canvas::cancel $mytoplevel"
- button $mytoplevel.buttons.apply -text [_ "Apply"] \
- -command "::dialog_canvas::apply $mytoplevel"
+ pack $mytoplevel.buttons.cancel -side left -expand 1 -fill x -padx 10
+ if {$::windowingsystem ne "aqua"} {
+ button $mytoplevel.buttons.apply -text [_ "Apply"] \
+ -command "::dialog_canvas::apply $mytoplevel"
+ pack $mytoplevel.buttons.apply -side left -expand 1 -fill x -padx 10
+ }
button $mytoplevel.buttons.ok -text [_ "OK"] \
-command "::dialog_canvas::ok $mytoplevel"
- pack $mytoplevel.buttons.cancel $mytoplevel.buttons.apply \
- $mytoplevel.buttons.ok -side left -expand 1
+ pack $mytoplevel.buttons.ok -side left -expand 1 -fill x -padx 10
}
diff --git a/pd/tcl/dialog_data.tcl b/pd/tcl/dialog_data.tcl
new file mode 100644
index 00000000..0bc989f5
--- /dev/null
+++ b/pd/tcl/dialog_data.tcl
@@ -0,0 +1,53 @@
+
+package provide dialog_data 0.1
+
+namespace eval ::dialog_data:: {
+ namespace export pdtk_data_dialog
+}
+
+############ pdtk_data_dialog -- run a data dialog #########
+
+proc ::dialog_data::send {mytoplevel} {
+ for {set i 1} {[$mytoplevel.text compare [concat $i.0 + 3 chars] < end]} \
+ {incr i 1} {
+ pdsend "$mytoplevel data [$mytoplevel.text get $i.0 [expr $i + 1].0]"
+ }
+ pdsend "$mytoplevel end"
+}
+
+proc ::dialog_data::cancel {mytoplevel} {
+ pdsend "$mytoplevel cancel"
+}
+
+proc ::dialog_data::ok {mytoplevel} {
+ ::dialog_data::send $mytoplevel
+ ::dialog_data::cancel $mytoplevel
+}
+
+proc ::dialog_data::pdtk_data_dialog {mytoplevel stuff} {
+ toplevel $mytoplevel -class DialogWindow
+ wm title $mytoplevel [_ "Data Properties"]
+ wm group $mytoplevel $::focused_window
+ wm transient $mytoplevel $::focused_window
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 0 -pady 0
+
+ frame $mytoplevel.buttonframe
+ pack $mytoplevel.buttonframe -side bottom -fill x -pady 2m
+ button $mytoplevel.buttonframe.send -text [_ "Send (Ctrl s)"] \
+ -command "::dialog_data::send $mytoplevel"
+ button $mytoplevel.buttonframe.ok -text [_ "OK (Ctrl t)"] \
+ -command "::dialog_data::ok $mytoplevel"
+ pack $mytoplevel.buttonframe.send -side left -expand 1
+ pack $mytoplevel.buttonframe.ok -side left -expand 1
+
+ text $mytoplevel.text -relief raised -bd 2 -height 40 -width 60 \
+ -yscrollcommand "$mytoplevel.scroll set"
+ scrollbar $mytoplevel.scroll -command "$mytoplevel.text yview"
+ pack $mytoplevel.scroll -side right -fill y
+ pack $mytoplevel.text -side left -fill both -expand 1
+ $mytoplevel.text insert end $stuff
+ focus $mytoplevel.text
+ bind $mytoplevel.text <Control-t> "::dialog_data::ok $mytoplevel"
+ bind $mytoplevel.text <Control-s> "::dialog_data::send $mytoplevel"
+}
diff --git a/pd/tcl/dialog_find.tcl b/pd/tcl/dialog_find.tcl
index c7a708ae..443bec3a 100644
--- a/pd/tcl/dialog_find.tcl
+++ b/pd/tcl/dialog_find.tcl
@@ -1,117 +1,182 @@
+# the find dialog panel is a bit unusual in that it is created directly by the
+# Tcl 'pd-gui'. Most dialog panels are created by sending a message to 'pd',
+# which then sends a message to 'pd-gui' to create the panel.
package provide dialog_find 0.1
package require pd_bindings
namespace eval ::dialog_find:: {
+ variable find_in_toplevel ".pdwindow"
# store the state of the "Match whole word only" check box
variable wholeword_button 0
# if the search hasn't changed, then the Find button sends "findagain"
variable previous_wholeword_button 0
variable previous_findstring ""
+ variable find_history {}
+ variable history_position 0
- namespace export menu_dialog_find
+ namespace export pdtk_couldnotfind
}
-# TODO make find panel as small as possible, being topmost means its findable
-# TODO (GNOME/Windows) find panel should retain focus after a find
-# TODO (Mac OS X) hide panel after success, but stay if the find was unsuccessful
+proc ::dialog_find::get_history {direction} {
+ variable find_history
+ variable history_position
+
+ incr history_position $direction
+ if {$history_position < 0} {set history_position 0}
+ if {$history_position > [llength $find_history]} {
+ set history_position [llength $find_history]
+ }
+ .find.entry delete 0 end
+ .find.entry insert 0 [lindex $find_history end-[expr $history_position - 1]]
+}
+# mytoplevel isn't used here, but is kept for compatibility with other dialog ok procs
proc ::dialog_find::ok {mytoplevel} {
+ variable find_in_window
variable wholeword_button
variable previous_wholeword_button
variable previous_findstring
- # find will be on top, so use the previous window that was on top
- set search_window [lindex [wm stackorder .] end-1]
- puts "search_window $search_window"
+ variable find_history
+
set findstring [.find.entry get]
- if {$findstring eq ""} {return}
- if {$search_window eq ".pdwindow"} {
- set matches [.pdwindow.text search -all -nocase -- $findstring 0.0]
+ if {$findstring eq ""} {
+ if {$::windowingsystem eq "aqua"} {bell}
+ return
+ }
+ if {$find_in_window eq ".pdwindow"} {
+ if {$::tcl_version < 8.5} {
+ # TODO implement in 8.4 style, without -all
+ set matches [.pdwindow.text search -nocase -- $findstring 0.0]
+ } else {
+ set matches [.pdwindow.text search -all -nocase -- $findstring 0.0]
+ }
.pdwindow.text tag delete sel
- foreach match $matches {
- .pdwindow.text tag add sel $match "$match wordend"
+ if {[llength $matches] > 0} {
+ foreach match $matches {
+ .pdwindow.text tag add sel $match "$match wordend"
+ }
+ .pdwindow.text see [lindex $matches 0]
+ lappend find_history $findstring
}
- .pdwindow.text see [lindex $matches 0]
} else {
if {$findstring eq $previous_findstring \
&& $wholeword_button == $previous_wholeword_button} {
- pdsend "$search_window findagain"
+ pdsend "$find_in_window findagain"
} else {
- # TODO switch back to this for 0.43:
- #pdsend "$search_window find $findstring $wholeword_button"
- pdsend "$search_window find $findstring"
+ pdsend [concat $find_in_window find [pdtk_encodedialog $findstring] \
+ $wholeword_button]
set previous_findstring $findstring
set previous_wholeword_button $wholeword_button
+ lappend find_history $findstring
}
}
+ if {$::windowingsystem eq "aqua"} {
+ # (Mac OS X) hide panel after success, but keep it if unsuccessful by
+ # having the couldnotfind proc reopen it
+ cancel $mytoplevel
+ } else {
+ # (GNOME/Windows) find panel should retain focus after a find
+ # (yes, a bit of a kludge)
+ after 100 "raise .find; focus .find.entry"
+ }
}
+# mytoplevel isn't used here, but is kept for compatibility with other dialog cancel procs
proc ::dialog_find::cancel {mytoplevel} {
wm withdraw .find
}
-proc ::dialog_find::set_canvas_to_search {mytoplevel} {
- # TODO rewrite using global $::focused_window
+proc ::dialog_find::set_window_to_search {mytoplevel} {
+ variable find_in_window $mytoplevel
if {[winfo exists .find.frame.targetlabel]} {
- set focusedtoplevel [winfo toplevel [lindex [wm stackorder .] end]]
- if {$focusedtoplevel eq ".find"} {
- set focusedtoplevel [winfo toplevel [lindex [wm stackorder .] end-1]]
+ if {$find_in_window eq ".find"} {
+ set find_in_window [winfo toplevel [lindex [wm stackorder .] end-1]]
}
- if {$focusedtoplevel eq ".pdwindow"} {
- .find.frame.targetlabel configure -text [wm title .pdwindow]
- } else {
- foreach window $::menu_windowlist {
- if {[lindex $window 1] eq $focusedtoplevel} {
- .find.frame.targetlabel configure -text [lindex $window 0]
- }
- }
+ # this has funny side effects in tcl 8.4 ???
+ if {$::tcl_version >= 8.5} {
+ wm transient .find $find_in_window
}
+ .find.frame.targetlabel configure -text \
+ [lookup_windowname $find_in_window]
}
}
+proc ::dialog_find::pdtk_couldnotfind {mytoplevel} {
+ bell
+ ::pdwindow::error [format [_ "Couldn't find '%s' in %s"] \
+ [.find.entry get] [lookup_windowname $mytoplevel] ]
+ if {$::windowingsystem eq "aqua"} {open_find_dialog $mytoplevel}
+}
+
# the find panel is opened from the menu and key bindings
-proc ::dialog_find::menu_find_dialog {mytoplevel} {
+proc ::dialog_find::open_find_dialog {mytoplevel} {
if {[winfo exists .find]} {
wm deiconify .find
raise .find
} else {
create_dialog $mytoplevel
}
+ .find.entry selection range 0 end
}
proc ::dialog_find::create_dialog {mytoplevel} {
toplevel .find -class DialogWindow
wm title .find [_ "Find"]
wm geometry .find =475x125+150+150
- .find configure
- if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
+ wm group .find .
+ wm resizable .find 0 0
+ wm transient .find
+ .find configure -menu $::dialog_menubar
+ .find configure -padx 10 -pady 5
::pd_bindings::dialog_bindings .find "find"
+ # sending these commands to the Find Dialog Panel should forward them to
+ # the currently focused patch
+ bind .find <$::modifier-Key-s> \
+ {menu_send $::focused_window menusave; break}
+ bind .find <$::modifier-Shift-Key-S> \
+ {menu_send $::focused_window menusaveas; break}
+ bind .find <$::modifier-Key-p> \
+ {menu_print $::focused_window; break}
frame .find.frame
pack .find.frame -side top -fill x -pady 1
label .find.frame.searchin -text [_ "Search in"]
- label .find.frame.targetlabel -font "TkTextFont 14"
+ label .find.frame.targetlabel -text [_ "Pd window"]
label .find.frame.for -text [_ "for:"]
pack .find.frame.searchin .find.frame.targetlabel .find.frame.for -side left
entry .find.entry -width 54 -font 18 -relief sunken \
- -highlightthickness 3 -highlightcolor blue
- focus .find.entry
+ -highlightthickness 1 -highlightcolor blue
pack .find.entry -side top -padx 10
+
+ bind .find.entry <Up> "::dialog_find::get_history 1"
+ bind .find.entry <Down> "::dialog_find::get_history -1"
checkbutton .find.wholeword -variable ::dialog_find::wholeword_button \
-text [_ "Match whole word only"] -anchor w
pack .find.wholeword -side top -padx 30 -pady 3 -fill x
frame .find.buttonframe -background yellow
+ pack .find.buttonframe -side right -pady 3
+ if {$::windowingsystem eq "win32"} {
+ button .find.cancel -text [_ "Cancel"] -default normal -width 9 \
+ -command "::dialog_find::cancel $mytoplevel"
+ pack .find.cancel -side right -padx 6 -pady 3
+ }
button .find.button -text [_ "Find"] -default active -width 9 \
-command "::dialog_find::ok $mytoplevel"
+ pack .find.button -side right -padx 6 -pady 3
if {$::windowingsystem eq "x11"} {
button .find.close -text [_ "Close"] -default normal -width 9 \
-command "::dialog_find::cancel $mytoplevel"
- pack .find.buttonframe .find.button .find.close -side right -padx 10 -pady 3
- } else {
- pack .find.buttonframe .find.button -side right -padx 10 -pady 3
+ pack .find.close -side right -padx 6 -pady 3
}
- ::dialog_find::set_canvas_to_search $mytoplevel
+ # on Mac OS X, the buttons shouldn't get Tab/keyboard focus
+ if {$::windowingsystem eq "aqua"} {
+ .find.wholeword configure -takefocus 0
+ .find.button configure -takefocus 0
+ }
+ ::dialog_find::set_window_to_search $mytoplevel
+ focus .find.entry
}
diff --git a/pd/tcl/dialog_font.tcl b/pd/tcl/dialog_font.tcl
index 578d155e..fce16000 100644
--- a/pd/tcl/dialog_font.tcl
+++ b/pd/tcl/dialog_font.tcl
@@ -7,17 +7,17 @@ namespace eval ::dialog_font:: {
variable whichstretch 1
variable canvaswindow
variable sizes {8 10 12 16 24 36}
- variable gfxstub
namespace export pdtk_canvas_dofont
}
# TODO this should use the pd_font_$size fonts created in pd-gui.tcl
+# TODO change pdtk_canvas_dofont to pdtk_font_dialog here and g_editor.c
# TODO this should really be changed on the C side so that it doesn't have to
# work around gfxstub/x_gui.c. The gfxstub stuff assumes that there are
# multiple panels, for properties panels like this, its much easier to use if
-# there is a single properties panel that adjusts based on which CanvasWindow
+# there is a single properties panel that adjusts based on which PatchWindow
# has focus
proc ::dialog_font::apply {mytoplevel myfontsize} {
@@ -30,44 +30,41 @@ proc ::dialog_font::apply {mytoplevel myfontsize} {
}
}
-proc ::dialog_font::cancel {mygfxstub} {
- if {$mygfxstub ne ".pdwindow"} {
- pdsend "$mygfxstub cancel"
+proc ::dialog_font::cancel {gfxstub} {
+ if {$gfxstub ne ".pdwindow"} {
+ pdsend "$gfxstub cancel"
}
destroy .font
}
-proc ::dialog_font::ok {mygfxstub} {
+proc ::dialog_font::ok {gfxstub} {
variable fontsize
- ::dialog_font::apply $mygfxstub $fontsize
- ::dialog_font::cancel $mygfxstub
+ apply $gfxstub $fontsize
+ cancel $gfxstub
}
proc ::dialog_font::update_font_dialog {mytoplevel} {
- set ::dialog_font::canvaswindow $mytoplevel
- if {$mytoplevel eq ".pdwindow"} {
- set windowname [_ "Pd window"]
- } else {
- set windowname [lookup_windowname $mytoplevel]
- }
+ variable canvaswindow $mytoplevel
if {[winfo exists .font]} {
- wm title .font [format [_ "%s Font"] $windowname]
+ wm title .font [format [_ "%s Font"] [lookup_windowname $mytoplevel]]
}
}
proc ::dialog_font::arrow_fontchange {change} {
variable sizes
- set position [expr [lsearch $sizes $::dialog_font::fontsize] + $change]
+ variable fontsize
+ variable canvaswindow
+ set position [expr [lsearch $sizes $fontsize] + $change]
if {$position < 0} {set position 0}
set max [llength $sizes]
if {$position >= $max} {set position [expr $max-1]}
- set ::dialog_font::fontsize [lindex $sizes $position]
- ::dialog_font::apply $::dialog_font::canvaswindow $::dialog_font::fontsize
+ set fontsize [lindex $sizes $position]
+ ::dialog_font::apply $canvaswindow $fontsize
}
# this should be called pdtk_font_dialog like the rest of the panels, but it
# is called from the C side, so we'll leave it be
-proc ::dialog_font::pdtk_canvas_dofont {mygfxstub initsize} {
+proc ::dialog_font::pdtk_canvas_dofont {gfxstub initsize} {
variable fontsize $initsize
variable whichstretch 1
variable stretchval 100
@@ -77,28 +74,34 @@ proc ::dialog_font::pdtk_canvas_dofont {mygfxstub initsize} {
# the gfxstub stuff expects multiple font windows, we only have one,
# so kill the new gfxstub requests as the come in. We'll save the
# original gfxstub for when the font panel gets closed
- pdsend "$mygfxstub cancel"
+ pdsend "$gfxstub cancel"
} else {
- create_dialog $mygfxstub
+ create_dialog $gfxstub
}
}
-proc ::dialog_font::create_dialog {mygfxstub} {
- variable gfxstub $mygfxstub
+proc ::dialog_font::create_dialog {gfxstub} {
toplevel .font -class DialogWindow
- if {$::windowingsystem eq "aqua"} {.font configure -menu .menubar}
+ .font configure -menu $::dialog_menubar
+ .font configure -padx 10 -pady 5
+ wm group .font .
+ wm resizable .font 0 0
+ wm transient .font $::focused_window
::pd_bindings::dialog_bindings .font "font"
- # replace standard bindings to work around the gfxstub stuff
- bind .font <KeyPress-Escape> "::dialog_font::cancel $mygfxstub"
- bind .font <KeyPress-Return> "::dialog_font::ok $mygfxstub"
- bind .font <$::pd_bindings::modifier-Key-w> "::dialog_font::cancel $mygfxstub"
+ # replace standard bindings to work around the gfxstub stuff and use
+ # break to prevent the close window command from going to other bindings.
+ # .font won't exist anymore, so it'll cause errors down the line...
+ bind .font <KeyPress-Return> "::dialog_font::ok $gfxstub; break"
+ bind .font <KeyPress-Escape> "::dialog_font::cancel $gfxstub; break"
+ bind .font <$::modifier-Key-w> "::dialog_font::cancel $gfxstub; break"
+ wm protocol .font WM_DELETE_WINDOW "dialog_font::cancel $gfxstub"
bind .font <Up> "::dialog_font::arrow_fontchange -1"
bind .font <Down> "::dialog_font::arrow_fontchange 1"
frame .font.buttonframe
pack .font.buttonframe -side bottom -fill x -pady 2m
button .font.buttonframe.ok -text [_ "OK"] \
- -command "::dialog_font::ok $mygfxstub"
+ -command "::dialog_font::ok $gfxstub"
pack .font.buttonframe.ok -side left -expand 1
labelframe .font.fontsize -text [_ "Font Size"] -padx 5 -pady 4 -borderwidth 1 \
diff --git a/pd/tcl/dialog_gatom.tcl b/pd/tcl/dialog_gatom.tcl
index b59751bf..200a631e 100644
--- a/pd/tcl/dialog_gatom.tcl
+++ b/pd/tcl/dialog_gatom.tcl
@@ -44,8 +44,8 @@ proc ::dialog_gatom::apply {mytoplevel} {
[$mytoplevel.limits.upper.entry get] \
[::dialog_gatom::escape [$mytoplevel.gatomlabel.name.entry get]] \
$gatomlabel_radio($mytoplevel) \
- [::dialog_gatom::escape [$mytoplevel.s_r.send.entry get]] \
- [::dialog_gatom::escape [$mytoplevel.s_r.receive.entry get]]"
+ [::dialog_gatom::escape [$mytoplevel.s_r.receive.entry get]] \
+ [::dialog_gatom::escape [$mytoplevel.s_r.send.entry get]]"
}
proc ::dialog_gatom::cancel {mytoplevel} {
@@ -60,7 +60,7 @@ proc ::dialog_gatom::ok {mytoplevel} {
# set up the panel with the info from pd
proc ::dialog_gatom::pdtk_gatom_dialog {mytoplevel initwidth initlower initupper \
initgatomlabel_radio \
- initgatomlabel initsend initreceive} {
+ initgatomlabel initreceive initsend} {
global gatomlabel_radio
set gatomlabel_radio($mytoplevel) $initgatomlabel_radio
@@ -91,7 +91,11 @@ proc ::dialog_gatom::create_dialog {mytoplevel} {
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Atom Box Properties"]
- if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
+ wm group $mytoplevel .
+ wm resizable $mytoplevel 0 0
+ wm transient $mytoplevel $::focused_window
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "gatom"
frame $mytoplevel.width -height 7
@@ -149,16 +153,18 @@ proc ::dialog_gatom::create_dialog {mytoplevel} {
pack $mytoplevel.s_r.receive.entry $mytoplevel.s_r.receive.label -side right
frame $mytoplevel.buttonframe -pady 5
- pack $mytoplevel.buttonframe -side top -fill x -pady 2m
+ pack $mytoplevel.buttonframe -side top -fill x -expand 1 -pady 2m
button $mytoplevel.buttonframe.cancel -text [_ "Cancel"] \
-command "::dialog_gatom::cancel $mytoplevel"
- pack $mytoplevel.buttonframe.cancel -side left -expand 1
- button $mytoplevel.buttonframe.apply -text [_ "Apply"] \
- -command "::dialog_gatom::apply $mytoplevel"
- pack $mytoplevel.buttonframe.apply -side left -expand 1
+ pack $mytoplevel.buttonframe.cancel -side left -expand 1 -fill x -padx 10
+ if {$::windowingsystem ne "aqua"} {
+ button $mytoplevel.buttonframe.apply -text [_ "Apply"] \
+ -command "::dialog_gatom::apply $mytoplevel"
+ pack $mytoplevel.buttonframe.apply -side left -expand 1 -fill x -padx 10
+ }
button $mytoplevel.buttonframe.ok -text [_ "OK"] \
-command "::dialog_gatom::ok $mytoplevel"
- pack $mytoplevel.buttonframe.ok -side left -expand 1
+ pack $mytoplevel.buttonframe.ok -side left -expand 1 -fill x -padx 10
$mytoplevel.width.entry select from 0
$mytoplevel.width.entry select adjust end
diff --git a/pd/tcl/dialog_iemgui.tcl b/pd/tcl/dialog_iemgui.tcl
index 34ed4ccb..ed3a60bf 100644
--- a/pd/tcl/dialog_iemgui.tcl
+++ b/pd/tcl/dialog_iemgui.tcl
@@ -252,7 +252,7 @@ proc ::dialog_iemgui::toggle_font {mytoplevel gn_f} {
1 { set current_font "Helvetica" }
2 { set current_font "Times" }
}
- set current_font_spec "{$current_font} 12 $::font_weight"
+ set current_font_spec "{$current_font} 16 $::font_weight"
$mytoplevel.label.fontpopup_label configure -text $current_font \
-font $current_font_spec
@@ -362,7 +362,11 @@ proc ::dialog_iemgui::apply {mytoplevel} {
set hhhsnd [unspace_text $hhhsnd]
set hhhrcv [unspace_text $hhhrcv]
set hhhgui_nam [unspace_text $hhhgui_nam]
-
+
+# make sure the offset boxes have a value
+ if {[eval concat $$var_iemgui_gn_dx] eq ""} {set $var_iemgui_gn_dx 0}
+ if {[eval concat $$var_iemgui_gn_dy] eq ""} {set $var_iemgui_gn_dy 0}
+
pdsend [concat $mytoplevel dialog \
[eval concat $$var_iemgui_wdt] \
[eval concat $$var_iemgui_hgt] \
@@ -496,12 +500,16 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [format [_ "%s Properties"] $mainheader]
- if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
+ wm group $mytoplevel .
+ wm resizable $mytoplevel 0 0
+ wm transient $mytoplevel $::focused_window
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "iemgui"
frame $mytoplevel.dim
pack $mytoplevel.dim -side top
- label $mytoplevel.dim.head -text $dim_header
+ label $mytoplevel.dim.head -text [_ $dim_header]
label $mytoplevel.dim.w_lab -text [_ $wdt_label] -width 6
entry $mytoplevel.dim.w_ent -textvariable $var_iemgui_wdt -width 5
label $mytoplevel.dim.dummy1 -text " " -width 10
@@ -514,7 +522,7 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
frame $mytoplevel.rng
pack $mytoplevel.rng -side top
- label $mytoplevel.rng.head -text $rng_header
+ label $mytoplevel.rng.head -text [_ $rng_header]
label $mytoplevel.rng.min_lab -text [_ $min_rng_label] -width 6
entry $mytoplevel.rng.min_ent -textvariable $var_iemgui_min_rng -width 9
label $mytoplevel.rng.dummy1 -text " " -width 1
@@ -544,21 +552,19 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
-command "::dialog_iemgui::lilo $mytoplevel" }
if {[eval concat $$var_iemgui_loadbang] == 0} {
button $mytoplevel.para.lb -text [_ "No init"] \
- -width [::msgcat::mcmax "No init"] \
-command "::dialog_iemgui::lb $mytoplevel" }
if {[eval concat $$var_iemgui_loadbang] == 1} {
button $mytoplevel.para.lb -text [_ "Save"] \
- -width [::msgcat::mcmax "Save"] \
-command "::dialog_iemgui::lb $mytoplevel" }
label $mytoplevel.para.num_lab -text [_ $num_label] -width 9
entry $mytoplevel.para.num_ent -textvariable $var_iemgui_num -width 4
if {[eval concat $$var_iemgui_steady] == 0} {
button $mytoplevel.para.stdy_jmp -command "::dialog_iemgui::stdy_jmp $mytoplevel" \
- -text [_ "Jump on click"] -width [::msgcat::mcmax "Jump on click"] }
+ -text [_ "Jump on click"] }
if {[eval concat $$var_iemgui_steady] == 1} {
button $mytoplevel.para.stdy_jmp -command "::dialog_iemgui::stdy_jmp $mytoplevel" \
- -text [_ "Steady on click"] -width [::msgcat::mcmax "Steady on click"] }
+ -text [_ "Steady on click"] }
if {[eval concat $$var_iemgui_lin0_log1] >= 0} {
pack $mytoplevel.para.lilo -side left -expand 1}
if {[eval concat $$var_iemgui_loadbang] >= 0} {
@@ -574,18 +580,22 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
labelframe $mytoplevel.s_r -borderwidth 1 -pady 4 -text [_ "Messages"]
pack $mytoplevel.s_r -side top -fill x -ipadx 5
frame $mytoplevel.s_r.send
- pack $mytoplevel.s_r.send -side top
- label $mytoplevel.s_r.send.lab -text [_ "Send symbol:"] -width 12 -justify right
+ pack $mytoplevel.s_r.send -side top -padx 4 -fill x -expand 1
+ label $mytoplevel.s_r.send.lab -text [_ "Send symbol:"] -justify left
entry $mytoplevel.s_r.send.ent -textvariable $var_iemgui_snd -width 22
if { $snd ne "nosndno" } {
- pack $mytoplevel.s_r.send.lab $mytoplevel.s_r.send.ent -side left}
+ pack $mytoplevel.s_r.send.lab $mytoplevel.s_r.send.ent -side left \
+ -fill x -expand 1
+ }
frame $mytoplevel.s_r.receive
- pack $mytoplevel.s_r.receive -side top
- label $mytoplevel.s_r.receive.lab -text [_ "Receive symbol:"] -width 12 -justify right
+ pack $mytoplevel.s_r.receive -side top -padx 4 -fill x -expand 1
+ label $mytoplevel.s_r.receive.lab -text [_ "Receive symbol:"] -justify left
entry $mytoplevel.s_r.receive.ent -textvariable $var_iemgui_rcv -width 22
if { $rcv ne "norcvno" } {
- pack $mytoplevel.s_r.receive.lab $mytoplevel.s_r.receive.ent -side left}
+ pack $mytoplevel.s_r.receive.lab $mytoplevel.s_r.receive.ent -side left \
+ -fill x -expand 1
+ }
# get the current font name from the int given from C-space (gn_f)
set current_font $::font_family
@@ -599,42 +609,40 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
labelframe $mytoplevel.label -borderwidth 1 -text [_ "Label"] -pady 4
pack $mytoplevel.label -side top -fill x
- entry $mytoplevel.label.name_entry -textvariable $var_iemgui_gui_nam -width 30 \
- -font [list $current_font 12 $::font_weight]
+ entry $mytoplevel.label.name_entry -textvariable $var_iemgui_gui_nam \
+ -width 30 -font [list $current_font 12 $::font_weight]
pack $mytoplevel.label.name_entry -side top -expand yes -fill both -padx 5
frame $mytoplevel.label.xy -padx 27 -pady 1
pack $mytoplevel.label.xy -side top
- label $mytoplevel.label.xy.x_lab -text [_ "X offset"] \
- -width [::msgcat::mcmax "X offset"]
+ label $mytoplevel.label.xy.x_lab -text [_ "X offset"]
entry $mytoplevel.label.xy.x_entry -textvariable $var_iemgui_gn_dx -width 5
label $mytoplevel.label.xy.dummy1 -text " " -width 2
- label $mytoplevel.label.xy.y_lab -text [_ "Y offset"] \
- -width [::msgcat::mcmax "Y offset"]
+ label $mytoplevel.label.xy.y_lab -text [_ "Y offset"]
entry $mytoplevel.label.xy.y_entry -textvariable $var_iemgui_gn_dy -width 5
pack $mytoplevel.label.xy.x_lab $mytoplevel.label.xy.x_entry $mytoplevel.label.xy.dummy1 \
$mytoplevel.label.xy.y_lab $mytoplevel.label.xy.y_entry -side left -anchor e
- label $mytoplevel.label.fontpopup_label -text $current_font \
- -relief groove -font [list $current_font 12 $::font_weight] -padx 5
- pack $mytoplevel.label.fontpopup_label -side left -anchor w -expand yes -fill x
- label $mytoplevel.label.fontsize_label -text [_ "Size:"] \
- -width [::msgcat::mcmax "Size:"]
+ button $mytoplevel.label.fontpopup_label -text $current_font \
+ -font [list $current_font 16 $::font_weight]
+ pack $mytoplevel.label.fontpopup_label -side left -anchor w \
+ -expand 1 -fill x -padx 5
+ label $mytoplevel.label.fontsize_label -text [_ "Size:"]
entry $mytoplevel.label.fontsize_entry -textvariable $var_iemgui_gn_fs -width 5
pack $mytoplevel.label.fontsize_entry $mytoplevel.label.fontsize_label \
-side right -anchor e -padx 5 -pady 5
menu $mytoplevel.popup
$mytoplevel.popup add command \
-label $::font_family \
- -font [format {{%s} 12 %s} $::font_family $::font_weight] \
+ -font [format {{%s} 16 %s} $::font_family $::font_weight] \
-command "::dialog_iemgui::toggle_font $mytoplevel 0"
$mytoplevel.popup add command \
-label "Helvetica" \
- -font [format {Helvetica 12 %s} $::font_weight] \
+ -font [format {Helvetica 16 %s} $::font_weight] \
-command "::dialog_iemgui::toggle_font $mytoplevel 1"
$mytoplevel.popup add command \
-label "Times" \
- -font [format {Times 12 %s} $::font_weight] \
+ -font [format {Times 16 %s} $::font_weight] \
-command "::dialog_iemgui::toggle_font $mytoplevel 2"
bind $mytoplevel.label.fontpopup_label <Button> \
[list tk_popup $mytoplevel.popup %X %Y]
@@ -648,14 +656,11 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
frame $mytoplevel.colors.select
pack $mytoplevel.colors.select -side top
radiobutton $mytoplevel.colors.select.radio0 -value 0 -variable \
- $var_iemgui_l2_f1_b0 -text [_ "Background"] -justify left \
- -width [::msgcat::mcmax "Background"]
+ $var_iemgui_l2_f1_b0 -text [_ "Background"] -justify left
radiobutton $mytoplevel.colors.select.radio1 -value 1 -variable \
- $var_iemgui_l2_f1_b0 -text [_ "Front"] -justify left \
- -width [::msgcat::mcmax "Front"]
+ $var_iemgui_l2_f1_b0 -text [_ "Front"] -justify left
radiobutton $mytoplevel.colors.select.radio2 -value 2 -variable \
- $var_iemgui_l2_f1_b0 -text [_ "Label"] -justify left \
- -width [::msgcat::mcmax "Label"]
+ $var_iemgui_l2_f1_b0 -text [_ "Label"] -justify left
if { [eval concat $$var_iemgui_fcol] >= 0 } {
pack $mytoplevel.colors.select.radio0 $mytoplevel.colors.select.radio1 \
$mytoplevel.colors.select.radio2 -side left
@@ -666,7 +671,6 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
frame $mytoplevel.colors.sections
pack $mytoplevel.colors.sections -side top
button $mytoplevel.colors.sections.but -text [_ "Compose color"] \
- -width [::msgcat::mcmax "Compose color"] \
-command "::dialog_iemgui::choose_col_bkfrlb $mytoplevel"
pack $mytoplevel.colors.sections.but -side left -anchor w -padx 10 -pady 5 \
-expand yes -fill x
@@ -686,7 +690,6 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
-font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
}
label $mytoplevel.colors.sections.lb_bk -text [_ "Test label"] \
- -width [::msgcat::mcmax "Test label"] \
-background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \
@@ -744,26 +747,18 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
$mytoplevel.colors.r3.c8 $mytoplevel.colors.r3.c9 -side left
frame $mytoplevel.cao -pady 10
- pack $mytoplevel.cao -side top
- button $mytoplevel.cao.cancel -text [_ "Cancel"] -width 6 \
+ pack $mytoplevel.cao -side top -expand 1 -fill x
+ button $mytoplevel.cao.cancel -text [_ "Cancel"] \
-command "::dialog_iemgui::cancel $mytoplevel"
- label $mytoplevel.cao.dummy1 -text "" -width 3
- button $mytoplevel.cao.apply -text [_ "Apply"] -width 6 \
- -command "::dialog_iemgui::apply $mytoplevel"
- label $mytoplevel.cao.dummy2 -text "" -width 3
- button $mytoplevel.cao.ok -text [_ "OK"] -width 6 \
- -command "::dialog_iemgui::ok $mytoplevel"
- pack $mytoplevel.cao.cancel $mytoplevel.cao.dummy1 -side left
- pack $mytoplevel.cao.apply $mytoplevel.cao.dummy2 -side left
- pack $mytoplevel.cao.ok -side left
-
- if {[info tclversion] < 8.4} {
- bind $mytoplevel <Key-Tab> {tkTabToWindow [tk_focusNext %W]}
- bind $mytoplevel <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]}
- } else {
- bind $mytoplevel <Key-Tab> {tk::TabToWindow [tk_focusNext %W]}
- bind $mytoplevel <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}
+ pack $mytoplevel.cao.cancel -side left -padx 10 -expand 1 -fill x
+ if {$::windowingsystem ne "aqua"} {
+ button $mytoplevel.cao.apply -text [_ "Apply"] \
+ -command "::dialog_iemgui::apply $mytoplevel"
+ pack $mytoplevel.cao.apply -side left -padx 10 -expand 1 -fill x
}
+ button $mytoplevel.cao.ok -text [_ "OK"] \
+ -command "::dialog_iemgui::ok $mytoplevel"
+ pack $mytoplevel.cao.ok -side left -padx 10 -expand 1 -fill x
$mytoplevel.dim.w_ent select from 0
$mytoplevel.dim.w_ent select adjust end
diff --git a/pd/tcl/dialog_message.tcl b/pd/tcl/dialog_message.tcl
new file mode 100644
index 00000000..107f1095
--- /dev/null
+++ b/pd/tcl/dialog_message.tcl
@@ -0,0 +1,85 @@
+# the message dialog panel is a bit unusual in that it is created directly by
+# the Tcl 'pd-gui'. Most dialog panels are created by sending a message to
+# 'pd', which then sends a message to 'pd-gui' to create the panel. This is
+# similar to the Find dialog panel.
+
+package provide dialog_message 0.1
+
+package require pd_bindings
+
+namespace eval ::dialog_message:: {
+ variable message_history {"pd dsp 1"}
+ variable history_position 0
+
+ namespace export open_message_dialog
+}
+
+proc ::dialog_message::get_history {direction} {
+ variable message_history
+ variable history_position
+
+ incr history_position $direction
+ if {$history_position < 0} {set history_position 0}
+ if {$history_position > [llength $message_history]} {
+ set history_position [llength $message_history]
+ }
+ .message.f.entry delete 0 end
+ .message.f.entry insert 0 \
+ [lindex $message_history end-[expr $history_position - 1]]
+}
+
+# mytoplevel isn't used here, but is kept for compatibility with other dialog ok procs
+proc ::dialog_message::ok {mytoplevel} {
+ variable message_history
+ set message [.message.f.entry get]
+ if {$message ne ""} {
+ pdsend $message
+ lappend message_history $message
+ .message.f.entry delete 0 end
+ }
+}
+
+# mytoplevel isn't used here, but is kept for compatibility with other dialog cancel procs
+proc ::dialog_message::cancel {mytoplevel} {
+ wm withdraw .message
+}
+
+# the message panel is opened from the menu and key bindings
+proc ::dialog_message::open_message_dialog {mytoplevel} {
+ if {[winfo exists .message]} {
+ wm deiconify .message
+ raise .message
+ } else {
+ create_dialog $mytoplevel
+ }
+}
+
+proc ::dialog_message::create_dialog {mytoplevel} {
+ toplevel .message -class DialogWindow
+ wm group .message .
+ wm transient .message
+ wm title .message [_ "Send a Pd message"]
+ wm geometry .message =400x80+150+150
+ wm resizable .message 1 0
+ wm minsize .message 250 80
+ .message configure -menu $::dialog_menubar
+ .message configure -padx 10 -pady 5
+ ::pd_bindings::dialog_bindings .message "message"
+ # not all Tcl/Tk versions or platforms support -topmost, so catch the error
+ catch {wm attributes $id -topmost 1}
+
+ # TODO this should use something like 'dialogfont' for the font
+ frame .message.f
+ pack .message.f -side top -fill x -expand 1
+ entry .message.f.entry -width 54 -font {Helvetica 18} -relief sunken \
+ -highlightthickness 1 -highlightcolor blue
+ label .message.f.semicolon -text ";" -font {Helvetica 24}
+ pack .message.f.semicolon -side left
+ pack .message.f.entry -side left -padx 10 -fill x -expand 1
+ focus .message.f.entry
+ label .message.label -text [_ "(use arrow keys for history)"]
+ pack .message.label -side bottom
+
+ bind .message.f.entry <Up> "::dialog_message::get_history 1"
+ bind .message.f.entry <Down> "::dialog_message::get_history -1"
+}
diff --git a/pd/tcl/dialog_midi.tcl b/pd/tcl/dialog_midi.tcl
index d8554665..450d2938 100644
--- a/pd/tcl/dialog_midi.tcl
+++ b/pd/tcl/dialog_midi.tcl
@@ -2,6 +2,7 @@ package provide dialog_midi 0.1
namespace eval ::dialog_midi:: {
namespace export pdtk_midi_dialog
+ namespace export pdtk_alsa_midi_dialog
}
# TODO this panel really needs some reworking, it works but the code is
@@ -81,10 +82,16 @@ proc ::dialog_midi::pdtk_midi_dialog {id indev1 indev2 indev3 indev4 \
set midi_alsain [llength $midi_indevlist]
set midi_alsaout [llength $midi_outdevlist]
- toplevel $id
+ toplevel $id -class DialogWindow
wm title $id [_ "MIDI Settings"]
- if {$::windowingsystem eq "aqua"} {$id configure -menu .menubar}
+ wm group $id .
+ wm resizable $id 0 0
+ wm transient $id
+ $id configure -menu $::dialog_menubar
+ $id configure -padx 10 -pady 5
::pd_bindings::dialog_bindings $id "midi"
+ # not all Tcl/Tk versions or platforms support -topmost, so catch the error
+ catch {wm attributes $id -topmost 1}
frame $id.buttonframe
pack $id.buttonframe -side bottom -fill x -pady 2m
@@ -165,7 +172,7 @@ proc ::dialog_midi::pdtk_midi_dialog {id indev1 indev2 indev3 indev4 \
}
# output device 3
- if {$longform && [llength $midi_midi_outdevlist] > 3} {
+ if {$longform && [llength $midi_outdevlist] > 3} {
frame $id.out3f
pack $id.out3f -side top
label $id.out3f.l1 -text [_ "Output device 3:"]
@@ -176,7 +183,7 @@ proc ::dialog_midi::pdtk_midi_dialog {id indev1 indev2 indev3 indev4 \
}
# output device 4
- if {$longform && [llength $midi_midi_outdevlist] > 4} {
+ if {$longform && [llength $midi_outdevlist] > 4} {
frame $id.out4f
pack $id.out4f -side top
label $id.out4f.l1 -text [_ "Output device 4:"]
diff --git a/pd/tcl/dialog_path.tcl b/pd/tcl/dialog_path.tcl
new file mode 100644
index 00000000..40a306ba
--- /dev/null
+++ b/pd/tcl/dialog_path.tcl
@@ -0,0 +1,70 @@
+
+package provide dialog_path 0.1
+
+namespace eval ::dialog_path:: {
+ variable use_standard_extensions_button 1
+ variable verbose_button 0
+
+ namespace export pdtk_path_dialog
+}
+
+############ pdtk_path_dialog -- run a path dialog #########
+
+# set up the panel with the info from pd
+proc ::dialog_path::pdtk_path_dialog {mytoplevel extrapath verbose} {
+ global use_standard_extensions_button
+ global verbose_button
+ set use_standard_extensions_button $extrapath
+ set verbose_button $verbose
+
+ if {[winfo exists $mytoplevel]} {
+ wm deiconify $mytoplevel
+ raise $mytoplevel
+ } else {
+ create_dialog $mytoplevel
+ }
+}
+
+proc ::dialog_path::create_dialog {mytoplevel} {
+
+ scrollboxwindow::make $mytoplevel $::sys_searchpath \
+ dialog_path::add dialog_path::edit dialog_path::commit \
+ [_ "Pd search path for objects, help, fonts, and other files"] \
+ 400 300
+
+ frame $mytoplevel.extraframe
+ pack $mytoplevel.extraframe -side bottom -pady 2m
+ checkbutton $mytoplevel.extraframe.extra -text [_ "Use standard extensions"] \
+ -variable use_standard_extensions_button -anchor w
+ checkbutton $mytoplevel.extraframe.verbose -text [_ "Verbose"] \
+ -variable verbose_button -anchor w
+ pack $mytoplevel.extraframe.extra $mytoplevel.extraframe.verbose \
+ -side left -expand 1
+}
+
+
+
+############ pdtk_path_dialog -- dialog window for search path #########
+proc ::dialog_path::choosePath { currentpath title } {
+ if {$currentpath == ""} {
+ set currentpath "~"
+ }
+ return [tk_chooseDirectory -initialdir $currentpath -title $title]
+}
+
+proc ::dialog_path::add {} {
+ return [::dialog_path::choosePath "" {Add a new path}]
+}
+
+proc ::dialog_path::edit { currentpath } {
+ return [::dialog_path::choosePath $currentpath "Edit existing path \[$currentpath\]"]
+}
+
+proc ::dialog_path::commit { new_path } {
+ global use_standard_extensions_button
+ global verbose_button
+
+ set ::sys_searchpath $new_path
+ pdsend "pd path-dialog $use_standard_extensions_button $verbose_button $::sys_searchpath"
+}
+
diff --git a/pd/tcl/dialog_startup.tcl b/pd/tcl/dialog_startup.tcl
new file mode 100644
index 00000000..52c5f647
--- /dev/null
+++ b/pd/tcl/dialog_startup.tcl
@@ -0,0 +1,96 @@
+
+package provide dialog_startup 0.1
+
+package require scrollboxwindow
+
+namespace eval dialog_startup {
+ variable defeatrt_flag 0
+
+ namespace export pdtk_startup_dialog
+}
+
+########## pdtk_startup_dialog -- dialog window for startup options #########
+# Create a simple modal window with an entry widget
+# for editing/adding a startup command
+# (the next-best-thing to in-place editing)
+proc ::dialog_startup::chooseCommand { prompt initialValue } {
+ global cmd
+ set cmd $initialValue
+
+ toplevel .inputbox
+ wm title .inputbox $prompt
+ wm group .inputbox .
+ wm minsize .inputbox 450 30
+ wm resizable .inputbox 0 0
+ wm geom .inputbox "450x30"
+ # not all Tcl/Tk versions or platforms support -topmost, so catch the error
+ catch {wm attributes $mytoplevel -topmost 1}
+
+ button .inputbox.button -text [_ "OK"] -command { destroy .inputbox } \
+ -width [::msgcat::mcmax [_ "OK"]]
+
+ entry .inputbox.entry -width 50 -textvariable cmd
+ pack .inputbox.button -side right
+ bind .inputbox.entry <KeyPress-Return> { destroy .inputbox }
+ bind .inputbox.entry <KeyPress-Escape> { destroy .inputbox }
+ pack .inputbox.entry -side right -expand 1 -fill x -padx 2m
+
+ focus .inputbox.entry
+
+ raise .inputbox
+ wm transient .inputbox
+ grab .inputbox
+ tkwait window .inputbox
+
+ return $cmd
+}
+
+proc ::dialog_startup::add {} {
+ return [chooseCommand [_ "Add new library"] ""]
+}
+
+proc ::dialog_startup::edit { current_library } {
+ return [chooseCommand [_ "Edit library"] $current_library]
+}
+
+proc ::dialog_startup::commit { new_startup } {
+ variable defeatrt_button
+ set ::startup_libraries $new_startup
+
+ pdsend "pd startup-dialog $defeatrt_button [pdtk_encodedialog $::startup_flags] $::startup_libraries"
+}
+
+# set up the panel with the info from pd
+proc ::dialog_startup::pdtk_startup_dialog {mytoplevel defeatrt flags} {
+ variable defeatrt_button $defeatrt
+ if {$flags ne ""} {variable ::startup_flags $flags}
+
+ if {[winfo exists $mytoplevel]} {
+ wm deiconify $mytoplevel
+ raise $mytoplevel
+ } else {
+ create_dialog $mytoplevel
+ }
+}
+
+proc ::dialog_startup::create_dialog {mytoplevel} {
+ ::scrollboxwindow::make $mytoplevel $::startup_libraries \
+ dialog_startup::add dialog_startup::edit dialog_startup::commit \
+ [_ "Pd libraries to load on startup"] \
+ 400 300
+
+ label $mytoplevel.entryname -text [_ "Startup flags:"]
+ entry $mytoplevel.entry -textvariable ::startup_flags -width 60
+ pack $mytoplevel.entryname $mytoplevel.entry -side left
+ pack $mytoplevel.entry -side right -padx 2m -fill x -expand 1
+
+ frame $mytoplevel.defeatrtframe
+ pack $mytoplevel.defeatrtframe -side bottom -fill x -pady 2m
+ if {$::windowingsystem ne "win32"} {
+ checkbutton $mytoplevel.defeatrtframe.defeatrt -anchor w \
+ -text [_ "Defeat real-time scheduling"] \
+ -variable ::dialog_startup::defeatrt_button
+ pack $mytoplevel.defeatrtframe.defeatrt -side left
+ }
+}
+
diff --git a/pd/tcl/helpbrowser.tcl b/pd/tcl/helpbrowser.tcl
new file mode 100644
index 00000000..bcec1fc5
--- /dev/null
+++ b/pd/tcl/helpbrowser.tcl
@@ -0,0 +1,272 @@
+
+package provide helpbrowser 0.1
+
+namespace eval ::helpbrowser:: {
+ variable libdirlist
+ variable helplist
+ variable reference_count
+ variable reference_paths
+ variable doctypes "*.{pd,pat,mxb,mxt,help,txt,htm,html,pdf}"
+
+ namespace export open_helpbrowser
+}
+
+# TODO remove the doc_ prefix on procs where its not needed
+# TODO rename .help_browser to .helpbrowser
+# TODO enter and up/down/left/right arrow key bindings for nav
+
+################## help browser and support functions #########################
+proc ::helpbrowser::open_helpbrowser {} {
+ if { [winfo exists .help_browser.frame] } {
+ wm deiconify .help_browser
+ raise .help_browser
+ } else {
+ toplevel .help_browser -class HelpBrowser
+ wm group .help_browser .
+ wm transient .help_browser
+ wm title .help_browser [_ "Help Browser"]
+ bind .help_browser <$::modifier-Key-w> "wm withdraw .help_browser"
+
+ if {$::windowingsystem eq "aqua"} {
+ .help_browser configure -menu $::dialog_menubar
+ }
+
+ wm resizable .help_browser 0 0
+ frame .help_browser.frame
+ pack .help_browser.frame -side top -fill both
+ build_references
+ make_rootlistbox .help_browser.frame
+ }
+}
+
+# make the root listbox of the help browser using the pre-built lists
+proc ::helpbrowser::make_rootlistbox {base} {
+ variable libdirlist
+ variable helplist
+ # exportselection 0 looks good, but selection gets easily out-of-sync
+ set current_listbox [listbox "[set b $base.root]" -yscrollcommand "$b-scroll set" \
+ -highlightbackground white -highlightthickness 5 \
+ -highlightcolor "#D6E5FC" -selectborderwidth 0 \
+ -height 20 -width 23 -exportselection 0 -bd 0]
+ pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \
+ -side left -fill both -expand 1
+ foreach item [concat [lsort [concat $libdirlist $helplist]]] {
+ $current_listbox insert end $item
+ }
+ bind $current_listbox <Button-1> \
+ [list ::helpbrowser::root_navigate %W %x %y]
+ bind $current_listbox <Key-Return> \
+ [list ::helpbrowser::root_navigate %W %x %y]
+ bind $current_listbox <Double-ButtonRelease-1> \
+ [list ::helpbrowser::root_doubleclick %W %x %y]
+ bind $current_listbox <$::modifier-Key-o> \
+ [list ::helpbrowser::root_doubleclick %W %x %y]
+}
+
+# navigate into a library/directory from the root
+proc ::helpbrowser::root_navigate {window x y} {
+ variable reference_paths
+ if {[set item [$window get [$window index "@$x,$y"]]] eq {}} {
+ return
+ }
+ set filename $reference_paths($item)
+ if {[file isdirectory $filename]} {
+ make_liblistbox [winfo parent $window] $filename
+ }
+}
+
+# double-click action to open the folder
+proc ::helpbrowser::root_doubleclick {window x y} {
+ variable reference_paths
+ if {[set listname [$window get [$window index "@$x,$y"]]] eq {}} {
+ return
+ }
+ set dir [file dirname $reference_paths($listname)]
+ set filename [file tail $reference_paths($listname)]
+ ::pdwindow::verbose 0 "menu_doc_open $dir $filename"
+ if { [catch {menu_doc_open $dir $filename} fid] } {
+ ::pdwindow::error "Could not open $dir/$filename\n"
+ }
+}
+
+# make the listbox to show the first level contents of a libdir
+proc ::helpbrowser::make_liblistbox {base dir} {
+ variable doctypes
+ catch { eval destroy [lrange [winfo children $base] 2 end] } errorMessage
+ # exportselection 0 looks good, but selection gets easily out-of-sync
+ set current_listbox [listbox "[set b $base.listbox0]" -yscrollcommand "$b-scroll set" \
+ -highlightbackground white -highlightthickness 5 \
+ -highlightcolor "#D6E5FC" -selectborderwidth 0 \
+ -height 20 -width 23 -exportselection 0 -bd 0]
+ pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \
+ -side left -fill both -expand 1
+ foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] {
+ if {[glob -directory $item -nocomplain -types {f} -- $doctypes] ne "" ||
+ [glob -directory $item -nocomplain -types {d} -- *] ne ""} {
+ $current_listbox insert end "[file tail $item]/"
+ }
+ }
+ foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
+ *-{help,meta}.pd]] {
+ $current_listbox insert end [file tail $item]
+ }
+ $current_listbox insert end "___________________________"
+ foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
+ *.txt]] {
+ $current_listbox insert end [file tail $item]
+ }
+ bind $current_listbox <Button-1> \
+ [list ::helpbrowser::dir_navigate $dir 1 %W %x %y]
+ bind $current_listbox <Double-ButtonRelease-1> \
+ [list ::helpbrowser::dir_doubleclick $dir 1 %W %x %y]
+ bind $current_listbox <Key-Return> \
+ [list ::helpbrowser::dir_doubleclick $dir 1 %W %x %y]
+}
+
+proc ::helpbrowser::doc_make_listbox {base dir count} {
+ variable doctypes
+ # check for [file readable]?
+ # requires Tcl 8.5 but probably deals with special chars better:
+ # destroy {*}[lrange [winfo children $base] [expr {2 * $count}] end]
+ if { [catch { eval destroy [lrange [winfo children $base] \
+ [expr { 2 * $count }] end] } errorMessage] } {
+ ::pdwindow::error "doc_make_listbox: error listing $dir\n"
+ }
+ # exportselection 0 looks good, but selection gets easily out-of-sync
+ set current_listbox [listbox "[set b "$base.listbox$count"]-list" \
+ -yscrollcommand "$b-scroll set" \
+ -highlightbackground white -highlightthickness 5 \
+ -highlightcolor "#D6E5FC" -selectborderwidth 0 \
+ -height 20 -width 23 -exportselection 0 -bd 0]
+ pack $current_listbox [scrollbar "$b-scroll" -command "$current_listbox yview"] \
+ -side left -fill both -expand 1
+ foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] {
+ $current_listbox insert end "[file tail $item]/"
+ }
+ foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
+ $doctypes]] {
+ $current_listbox insert end [file tail $item]
+ }
+ bind $current_listbox <Button-1> \
+ "::helpbrowser::dir_navigate {$dir} $count %W %x %y"
+ bind $current_listbox <Key-Right> \
+ "::helpbrowser::dir_navigate {$dir} $count %W %x %y"
+ bind $current_listbox <Double-ButtonRelease-1> \
+ "::helpbrowser::dir_doubleclick {$dir} $count %W %x %y"
+ bind $current_listbox <Key-Return> \
+ "::helpbrowser::dir_doubleclick {$dir} $count %W %x %y"
+}
+
+# navigate into an actual directory
+proc ::helpbrowser::dir_navigate {dir count window x y} {
+ if {[set newdir [$window get [$window index "@$x,$y"]]] eq {}} {
+ return
+ }
+ set dir_to_open [file join $dir $newdir]
+ if {[file isdirectory $dir_to_open]} {
+ doc_make_listbox [winfo parent $window] $dir_to_open [incr count]
+ }
+}
+
+proc ::helpbrowser::dir_doubleclick {dir count window x y} {
+ if {[set filename [$window get [$window index "@$x,$y"]]] eq {}} {
+ return
+ }
+ if { [catch {menu_doc_open $dir $filename} fid] } {
+ ::pdwindow::error "Could not open $dir/$filename\n"
+ }
+}
+
+proc ::helpbrowser::rightclickmenu {dir count window x y} {
+ if {[set filename [$window get [$window index "@$x,$y"]]] eq {}} {
+ return
+ }
+ if { [catch {menu_doc_open $dir $filename} fid] } {
+ ::pdwindow::error "Could not open $dir/$filename\n"
+ }
+}
+
+#------------------------------------------------------------------------------#
+# build help browser trees
+
+# TODO check file timestamp against timestamp of when tree was built
+
+proc ::helpbrowser::findfiles {basedir pattern} {
+ set basedir [string trimright [file join [file normalize $basedir] { }]]
+ set filelist {}
+
+ # Look in the current directory for matching files, -type {f r}
+ # means ony readable normal files are looked at, -nocomplain stops
+ # an error being thrown if the returned list is empty
+ foreach filename [glob -nocomplain -type {f r} -path $basedir $pattern] {
+ lappend filelist $filename
+ }
+
+ foreach dirName [glob -nocomplain -type {d r} -path $basedir *] {
+ set subdirlist [findfiles $dirName $pattern]
+ if { [llength $subdirlist] > 0 } {
+ foreach subdirfile $subdirlist {
+ lappend filelist $subdirfile
+ }
+ }
+ }
+ return $filelist
+}
+
+proc ::helpbrowser::add_entry {reflist entry} {
+ variable libdirlist
+ variable helplist
+ variable reference_paths
+ variable reference_count
+ set entryname [file tail $entry]
+ # if we are checking libdirs, then check to see if there is already a
+ # libdir with that name that has been discovered in the path. If so, dump
+ # a warning. The trailing slash on $entryname is added below when
+ # $entryname is a dir
+ if {$reflist eq "libdirlist" && [lsearch -exact $libdirlist $entryname/] > -1} {
+ ::pdwindow::error "WARNING: duplicate '$entryname' library found!\n"
+ ::pdwindow::error " '$reference_paths($entryname/)' is active\n"
+ ::pdwindow::error " '$entry' is duplicate\n"
+ incr reference_count($entryname)
+ append entryname "/ ($reference_count($entryname))"
+ } else {
+ set reference_count($entryname) 1
+ if {[file isdirectory $entry]} {
+ append entryname "/"
+ }
+ }
+ lappend $reflist $entryname
+ set reference_paths($entryname) $entry
+}
+
+proc ::helpbrowser::build_references {} {
+ variable libdirlist {" Pure Data/" "-----------------------"}
+ variable helplist {}
+ variable reference_count
+ variable reference_paths
+
+ array set reference_count {}
+ array set reference_paths [list \
+ " Pure Data/" $::sys_libdir/doc \
+ "-----------------------" "" \
+ ]
+ foreach pathdir [concat $::sys_searchpath $::sys_staticpath] {
+ if { ! [file isdirectory $pathdir]} {continue}
+ # Fix the directory name, this ensures the directory name is in the
+ # native format for the platform and contains a final directory seperator
+ set dir [string trimright [file join [file normalize $pathdir] { }]]
+ ## find the libdirs
+ foreach filename [glob -nocomplain -type d -path $dir "*"] {
+ add_entry libdirlist $filename
+ }
+ ## find the stray help patches
+ foreach filename [glob -nocomplain -type f -path $dir "*-help.pd"] {
+ add_entry helplist $filename
+ }
+ }
+}
+
+
+
+
+
diff --git a/pd/tcl/opt_parser.tcl b/pd/tcl/opt_parser.tcl
index d304e045..c34baf6d 100644
--- a/pd/tcl/opt_parser.tcl
+++ b/pd/tcl/opt_parser.tcl
@@ -3,35 +3,44 @@ package provide opt_parser 0.1
namespace eval opt_parser {
# list of option vars (keys are long option names)
variable optlist
+ # option behavior <set|lappend>
+ variable optbehavior
variable optprefix {-}
}
proc opt_parser::init {optdata} {
variable optlist
- array unset optlist
- array set optlist {}
+ variable optbehavior
+ array unset optlist ; array set optlist {}
+ array unset optbehavior ; array set optbehavior {}
foreach item $optdata {
- foreach {longname varlist} $item {
- if {[llength $varlist] < 1} {
- return -code error "usage: init { {optname {var1 var2 ...}} ... }"
+ foreach {optName behavior varlist} $item {
+ if {[llength $varlist] < 1 || [lsearch -exact {set lappend} $behavior] == -1} {
+ return -code error "usage: init { {optname <set|lappend> {var1 var2 ...}} ... }"
}
- set optlist($longname) $varlist
+ set optlist($optName) $varlist
+ set optbehavior($optName) $behavior
}
}
}
proc opt_parser::get_options {argv {opts {}}} {
- set ignore_unknown_flags 0
+ # second argument are internal options
+ # (like 'ignore_unknown_flags <0|1>')
foreach {k v} $opts {set $k $v}
+ set ignore_unknown_flags 0
variable optlist
+ variable optbehavior
variable optprefix
# zero all the options 1st var
foreach optName [array names optlist] {
uplevel [list set [lindex $optlist($optName) 0] 0]
- for {set i 1} {$i < [llength $optlist($optName)]} {incr i} {
- uplevel [list set [lindex $optlist($optName) $i] [list]]
+ if {$optbehavior($optName) == {lappend}} {
+ for {set i 1} {$i < [llength $optlist($optName)]} {incr i} {
+ uplevel [list set [lindex $optlist($optName) $i] [list]]
+ }
}
}
@@ -41,16 +50,15 @@ proc opt_parser::get_options {argv {opts {}}} {
set argc [llength $argv]
for {set i 0} {$i < $argc} {} {
# get i-th arg
- set argv_i [lindex $argv $i]
+ set optName [lindex $argv $i]
incr i
# if it's not an option, stop here, and add to residualArgs
- if {![regexp ^$optprefix $argv_i]} {
- lappend residualArgs $argv_i
+ if {![regexp ^$optprefix $optName]} {
+ lappend residualArgs $optName
continue
}
- set optName [regsub ^$optprefix $argv_i {}]
if {[info exists optlist($optName)]} {
set varlist $optlist($optName)
uplevel [list set [lindex $optlist($optName) 0] 1]
@@ -59,9 +67,9 @@ proc opt_parser::get_options {argv {opts {}}} {
while {$n_required_opt_args > 0} {
incr n_required_opt_args -1
if {$i >= $argc} {
- return -code error "not enough arguments for option $optprefix$optName"
+ return -code error "not enough arguments for option $optName"
}
- uplevel [list lappend [lindex $varlist $j] [lindex $argv $i]]
+ uplevel [list $optbehavior($optName) [lindex $varlist $j] [lindex $argv $i]]
incr j
incr i
}
@@ -70,7 +78,7 @@ proc opt_parser::get_options {argv {opts {}}} {
lappend residualArgs $argv_i
continue
} else {
- return -code error "unknown option: $optprefix$optName"
+ return -code error "unknown option: $optName"
}
}
}
diff --git a/pd/tcl/pd-gui.tcl b/pd/tcl/pd-gui.tcl
index 6dfe1663..39b260f5 100644
--- a/pd/tcl/pd-gui.tcl
+++ b/pd/tcl/pd-gui.tcl
@@ -8,15 +8,19 @@
# "." automatically gets a window, we don't want it. Withdraw it before doing
# anything else, so that we don't get the automatic window flashing for a
# second while pd loads.
-wm withdraw .
-
-puts -------------------------------pd-gui.tcl-----------------------------------
+if { [catch {wm withdraw .} fid] } { exit 2 }
package require Tcl 8.3
package require Tk
-package require Tk
-if {[tk windowingsystem] ne "win32"} {package require msgcat}
+#package require tile
+## replace Tk widgets with Ttk widgets on 8.5
+#namespace import -force ttk::*
+
+package require msgcat
# TODO figure out msgcat issue on Windows
+# TODO create a constructor in each package to create things at startup, that
+# way they can be easily be modified by startup scripts
+# TODO create alt-Enter/Cmd-I binding to bring up Properties panels
# Pd's packages are stored in the same directory as the main script (pd-gui.tcl)
set auto_path [linsert $auto_path 0 [file dirname [info script]]]
@@ -27,26 +31,52 @@ package require pdwindow
package require dialog_array
package require dialog_audio
package require dialog_canvas
+package require dialog_data
package require dialog_font
package require dialog_gatom
package require dialog_iemgui
+package require dialog_message
package require dialog_midi
+package require dialog_path
+package require dialog_startup
+package require helpbrowser
+package require pd_menucommands
+package require opt_parser
package require pdtk_canvas
package require pdtk_text
# TODO eliminate this kludge:
package require wheredoesthisgo
+#------------------------------------------------------------------------------#
+# import functions into the global namespace
+
+# make global since they are used throughout
+namespace import ::pd_menucommands::*
+
# import into the global namespace for backwards compatibility
namespace import ::pd_connect::pdsend
namespace import ::pdwindow::pdtk_post
+namespace import ::pdwindow::pdtk_pd_dio
+namespace import ::pdwindow::pdtk_pd_dsp
+namespace import ::pdwindow::pdtk_pd_meters
+namespace import ::pdtk_canvas::pdtk_canvas_popup
+namespace import ::pdtk_canvas::pdtk_canvas_editmode
+namespace import ::pdtk_canvas::pdtk_canvas_getscroll
+namespace import ::pdtk_canvas::pdtk_canvas_setparents
+namespace import ::pdtk_canvas::pdtk_canvas_reflecttitle
+namespace import ::pdtk_canvas::pdtk_canvas_menuclose
namespace import ::dialog_array::pdtk_array_dialog
namespace import ::dialog_audio::pdtk_audio_dialog
namespace import ::dialog_canvas::pdtk_canvas_dialog
+namespace import ::dialog_data::pdtk_data_dialog
+namespace import ::dialog_find::pdtk_couldnotfind
namespace import ::dialog_font::pdtk_canvas_dofont
namespace import ::dialog_gatom::pdtk_gatom_dialog
namespace import ::dialog_iemgui::pdtk_iemgui_dialog
namespace import ::dialog_midi::pdtk_midi_dialog
namespace import ::dialog_midi::pdtk_alsa_midi_dialog
+namespace import ::dialog_path::pdtk_path_dialog
+namespace import ::dialog_startup::pdtk_startup_dialog
# hack - these should be better handled in the C code
namespace import ::dialog_array::pdtk_array_listview_new
@@ -57,10 +87,16 @@ namespace import ::dialog_array::pdtk_array_listview_closeWindow
#------------------------------------------------------------------------------#
# global variables
+# this is a wide array of global variables that are used throughout the GUI.
+# they can be used in plugins to check the status of various things since they
+# should all have been properly initialized by the time startup plugins are
+# loaded.
+
set PD_MAJOR_VERSION 0
set PD_MINOR_VERSION 0
set PD_BUGFIX_VERSION 0
set PD_TEST_VERSION ""
+set done_init 0
set TCL_MAJOR_VERSION 0
set TCL_MINOR_VERSION 0
@@ -69,8 +105,13 @@ set TCL_BUGFIX_VERSION 0
# for testing which platform we are running on ("aqua", "win32", or "x11")
set windowingsystem ""
-# variable for vwait so that 'pd-gui' will timeout if 'pd' never shows up
-set wait4pd "init"
+# args about how much and where to log
+set loglevel 2
+set stderr 0
+
+# connection between 'pd' and 'pd-gui'
+set host ""
+set port 0
# canvas font, received from pd in pdtk_pd_startup, set in s_main.c
set font_family "courier"
@@ -78,45 +119,95 @@ set font_weight "normal"
# sizes of chars for each of the Pd fixed font sizes:
# fontsize width(pixels) height(pixels)
set font_fixed_metrics {
- 8 5 10
- 9 6 11
+ 8 5 11
+ 9 6 12
10 6 13
- 12 7 15
+ 12 7 16
14 8 17
- 16 10 20
+ 16 10 19
18 11 22
- 24 14 30
+ 24 14 29
30 18 37
- 36 22 45
+ 36 22 44
}
+set font_measured_metrics {}
# root path to lib of Pd's files, see s_main.c for more info
set sys_libdir {}
# root path where the pd-gui.tcl GUI script is located
set sys_guidir {}
-
-set audioapi_list {}
-set midiapi_list {}
+# user-specified search path for objects, help, fonts, etc.
+set sys_searchpath {}
+# hard-coded search patch for objects, help, plugins, etc.
+set sys_staticpath {}
+# the path to the folder where the current plugin is being loaded from
+set current_plugin_loadpath {}
+# list of command line flags set at startup
+set startup_flags {}
+# list of libraries loaded on startup
+set startup_libraries {}
+# start dirs for new files and open panels
+set filenewdir [pwd]
+set fileopendir [pwd]
+
+
+# lists of audio/midi devices and APIs for prefs dialogs
+set audio_apilist {}
+set audio_indevlist {}
+set audio_outdevlist {}
+set midi_apilist {}
+set midi_indevlist {}
+set midi_outdevlist {}
set pd_whichapi 0
set pd_whichmidiapi 0
# current state of the DSP
set dsp 0
+# state of the peak meters in the Pd window
+set meters 0
# the toplevel window that currently is on top and has focus
set focused_window .
-# TODO figure out how to get all windows into the menu_windowlist
-# store list of parent windows for Window menu
-set menu_windowlist {}
# store that last 10 files that were opened
set recentfiles_list {}
set total_recentfiles 10
-# keep track of the location of popup menu for CanvasWindows
-set popup_xpix 0
-set popup_ypix 0
+# keep track of the location of popup menu for PatchWindows, in canvas coords
+set popup_xcanvas 0
+set popup_ycanvas 0
+# modifier for key commands (Ctrl/Control on most platforms, Cmd/Mod1 on MacOSX)
+set modifier ""
+# current state of the Edit Mode menu item
+set editmode_button 0
+
## per toplevel/patch data
-# store editmode for each open canvas, starting with a blank array
-array set editmode {}
+# window location modifiers
+set menubarsize 0 ;# Mac OS X and other platforms have a menubar on top
+set windowframex 0 ;# different platforms have different window frames
+set windowframey 0 ;# different platforms have different window frames
+# patch properties
+array set editmode {} ;# store editmode for each open patch canvas
+array set editingtext {};# if an obj, msg, or comment is being edited, per patch
+array set loaded {} ;# store whether a patch has completed loading
+array set xscrollable {};# keep track of whether the scrollbars are present
+array set yscrollable {}
+# patch window tree, these might contain patch IDs without a mapped toplevel
+array set windowname {} ;# window names based on mytoplevel IDs
+array set childwindows {} ;# all child windows based on mytoplevel IDs
+array set parentwindows {} ;# topmost parent window ID based on mytoplevel IDs
+
+# variables for holding the menubar to allow for configuration by plugins
+set ::pdwindow_menubar ".menubar"
+set ::patch_menubar ".menubar"
+set ::dialog_menubar ""
+
+# minimum size of the canvas window of a patch
+set canvas_minwidth 50
+set canvas_minheight 20
+
+# undo states
+set ::undo_action "no"
+set ::redo_action "no"
+set ::undo_toplevel "."
#------------------------------------------------------------------------------#
# coding style
@@ -129,17 +220,23 @@ array set editmode {}
# - if a menu_* proc opens a dialog panel, that proc is called menu_*_dialog
# - use "eq/ne" for string comparison, NOT "==/!=" (http://wiki.tcl.tk/15323)
#
+#
## Names for Common Variables
#----------------------------
-#
# variables named after the Tk widgets they represent
+# $window = any kind of Tk widget that can be a Tk 'window'
# $mytoplevel = a window id made by a 'toplevel' command
-# $mygfxstub = a window id made by a 'toplevel' command via gfxstub/x_gui.c
-# $menubar = the 'menu' attached to each 'toplevel'
-# $mymenu = 'menu' attached to the menubar
-# $menuitem = 'menu' item
-# $mycanvas = 'canvas'
-# $canvasitem = 'canvas' item
+# $gfxstub = a 'toplevel' window id for dialogs made in gfxstub/x_gui.c
+# $menubar = the 'menu' attached to each 'toplevel'
+# $mymenu = 'menu' attached to the menubar, like the File menu
+# $tkcanvas = a Tk 'canvas', which is the root of each patch
+#
+#
+## Dialog Panel Types
+#----------------------------
+# global (only one): find, sendmessage, prefs, helpbrowser
+# per-canvas: font, canvas properties (created with a message from pd)
+# per object: gatom, iemgui, array, data structures (created with a message from pd)
#
#
## Prefix Names for procs
@@ -150,18 +247,6 @@ array set editmode {}
# ------------------------------------------------------------------------------
# init functions
-proc set_pd_version {versionstring} {
- regexp -- {.*([0-9])\.([0-9]+)[\.\-]([0-9]+)([^0-9]?.*)} $versionstring \
- wholematch \
- ::PD_MAJOR_VERSION ::PD_MINOR_VERSION ::PD_BUGFIX_VERSION ::PD_TEST_VERSION
-}
-
-proc set_tcl_version {} {
- regexp {([0-9])\.([0-9])\.([0-9]+)} [info patchlevel] \
- wholematch \
- ::TCL_MAJOR_VERSION ::TCL_MINOR_VERSION ::TCL_BUGFIX_VERSION
-}
-
# root paths to find Pd's files where they are installed
proc set_pd_paths {} {
set ::sys_guidir [file normalize [file dirname [info script]]]
@@ -175,6 +260,8 @@ proc init_for_platform {} {
switch -- $::windowingsystem {
"x11" {
+ set ::modifier "Control"
+ option add *PatchWindow*Canvas.background "white" startupFile
# add control to show/hide hidden files in the open panel (load
# the tk_getOpenFile dialog once, otherwise it will not work)
catch {tk_getOpenFile -with-invalid-argument}
@@ -188,8 +275,31 @@ proc init_for_platform {} {
[list [_ "Max Patch Files"] {.pat} ] \
[list [_ "Max Text Files"] {.mxt} ] \
]
+ # some platforms have a menubar on the top, so place below them
+ set ::menubarsize 0
+ # Tk handles the window placement differently on each
+ # platform. With X11, the x,y placement refers to the window
+ # frame's upper left corner. http://wiki.tcl.tk/11502
+ set ::windowframex 3
+ set ::windowframey 53
+ # TODO add wm iconphoto/iconbitmap here if it makes sense
+ # mouse cursors for all the different modes
+ set ::cursor_runmode_nothing "left_ptr"
+ set ::cursor_runmode_clickme "arrow"
+ set ::cursor_runmode_thicken "sb_v_double_arrow"
+ set ::cursor_runmode_addpoint "plus"
+ set ::cursor_editmode_nothing "hand2"
+ set ::cursor_editmode_connect "circle"
+ set ::cursor_editmode_disconnect "X_cursor"
}
"aqua" {
+ set ::modifier "Mod1"
+ option add *DialogWindow*background "#E8E8E8" startupFile
+ option add *DialogWindow*Entry.highlightBackground "#E8E8E8" startupFile
+ option add *DialogWindow*Button.highlightBackground "#E8E8E8" startupFile
+ option add *DialogWindow*Entry.background "white" startupFile
+ # Mac OS X needs a menubar all the time
+ set ::dialog_menubar ".menubar"
# set file types that open/save recognize
set ::filetypes \
[list \
@@ -197,10 +307,33 @@ proc init_for_platform {} {
[list [_ "Pd Files"] {.pd} ] \
[list [_ "Max Patch Files (.pat)"] {.pat} ] \
[list [_ "Max Text Files (.mxt)"] {.mxt} ] \
- ]
+ ]
+ # some platforms have a menubar on the top, so place below them
+ set ::menubarsize 22
+ # Tk handles the window placement differently on each platform, on
+ # Mac OS X, the x,y placement refers to the content window's upper
+ # left corner (not of the window frame) http://wiki.tcl.tk/11502
+ set ::windowframex 0
+ set ::windowframey 0
+ # mouse cursors for all the different modes
+ set ::cursor_runmode_nothing "arrow"
+ set ::cursor_runmode_clickme "center_ptr"
+ set ::cursor_runmode_thicken "sb_v_double_arrow"
+ set ::cursor_runmode_addpoint "plus"
+ set ::cursor_editmode_nothing "hand2"
+ set ::cursor_editmode_connect "circle"
+ set ::cursor_editmode_disconnect "X_cursor"
}
"win32" {
+ set ::modifier "Control"
+ option add *PatchWindow*Canvas.background "white" startupFile
+ # fix menu font size on Windows with tk scaling = 1
font create menufont -family Tahoma -size -11
+ option add *Menu.font menufont startupFile
+ option add *HelpBrowser*font menufont startupFile
+ option add *DialogWindow*font menufont startupFile
+ option add *PdWindow*font menufont startupFile
+ option add *ErrorDialog*font menufont startupFile
# set file types that open/save recognize
set ::filetypes \
[list \
@@ -209,6 +342,24 @@ proc init_for_platform {} {
[list [_ "Max Patch Files"] {.pat} ] \
[list [_ "Max Text Files"] {.mxt} ] \
]
+ # some platforms have a menubar on the top, so place below them
+ set ::menubarsize 0
+ # Tk handles the window placement differently on each platform, on
+ # Mac OS X, the x,y placement refers to the content window's upper
+ # left corner. http://wiki.tcl.tk/11502
+ # TODO this probably needs a script layer: http://wiki.tcl.tk/11291
+ set ::windowframex 0
+ set ::windowframey 0
+ # TODO use 'winico' package for full, hicolor icon support
+ wm iconbitmap . -default [file join $::sys_guidir pd.ico]
+ # mouse cursors for all the different modes
+ set ::cursor_runmode_nothing "right_ptr"
+ set ::cursor_runmode_clickme "arrow"
+ set ::cursor_runmode_thicken "sb_v_double_arrow"
+ set ::cursor_runmode_addpoint "plus"
+ set ::cursor_editmode_nothing "hand2"
+ set ::cursor_editmode_connect "circle"
+ set ::cursor_editmode_disconnect "X_cursor"
}
}
}
@@ -217,26 +368,32 @@ proc init_for_platform {} {
# locale handling
# official GNU gettext msgcat shortcut
-if {[tk windowingsystem] ne "win32"} {
- proc _ {s} {return [::msgcat::mc $s]}
-} else {
- proc _ {s} {return $s}
-}
+proc _ {s} {return [::msgcat::mc $s]}
proc load_locale {} {
- if {[tk windowingsystem] ne "win32"} {
- ::msgcat::mcload [file join [file dirname [info script]] .. po]
+ # on any UNIX-like environment, Tcl should automatically use LANG, LC_ALL,
+ # etc. otherwise we need to dig it up. Mac OS X only uses LANG, etc. from
+ # the Terminal, and Windows doesn't have LANG, etc unless you manually set
+ # it up yourself. Windows apps don't use the locale env vars usually.
+ if {$::tcl_platform(os) eq "Darwin" && ! [info exists ::env(LANG)]} {
+ # http://thread.gmane.org/gmane.comp.lang.tcl.mac/5215
+ # http://thread.gmane.org/gmane.comp.lang.tcl.mac/6433
+ if {![catch "exec defaults read com.apple.dock loc" lang]} {
+ ::msgcat::mclocale $lang
+ } elseif {![catch "exec defaults read NSGlobalDomain AppleLocale" lang]} {
+ ::msgcat::mclocale $lang
+ }
+ } elseif {$::tcl_platform(platform) eq "windows"} {
+ # using LANG on Windows is useful for easy debugging
+ if {[info exists ::env(LANG)] && $::env(LANG) ne "C" && $::env(LANG) ne ""} {
+ ::msgcat::mclocale $::env(LANG)
+ } elseif {![catch {package require registry}]} {
+ ::msgcat::mclocale [string tolower \
+ [string range \
+ [registry get {HKEY_CURRENT_USER\Control Panel\International} sLanguage] 0 1] ]
+ }
}
-
- # for Windows
- #set locale "en" ;# Use whatever is right for your app
- #if {[catch {package require registry}]} {
- # tk_messageBox -icon error -message "Could not get locale from registry"
- #} else {
- # set locale [string tolower \
- # [string range \
- # [registry get {HKEY_CURRENT_USER\Control Panel\International} sLanguage] 0 1] ]
- #}
+ ::msgcat::mcload [file join [file dirname [info script]] .. po]
##--moo: force default system and stdio encoding to UTF-8
encoding system utf-8
@@ -258,32 +415,32 @@ proc get_font_for_size {size} {
# always do a good job of choosing in respect to Pd's needs. So this chooses
# from a list of fonts that are known to work well with Pd.
proc find_default_font {} {
- set testfonts {Inconsolata "Courier New" "Liberation Mono" FreeMono \
- "DejaVu Sans Mono" "Bitstream Vera Sans Mono"}
+ set testfonts {"DejaVu Sans Mono" "Bitstream Vera Sans Mono" \
+ "Inconsolata" "Courier 10 Pitch" "Andale Mono" "Droid Sans Mono"}
foreach family $testfonts {
if {[lsearch -exact -nocase [font families] $family] > -1} {
set ::font_family $family
break
}
}
- puts "DEFAULT FONT: $::font_family"
+ ::pdwindow::verbose 0 "Default font: $::font_family\n"
}
proc set_base_font {family weight} {
if {[lsearch -exact [font families] $family] > -1} {
set ::font_family $family
} else {
- pdtk_post [format \
- [_ "WARNING: Font family '%s' not found, using default (%s)"] \
- $family $::font_family]
+ ::pdwindow::post [format \
+ [_ "WARNING: Font family '%s' not found, using default (%s)\n"] \
+ $family $::font_family]
}
if {[lsearch -exact {bold normal} $weight] > -1} {
set ::font_weight $weight
set using_defaults 0
} else {
- pdtk_post [format \
- [_ "WARNING: Font weight '%s' not found, using default (%s)"] \
- $weight $::font_weight]
+ ::pdwindow::post [format \
+ [_ "WARNING: Font weight '%s' not found, using default (%s)\n"] \
+ $weight $::font_weight]
}
}
@@ -297,17 +454,22 @@ proc fit_font_into_metrics {} {
-size [expr {-$height}]
set height2 $height
set giveup 0
- while {[font measure $myfont M] > $width} {
+ while {[font measure $myfont M] > $width || \
+ [font metrics $myfont -linespace] > $height} {
incr height2 -1
font configure $myfont -size [expr {-$height2}]
if {$height2 * 2 <= $height} {
set giveup 1
+ set ::font_measured_metrics $::font_fixed_metrics
break
}
}
+ set ::font_measured_metrics \
+ "$::font_measured_metrics $size\
+ [font measure $myfont M] [font metrics $myfont -linespace]"
if {$giveup} {
- pdtk_post [format \
- [_ "ERROR: %s failed to find font size (%s) that fits into %sx%s!"]\
+ ::pdwindow::post [format \
+ [_ "WARNING: %s failed to find font size (%s) that fits into %sx%s!\n"]\
[lindex [info level 0] 0] $size $width $height]
continue
}
@@ -318,46 +480,77 @@ proc fit_font_into_metrics {} {
# ------------------------------------------------------------------------------
# procs called directly by pd
-# this is only called when 'pd' starts 'pd-gui', not the other way around
-proc pdtk_pd_startup {versionstring audio_apis midi_apis sys_font sys_fontweight} {
-# pdtk_post "-------------- pdtk_pd_startup ----------------"
-# pdtk_post "version: $versionstring"
-# pdtk_post "audio_apis: $audio_apis"
-# pdtk_post "midi_apis: $midi_apis"
-# pdtk_post "sys_font: $sys_font"
-# pdtk_post "sys_fontweight: $sys_fontweight"
+proc pdtk_pd_startup {major minor bugfix test
+ audio_apis midi_apis sys_font sys_fontweight} {
+ set ::PD_MAJOR_VERSION $major
+ set ::PD_MINOR_VERSION $minor
+ set ::PD_BUGFIX_VERSION $bugfix
+ set ::PD_TEST_VERSION $test
set oldtclversion 0
- pdsend "pd init [enquote_path [pwd]] $oldtclversion $::font_fixed_metrics"
- set_pd_version $versionstring
- set ::audioapi_list $audio_apis
- set ::midiapi_list $midi_apis
+ set ::audio_apilist $audio_apis
+ set ::midi_apilist $midi_apis
if {$::tcl_version >= 8.5} {find_default_font}
set_base_font $sys_font $sys_fontweight
fit_font_into_metrics
- # TODO what else is needed from the original?
- set ::wait4pd "started"
+ pdsend "pd init [enquote_path [pwd]] $oldtclversion $::font_measured_metrics"
+ ::pd_bindings::class_bindings
+ ::pd_bindings::global_bindings
+ ::pd_menus::create_menubar
+ ::pdtk_canvas::create_popup
+ ::pdwindow::create_window
+ ::pd_menus::configure_for_pdwindow
+ load_startup_plugins
+ open_filestoopen
+ set ::done_init 1
}
##### routine to ask user if OK and, if so, send a message on to Pd ######
-# TODO add 'mytoplevel' once merged to 0.43, with -parent
-proc pdtk_check {message reply_to_pd default} {
- # TODO this should use -parent and -title, but the hard part is figuring
- # out how to get the values for those without changing g_editor.c
- set answer [tk_messageBox -type yesno -icon question -default $default \
- -message [_ $message]]
+proc pdtk_check {mytoplevel message reply_to_pd default} {
+ wm deiconify $mytoplevel
+ raise $mytoplevel
+ if {$::windowingsystem eq "win32"} {
+ set answer [tk_messageBox -message [_ $message] -type yesno -default $default \
+ -icon question -title [wm title $mytoplevel]]
+ } else {
+ set answer [tk_messageBox -message [_ $message] -type yesno \
+ -default $default -parent $mytoplevel -icon question]
+ }
if {$answer eq "yes"} {
pdsend $reply_to_pd
}
}
-proc pdtk_fixwindowmenu {} {
- # TODO canvas_updatewindowlist() sets up the menu_windowlist with all of
- # the parent CanvasWindows, we should then use [wm stackorder .] to get
- # the rest of the CanvasWindows to make sure that all CanvasWindows are in
- # the menu. This would probably be better handled on the C side of
- # things, since then, the menu_windowlist could be built with the proper
- # parent/child relationships.
- # pdtk_post "Running pdtk_fixwindowmenu"
+# ------------------------------------------------------------------------------
+# parse command line args when Wish/pd-gui.tcl is started first
+
+proc parse_args {argc argv} {
+ opt_parser::init {
+ {-stderr set {::stderr}}
+ {-open lappend {- ::filestoopen_list}}
+ }
+ set unflagged_files [opt_parser::get_options $argv]
+ # if we have a single arg that is not a file, its a port or host:port combo
+ if {$argc == 1 && ! [file exists $argv]} {
+ if { [string is int $argv] && $argv > 0} {
+ # 'pd-gui' got the port number from 'pd'
+ set ::host "localhost"
+ set ::port $argv
+ } else {
+ set hostport [split $argv ":"]
+ set ::host [lindex $hostport 0]
+ set ::port [lindex $hostport 1]
+ }
+ } elseif {$unflagged_files ne ""} {
+ foreach filename $unflagged_files {
+ lappend ::filestoopen_list $filename
+ }
+ }
+}
+
+proc open_filestoopen {} {
+ foreach filename $::filestoopen_list {
+ open_file $filename
+ }
}
# ------------------------------------------------------------------------------
@@ -384,28 +577,37 @@ proc first_lost {} {
selection own -command first_lost -selection PUREDATA .
}
-# all other instances
-proc send_args {offset maxChars} {
- return [string range $::argv $offset [expr {$offset+$maxChars}]]
-}
-
proc others_lost {} {
set ::singleton_state "exit"
destroy .
exit
}
+# all other instances
+proc send_args {offset maxChars} {
+ set sendargs {}
+ foreach filename $::filestoopen_list {
+ lappend sendargs [file normalize $filename]
+ }
+ return [string range $sendargs $offset [expr {$offset+$maxChars}]]
+}
-# ------------------------------------------------------------------------------
-# various startup related procs
+# this command will open files received from a 2nd instance of Pd
+proc receive_args {filelist} {
+ raise .
+ foreach filename $filelist {
+ open_file $filename
+ }
+}
proc check_for_running_instances {argc argv} {
- # pdtk_post "check_for_running_instances $argc $argv"
switch -- $::windowingsystem {
"aqua" {
# handled by ::tk::mac::OpenDocument in apple_events.tcl
} "x11" {
# http://wiki.tcl.tk/1558
+ # TODO replace PUREDATA name with path so this code is a singleton
+ # based on install location rather than this hard-coded name
if {![singleton PUREDATA_MANAGER]} {
# other instances called by wish/pd-gui (exempt 'pd' by 5400 arg)
if {$argc == 1 && [string is int $argv] && $argv >= 5400} {return}
@@ -425,32 +627,33 @@ proc check_for_running_instances {argc argv} {
}
}
-# this command will open files received from a 2nd instance of Pd
-proc receive_args args {
- # pdtk_post "receive_files $args"
- raise .
- foreach filename $args {
- open_file $filename
+
+# ------------------------------------------------------------------------------
+# load plugins on startup
+
+proc load_plugin_script {filename} {
+ global errorInfo
+
+ ::pdwindow::debug "Loading plugin: $filename\n"
+ set tclfile [open $filename]
+ set tclcode [read $tclfile]
+ close $tclfile
+ if {[catch {uplevel #0 $tclcode} errorname]} {
+ ::pdwindow::error "-----------\n"
+ ::pdwindow::error "UNHANDLED ERROR: $errorInfo\n"
+ ::pdwindow::error "FAILED TO LOAD $filename\n"
+ ::pdwindow::error "-----------\n"
}
}
-proc load_startup {} {
- global errorInfo
-# TODO search all paths for startup.tcl
- set startupdir [file normalize "$::sys_libdir/startup"]
- # pdtk_post "load_startup $startupdir"
- puts stderr "load_startup $startupdir"
- if { ! [file isdirectory $startupdir]} { return }
- foreach filename [glob -directory $startupdir -nocomplain -types {f} -- *.tcl] {
- puts "Loading $filename"
- set tclfile [open $filename]
- set tclcode [read $tclfile]
- close $tclfile
- if {[catch {uplevel #0 $tclcode} errorname]} {
- puts stderr "------------------------------------------------------"
- puts stderr "UNHANDLED ERROR: $errorInfo"
- puts stderr "FAILED TO LOAD $filename"
- puts stderr "------------------------------------------------------"
+proc load_startup_plugins {} {
+ foreach pathdir [concat $::sys_searchpath $::sys_staticpath] {
+ set dir [file normalize $pathdir]
+ if { ! [file isdirectory $dir]} {continue}
+ foreach filename [glob -directory $dir -nocomplain -types {f} -- \
+ *-plugin/*-plugin.tcl *-plugin.tcl] {
+ set ::current_plugin_loadpath [file dirname $filename]
+ load_plugin_script $filename
}
}
}
@@ -462,42 +665,27 @@ proc main {argc argv} {
set ::windowingsystem [tk windowingsystem]
tk appname pd-gui
load_locale
+ parse_args $argc $argv
check_for_running_instances $argc $argv
set_pd_paths
init_for_platform
- # post_tclinfo
- # set a timeout for how long 'pd-gui' should wait for 'pd' to start
- after 20000 set ::wait4pd "timeout"
- # TODO check args for -stderr and set pdtk_post accordingly
- if {$argc == 1 && [string is int $argv] && $argv >= 5400} {
+ # ::host and ::port are parsed from argv by parse_args
+ if { $::port > 0 && $::host ne "" } {
# 'pd' started first and launched us, so get the port to connect to
- ::pd_connect::to_pd [lindex $argv 0]
+ ::pd_connect::to_pd $::port $::host
} else {
# the GUI is starting first, so create socket and exec 'pd'
- set portnumber [::pd_connect::create_socket]
+ set ::port [::pd_connect::create_socket]
set pd_exec [file join [file dirname [info script]] ../bin/pd]
- exec -- $pd_exec -guiport $portnumber &
- }
- # wait for 'pd' to call pdtk_pd_startup, or exit on timeout
- vwait ::wait4pd
- if {$::wait4pd eq "timeout"} {
- puts stderr [_ "ERROR: 'pd' never showed up, 'pd-gui' quitting!"]
- exit 2
+ exec -- $pd_exec -guiport $::port &
+ if {$::windowingsystem eq "aqua"} {
+ # on Aqua, if 'pd-gui' first, then initial dir is home
+ set ::filenewdir $::env(HOME)
+ set ::fileopendir $::env(HOME)
+ }
}
- ::pd_bindings::class_bindings
- ::pd_menus::create_menubar
- ::pdtk_canvas::create_popup
- ::pdwindow::create_window
- ::pd_menus::configure_for_pdwindow
- load_startup
- # pdtk_post "------------------ done with main ----------------------"
+ ::pdwindow::verbose 0 "------------------ done with main ----------------------\n"
}
main $::argc $::argv
-
-
-
-
-
-
diff --git a/pd/tcl/pd.ico b/pd/tcl/pd.ico
new file mode 100755
index 00000000..2da5c243
--- /dev/null
+++ b/pd/tcl/pd.ico
Binary files differ
diff --git a/pd/tcl/pd_bindings.tcl b/pd/tcl/pd_bindings.tcl
index 0cef0474..82ac3509 100644
--- a/pd/tcl/pd_bindings.tcl
+++ b/pd/tcl/pd_bindings.tcl
@@ -4,83 +4,97 @@ package require pd_menucommands
package require dialog_find
namespace eval ::pd_bindings:: {
- variable modifier
-
- namespace export window_bindings
+ namespace export global_bindings
namespace export dialog_bindings
- namespace export canvas_bindings
+ namespace export patch_bindings
}
-# the commands are bound using "" quotations so that the $mytoplevel is
+# TODO rename pd_bindings to window_bindings after merge is done
+
+# Some commands are bound using "" quotations so that the $mytoplevel is
# interpreted immediately. Since the command is being bound to $mytoplevel,
# it makes sense to have value of $mytoplevel already in the command. This is
-# the opposite of the menu commands in pd_menus.tcl
+# the opposite of most menu/bind commands here and in pd_menus.tcl, which use
+# {} to force execution of any variables (i.e. $::focused_window) until later
+
-# binding by class is not recursive, so its useful for certain things
+# binding by class is not recursive, so its useful for window events
proc ::pd_bindings::class_bindings {} {
# and the Pd window is in a class to itself
- bind PdWindow <Configure> "::pd_bindings::window_configure %W"
bind PdWindow <FocusIn> "::pd_bindings::window_focusin %W"
- # bind to all the canvas windows
- bind CanvasWindow <Map> "::pd_bindings::map %W"
- bind CanvasWindow <Unmap> "::pd_bindings::unmap %W"
- bind CanvasWindow <Configure> "::pd_bindings::window_configure %W"
- bind CanvasWindow <FocusIn> "::pd_bindings::window_focusin %W"
- # bindings for dialog windows, which behave differently than canvas windows
+ # bind to all the windows dedicated to patch canvases
+ bind PatchWindow <FocusIn> "::pd_bindings::window_focusin %W"
+ bind PatchWindow <Map> "::pd_bindings::map %W"
+ bind PatchWindow <Unmap> "::pd_bindings::unmap %W"
+ bind PatchWindow <Configure> "::pd_bindings::patch_configure %W %w %h %x %y"
+ # dialog panel windows bindings, which behave differently than PatchWindows
bind DialogWindow <Configure> "::pd_bindings::dialog_configure %W"
bind DialogWindow <FocusIn> "::pd_bindings::dialog_focusin %W"
}
-proc ::pd_bindings::window_bindings {mytoplevel} {
- variable modifier
-
- # for key bindings
- if {$::windowingsystem eq "aqua"} {
- set modifier "Mod1"
- } else {
- set modifier "Control"
- }
-
- # File menu
- bind $mytoplevel <$modifier-Key-b> "menu_helpbrowser"
- bind $mytoplevel <$modifier-Key-f> "::dialog_find::menu_find_dialog $mytoplevel"
- bind $mytoplevel <$modifier-Key-n> "menu_new"
- bind $mytoplevel <$modifier-Key-o> "menu_open"
- bind $mytoplevel <$modifier-Key-p> "menu_print $mytoplevel"
- bind $mytoplevel <$modifier-Key-q> "pdsend \"pd verifyquit\""
- bind $mytoplevel <$modifier-Key-r> "menu_raise_pdwindow"
- bind $mytoplevel <$modifier-Shift-Key-L> "menu_clear_console"
- bind $mytoplevel <$modifier-Shift-Key-Q> "pdsend \"pd quit\""
- bind $mytoplevel <$modifier-Shift-Key-R> "menu_toggle_console"
-
- # DSP control
- bind $mytoplevel <$modifier-Key-slash> "pdsend \"pd dsp 1\""
- bind $mytoplevel <$modifier-Key-period> "pdsend \"pd dsp 0\""
-}
-
-proc ::pd_bindings::pdwindow_bindings {mytoplevel} {
- variable modifier
-
- window_bindings $mytoplevel
-
- # TODO update this to work with the console, if it is used
- bind $mytoplevel <$modifier-Key-a> ".pdwindow.text tag add sel 1.0 end"
- bind $mytoplevel <$modifier-Key-x> "tk_textCut .pdwindow.text"
- bind $mytoplevel <$modifier-Key-c> "tk_textCopy .pdwindow.text"
- bind $mytoplevel <$modifier-Key-v> "tk_textPaste .pdwindow.text"
- bind $mytoplevel <$modifier-Key-w> "wm iconify $mytoplevel"
+proc ::pd_bindings::global_bindings {} {
+ # we use 'bind all' everywhere to get as much of Tk's automatic binding
+ # behaviors as possible, things like not sending an event for 'O' when
+ # 'Control-O' is pressed.
+ bind all <$::modifier-Key-a> {menu_send %W selectall}
+ bind all <$::modifier-Key-b> {menu_helpbrowser}
+ bind all <$::modifier-Key-c> {menu_send %W copy}
+ bind all <$::modifier-Key-d> {menu_send %W duplicate}
+ bind all <$::modifier-Key-e> {menu_toggle_editmode}
+ bind all <$::modifier-Key-f> {menu_find_dialog}
+ bind all <$::modifier-Key-g> {menu_send %W findagain}
+ bind all <$::modifier-Key-n> {menu_new}
+ bind all <$::modifier-Key-o> {menu_open}
+ bind all <$::modifier-Key-p> {menu_print $::focused_window}
+ bind all <$::modifier-Key-q> {pdsend "pd verifyquit"}
+ bind all <$::modifier-Key-r> {menu_raise_pdwindow}
+ bind all <$::modifier-Key-s> {menu_send %W menusave}
+ bind all <$::modifier-Key-v> {menu_send %W paste}
+ bind all <$::modifier-Key-w> {menu_send_float %W menuclose 0}
+ bind all <$::modifier-Key-x> {menu_send %W cut}
+ bind all <$::modifier-Key-z> {menu_undo}
+ bind all <$::modifier-Key-1> {menu_send_float %W obj 0}
+ bind all <$::modifier-Key-2> {menu_send_float %W msg 0}
+ bind all <$::modifier-Key-3> {menu_send_float %W floatatom 0}
+ bind all <$::modifier-Key-4> {menu_send_float %W symbolatom 0}
+ bind all <$::modifier-Key-5> {menu_send_float %W text 0}
+ bind all <$::modifier-Key-slash> {pdsend "pd dsp 1"}
+ bind all <$::modifier-Key-period> {pdsend "pd dsp 0"}
+ # annoying, but Tk's bind needs uppercase letter to get the Shift
+ bind all <$::modifier-Shift-Key-B> {menu_send %W bng}
+ bind all <$::modifier-Shift-Key-C> {menu_send %W mycnv}
+ bind all <$::modifier-Shift-Key-D> {menu_send %W vradio}
+ bind all <$::modifier-Shift-Key-H> {menu_send %W hslider}
+ bind all <$::modifier-Shift-Key-I> {menu_send %W hradio}
+ bind all <$::modifier-Shift-Key-L> {menu_clear_console}
+ bind all <$::modifier-Shift-Key-N> {menu_send %W numbox}
+ bind all <$::modifier-Shift-Key-Q> {pdsend "pd quit"}
+ bind all <$::modifier-Shift-Key-S> {menu_send %W menusaveas}
+ bind all <$::modifier-Shift-Key-T> {menu_send %W toggle}
+ bind all <$::modifier-Shift-Key-U> {menu_send %W vumeter}
+ bind all <$::modifier-Shift-Key-V> {menu_send %W vslider}
+ bind all <$::modifier-Shift-Key-W> {menu_send_float %W menuclose 1}
+ bind all <$::modifier-Shift-Key-Z> {menu_redo}
+
+ # OS-specific bindings
if {$::windowingsystem eq "aqua"} {
- bind $mytoplevel <$modifier-Key-m> "menu_minimize $mytoplevel"
- bind $mytoplevel <$modifier-Key-t> "menu_font_dialog $mytoplevel"
- bind $mytoplevel <$modifier-quoteleft> "menu_raisenextwindow"
+ # Cmd-m = Minimize and Cmd-t = Font on Mac OS X for all apps
+ bind all <$::modifier-Key-m> {menu_minimize %W}
+ bind all <$::modifier-Key-t> {menu_font_dialog}
+ bind all <$::modifier-quoteleft> {menu_raisenextwindow}
+ bind all <$::modifier-Shift-Key-M> {menu_message_dialog}
} else {
- bind $mytoplevel <$modifier-Key-m> "menu_message_dialog"
- bind $mytoplevel <$modifier-Key-t> "menu_texteditor"
+ bind all <$::modifier-Key-m> {menu_message_dialog}
+ #bind all <$::modifier-Key-t> {menu_texteditor}
+ bind all <$::modifier-Next> {menu_raisenextwindow} ;# PgUp
+ bind all <$::modifier-Prior> {menu_raisepreviouswindow};# PageDown
}
- # Tcl event bindings
- wm protocol $mytoplevel WM_DELETE_WINDOW "pdsend \"pd verifyquit\""
+ bind all <KeyPress> {::pd_bindings::sendkey %W 1 %K %A 0}
+ bind all <KeyRelease> {::pd_bindings::sendkey %W 0 %K %A 0}
+ bind all <Shift-KeyPress> {::pd_bindings::sendkey %W 1 %K %A 1}
+ bind all <Shift-KeyRelease> {::pd_bindings::sendkey %W 0 %K %A 1}
}
# this is for the dialogs: find, font, sendmessage, gatom properties, array
@@ -89,135 +103,115 @@ proc ::pd_bindings::pdwindow_bindings {mytoplevel} {
proc ::pd_bindings::dialog_bindings {mytoplevel dialogname} {
variable modifier
- window_bindings $mytoplevel
-
bind $mytoplevel <KeyPress-Escape> "dialog_${dialogname}::cancel $mytoplevel"
bind $mytoplevel <KeyPress-Return> "dialog_${dialogname}::ok $mytoplevel"
- bind $mytoplevel <$modifier-Key-w> "dialog_${dialogname}::cancel $mytoplevel"
+ bind $mytoplevel <$::modifier-Key-w> "dialog_${dialogname}::cancel $mytoplevel"
+ # these aren't supported in the dialog, so alert the user, then break so
+ # that no other key bindings are run
+ bind $mytoplevel <$::modifier-Key-s> {bell; break}
+ bind $mytoplevel <$::modifier-Shift-Key-S> {bell; break}
+ bind $mytoplevel <$::modifier-Key-p> {bell; break}
- $mytoplevel configure -padx 10 -pady 5
- wm group $mytoplevel .
- wm resizable $mytoplevel 0 0
wm protocol $mytoplevel WM_DELETE_WINDOW "dialog_${dialogname}::cancel $mytoplevel"
- catch { # not all platforms/Tcls versions have these options
- wm attributes $mytoplevel -topmost 1
- #wm attributes $mytoplevel -transparent 1
- #$mytoplevel configure -highlightthickness 1
- }
}
-proc ::pd_bindings::canvas_bindings {mytoplevel} {
+proc ::pd_bindings::patch_bindings {mytoplevel} {
variable modifier
- set mycanvas $mytoplevel.c
-
- window_bindings $mytoplevel
+ set tkcanvas [tkcanvas_name $mytoplevel]
- # key bindings -------------------------------------------------------------
- bind $mytoplevel <$modifier-Key-1> "pdsend \"$mytoplevel obj\""
- bind $mytoplevel <$modifier-Key-2> "pdsend \"$mytoplevel msg\""
- bind $mytoplevel <$modifier-Key-3> "pdsend \"$mytoplevel floatatom\""
- bind $mytoplevel <$modifier-Key-4> "pdsend \"$mytoplevel symbolatom\""
- bind $mytoplevel <$modifier-Key-5> "pdsend \"$mytoplevel text\""
- bind $mytoplevel <$modifier-Key-a> "pdsend \"$mytoplevel selectall\""
- bind $mytoplevel <$modifier-Key-c> "pdsend \"$mytoplevel copy\""
- bind $mytoplevel <$modifier-Key-d> "pdsend \"$mytoplevel duplicate\""
- bind $mytoplevel <$modifier-Key-e> "pdsend \"$mytoplevel editmode 0\""
- bind $mytoplevel <$modifier-Key-g> "pdsend \"$mytoplevel findagain\""
- bind $mytoplevel <$modifier-Key-s> "pdsend \"$mytoplevel menusave\""
- bind $mytoplevel <$modifier-Key-v> "pdsend \"$mytoplevel paste\""
- bind $mytoplevel <$modifier-Key-w> "pdsend \"$mytoplevel menuclose 0\""
- bind $mytoplevel <$modifier-Key-x> "pdsend \"$mytoplevel cut\""
- bind $mytoplevel <$modifier-Key-z> "menu_undo $mytoplevel"
+ # TODO move mouse bindings to global and bind to 'all'
- # annoying, but Tk's bind needs uppercase letter to get the Shift
- bind $mytoplevel <$modifier-Shift-Key-B> "pdsend \"$mytoplevel bng 1\""
- bind $mytoplevel <$modifier-Shift-Key-C> "pdsend \"$mytoplevel mycnv 1\""
- bind $mytoplevel <$modifier-Shift-Key-D> "pdsend \"$mytoplevel vradio 1\""
- bind $mytoplevel <$modifier-Shift-Key-H> "pdsend \"$mytoplevel hslider 1\""
- bind $mytoplevel <$modifier-Shift-Key-I> "pdsend \"$mytoplevel hradio 1\""
- bind $mytoplevel <$modifier-Shift-Key-N> "pdsend \"$mytoplevel numbox 1\""
- bind $mytoplevel <$modifier-Shift-Key-S> "pdsend \"$mytoplevel menusaveas\""
- bind $mytoplevel <$modifier-Shift-Key-T> "pdsend \"$mytoplevel toggle 1\""
- bind $mytoplevel <$modifier-Shift-Key-U> "pdsend \"$mytoplevel vumeter 1\""
- bind $mytoplevel <$modifier-Shift-Key-V> "pdsend \"$mytoplevel vslider 1\""
- bind $mytoplevel <$modifier-Shift-Key-W> "pdsend \"$mytoplevel menuclose 1\""
- bind $mytoplevel <$modifier-Shift-Key-Z> "menu_redo $mytoplevel"
-
- if {$::windowingsystem eq "aqua"} {
- bind $mytoplevel <$modifier-Key-m> "menu_minimize $mytoplevel"
- bind $mytoplevel <$modifier-Key-t> "menu_font_dialog $mytoplevel"
- bind $mytoplevel <$modifier-quoteleft> "menu_raisenextwindow"
- } else {
- bind $mytoplevel <$modifier-Key-m> "menu_message_dialog"
- bind $mytoplevel <$modifier-Key-t> "menu_texteditor"
+ # mouse bindings -----------------------------------------------------------
+ # these need to be bound to $tkcanvas because %W will return $mytoplevel for
+ # events over the window frame and $tkcanvas for events over the canvas
+ bind $tkcanvas <Motion> "pdtk_canvas_motion %W %x %y 0"
+ bind $tkcanvas <$::modifier-Motion> "pdtk_canvas_motion %W %x %y 2"
+ bind $tkcanvas <ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 0"
+ bind $tkcanvas <ButtonRelease-1> "pdtk_canvas_mouseup %W %x %y %b"
+ bind $tkcanvas <$::modifier-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 2"
+ bind $tkcanvas <Shift-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 1"
+
+ if {$::windowingsystem eq "x11"} {
+ # from http://wiki.tcl.tk/3893
+ bind all <Button-4> \
+ {event generate [focus -displayof %W] <MouseWheel> -delta 1}
+ bind all <Button-5> \
+ {event generate [focus -displayof %W] <MouseWheel> -delta -1}
+ bind all <Shift-Button-4> \
+ {event generate [focus -displayof %W] <Shift-MouseWheel> -delta 1}
+ bind all <Shift-Button-5> \
+ {event generate [focus -displayof %W] <Shift-MouseWheel> -delta -1}
}
- bind $mytoplevel <KeyPress> "::pd_bindings::sendkey %W 1 %K %A 0"
- bind $mytoplevel <KeyRelease> "::pd_bindings::sendkey %W 0 %K %A 0"
- bind $mytoplevel <Shift-KeyPress> "::pd_bindings::sendkey %W 1 %K %A 1"
- bind $mytoplevel <Shift-KeyRelease> "::pd_bindings::sendkey %W 0 %K %A 1"
+ bind $tkcanvas <MouseWheel> {::pdtk_canvas::scroll %W y %D}
+ bind $tkcanvas <Shift-MouseWheel> {::pdtk_canvas::scroll %W x %D}
- # mouse bindings -----------------------------------------------------------
- # these need to be bound to $mycanvas because %W will return $mytoplevel for
- # events over the window frame and $mytoplevel.c for events over the canvas
- bind $mycanvas <Motion> "pdtk_canvas_motion %W %x %y 0"
- bind $mycanvas <$modifier-Motion> "pdtk_canvas_motion %W %x %y 2"
- bind $mycanvas <ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 0"
- bind $mycanvas <ButtonRelease-1> "pdtk_canvas_mouseup %W %x %y %b"
- bind $mycanvas <$modifier-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 2"
- # TODO look into "virtual events' for a means for getting Shift-Button, etc.
+ # "right clicks" are defined differently on each platform
switch -- $::windowingsystem {
"aqua" {
- bind $mycanvas <ButtonPress-2> "pdtk_canvas_rightclick %W %x %y %b"
+ bind $tkcanvas <ButtonPress-2> "pdtk_canvas_rightclick %W %x %y %b"
# on Mac OS X, make a rightclick with Ctrl-click for 1 button mice
- bind $mycanvas <Control-Button-1> "pdtk_canvas_rightclick %W %x %y %b"
- # TODO try replacing the above with this
- #bind all <Control-Button-1> {event generate %W <Button-2> \
- # -x %x -y %y -rootx %X -rooty %Y \
- # -button 2 -time %t}
+ bind $tkcanvas <Control-Button-1> "pdtk_canvas_rightclick %W %x %y %b"
+ bind $tkcanvas <Option-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 3"
} "x11" {
- bind $mycanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
+ bind $tkcanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
# on X11, button 2 "pastes" from the X windows clipboard
- bind $mycanvas <ButtonPress-2> "pdtk_canvas_clickpaste %W %x %y %b"
+ bind $tkcanvas <ButtonPress-2> "pdtk_canvas_clickpaste %W %x %y %b"
+ bind $tkcanvas <Alt-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 3"
} "win32" {
- bind $mycanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
+ bind $tkcanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
+ bind $tkcanvas <Alt-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 3"
}
}
- #TODO bind $mytoplevel <MouseWheel>
# window protocol bindings
wm protocol $mytoplevel WM_DELETE_WINDOW "pdsend \"$mytoplevel menuclose 0\""
- bind $mycanvas <Destroy> "::pd_bindings::window_destroy %W"
+ bind $tkcanvas <Destroy> "::pd_bindings::window_destroy %W"
}
#------------------------------------------------------------------------------#
# event handlers
-proc ::pd_bindings::window_configure {mytoplevel} {
- pdtk_canvas_getscroll $mytoplevel
+proc ::pd_bindings::patch_configure {mytoplevel width height x y} {
+ # for some reason, when we create a window, we get an event with a
+ # widthXheight of 1x1 first, then we get the right values, so filter it out
+ if {$width == 1 && $height == 1} {return}
+ pdtk_canvas_getscroll [tkcanvas_name $mytoplevel]
+ # send the size/location of the window and canvas to 'pd' in the form of:
+ # left top right bottom
+ pdsend "$mytoplevel setbounds $x $y [expr $x + $width] [expr $y + $height]"
}
-proc ::pd_bindings::window_destroy {mycanvas} {
- set mytoplevel [winfo toplevel $mycanvas]
+proc ::pd_bindings::window_destroy {window} {
+ set mytoplevel [winfo toplevel $window]
unset ::editmode($mytoplevel)
+ unset ::editingtext($mytoplevel)
+ unset ::loaded($mytoplevel)
+ # unset my entries all of the window data tracking arrays
+ array unset ::windowname $mytoplevel
+ array unset ::parentwindows $mytoplevel
+ array unset ::childwindows $mytoplevel
}
# do tasks when changing focus (Window menu, scrollbars, etc.)
proc ::pd_bindings::window_focusin {mytoplevel} {
- # pdtk_post "::pd_bindings::window_focusin $mytoplevel"
+ # focused_window is used throughout for sending bindings, menu commands,
+ # etc. to the correct patch receiver symbol.
set ::focused_window $mytoplevel
- ::dialog_find::set_canvas_to_search $mytoplevel
- ::pd_menucommands::set_menu_new_dir $mytoplevel
+ ::dialog_find::set_window_to_search $mytoplevel
+ ::pd_menucommands::set_filenewdir $mytoplevel
::dialog_font::update_font_dialog $mytoplevel
if {$mytoplevel eq ".pdwindow"} {
::pd_menus::configure_for_pdwindow
} else {
::pd_menus::configure_for_canvas $mytoplevel
}
- # TODO handle enabling/disabling the Undo and Redo menu items in Edit
+ if {[winfo exists .font]} {wm transient .font $::focused_window}
+ # if we regain focus from another app, make sure to editmode cursor is right
+ if {$::editmode($mytoplevel)} {
+ $mytoplevel configure -cursor hand2
+ }
# TODO handle enabling/disabling the Cut/Copy/Paste menu items in Edit
- # TODO enable menu items that the Pd window or dialogs might have disabled
- # TODO update "Open Recent" menu
}
proc ::pd_bindings::dialog_configure {mytoplevel} {
@@ -233,6 +227,7 @@ proc ::pd_bindings::dialog_focusin {mytoplevel} {
# don't get a final "unmap" event when we destroy the window.
proc ::pd_bindings::map {mytoplevel} {
pdsend "$mytoplevel map 1"
+ ::pdtk_canvas::finished_loading_file $mytoplevel
}
proc ::pd_bindings::unmap {mytoplevel} {
@@ -243,7 +238,11 @@ proc ::pd_bindings::unmap {mytoplevel} {
#------------------------------------------------------------------------------#
# key usage
-proc ::pd_bindings::sendkey {mycanvas state key iso shift} {
+# canvas_key() expects to receive the patch's mytoplevel because key messages
+# are local to each patch. Therefore, key messages are not send for the
+# dialog panels, the Pd window, help browser, etc. so we need to filter those
+# events out.
+proc ::pd_bindings::sendkey {window state key iso shift} {
# TODO canvas_key on the C side should be refactored with this proc as well
switch -- $key {
"BackSpace" { set iso ""; set key 8 }
@@ -257,7 +256,13 @@ proc ::pd_bindings::sendkey {mycanvas state key iso shift} {
if {$iso ne ""} {
scan $iso %c key
}
- puts "::pd_bindings::sendkey {%W:$mycanvas $state %K$key %A$iso $shift}"
- # $mycanvas might be a toplevel, but [winfo toplevel] does the right thing
- pdsend "[winfo toplevel $mycanvas] key $state $key $shift"
+ # some pop-up panels also bind to keys like the enter, but then disappear,
+ # so ignore their events. The inputbox in the Startup dialog does this.
+ if {! [winfo exists $window]} {return}
+ #$window might be a toplevel or canvas, [winfo toplevel] does the right thing
+ set mytoplevel [winfo toplevel $window]
+ if {[winfo class $mytoplevel] eq "PatchWindow"} {
+ pdsend "$mytoplevel key $state $key $shift"
+ }
+ # TODO send to 'pd key' for global key events in Pd?
}
diff --git a/pd/tcl/pd_connect.tcl b/pd/tcl/pd_connect.tcl
index cdd3d91d..5bb3f29f 100644
--- a/pd/tcl/pd_connect.tcl
+++ b/pd/tcl/pd_connect.tcl
@@ -12,18 +12,17 @@ namespace eval ::pd_connect:: {
# TODO figure out how to escape { } properly
proc ::pd_connect::configure_socket {sock} {
- fconfigure $sock -blocking 0 -buffering line -encoding utf-8;
+ fconfigure $sock -blocking 0 -buffering none -encoding utf-8;
fileevent $sock readable {::pd_connect::pd_readsocket ""}
}
# if pd opens first, it starts pd-gui, then pd-gui connects to the port pd sent
-proc ::pd_connect::to_pd {port} {
- # puts "::pd_connect::to_pd"
+proc ::pd_connect::to_pd {port {host localhost}} {
variable pd_socket
- # puts stderr "Connecting to localhost $port ..."
- if {[catch {set pd_socket [socket localhost $port]}]} {
- puts stderr "WARNING: connect to pd failed, retrying port $port."
- after 1000 ::pd_connect::to_pd $port
+ ::pdwindow::debug "'pd-gui' connecting to 'pd' on localhost $port ...\n"
+ if {[catch {set pd_socket [socket $host $port]}]} {
+ puts stderr "WARNING: connect to pd failed, retrying port $host:$port."
+ after 1000 ::pd_connect::to_pd $port $host
return
}
::pd_connect::configure_socket $pd_socket
@@ -40,15 +39,15 @@ proc ::pd_connect::create_socket {} {
}
proc ::pd_connect::from_pd {channel clientaddr clientport} {
- puts "::pd_connect::from_pd"
variable pd_socket $channel
- puts "Connection from $clientaddr:$clientport registered"
+ ::pdwindow::debug "Connection from 'pd' to 'pd-gui' on $clientaddr:$clientport\n"
::pd_connect::configure_socket $pd_socket
}
# send a pd/FUDI message from Tcl to Pd. This function aims to behave like a
-# [; message( in Pd. Basically, whatever is in quotes after the proc name
-# will be sent as if it was sent from a message box with a leading semi-colon
+# [; message( in Pd or pdsend on the command line. Basically, whatever is in
+# quotes after the proc name will be sent as if it was sent from a message box
+# with a leading semi-colon.
proc ::pd_connect::pdsend {message} {
variable pd_socket
append message \;
@@ -74,18 +73,15 @@ proc ::pd_connect::pd_readsocket {cmd_from_pd} {
exit
}
}
-# puts stderr [concat CMD: $cmd_from_pd :CMD]
if {[catch {uplevel #0 $cmd_from_pd} errorname]} {
global errorInfo
- puts stderr "errorname: >>$errorname<<"
switch -regexp -- $errorname {
"missing close-brace" {
- # TODO consider using [info complete $cmd_from_pd] in a loop
pd_readsocket $cmd_from_pd
} "^invalid command name" {
- puts stderr "INVALID COMMAND NAME: $errorInfo"
+ ::pdwindow::fatal [concat [_ "(Tcl) INVALID COMMAND NAME: "] $errorInfo "\n"]
} default {
- puts stderr "UNHANDLED ERROR: $errorInfo"
+ ::pdwindow::fatal [concat [_ "(Tcl) UNHANDLED ERROR: "] $errorInfo "\n"]
}
}
}
diff --git a/pd/tcl/pd_menucommands.tcl b/pd/tcl/pd_menucommands.tcl
index e1373b84..d351c994 100644
--- a/pd/tcl/pd_menucommands.tcl
+++ b/pd/tcl/pd_menucommands.tcl
@@ -3,8 +3,6 @@ package provide pd_menucommands 0.1
namespace eval ::pd_menucommands:: {
variable untitled_number "1"
- variable menu_new_dir [pwd]
- variable menu_open_dir [pwd]
namespace export menu_*
}
@@ -14,27 +12,27 @@ namespace eval ::pd_menucommands:: {
proc ::pd_menucommands::menu_new {} {
variable untitled_number
- variable menu_new_dir
- if { ! [file isdirectory $menu_new_dir]} {set menu_new_dir $::env(HOME)}
- set untitled_name [_ "Untitled"]
- pdsend "pd filename $untitled_name-$untitled_number [enquote_path $menu_new_dir]"
+ if { ! [file isdirectory $::filenewdir]} {set ::filenewdir $::env(HOME)}
+ # to localize "Untitled" there will need to be changes in g_canvas.c and
+ # g_readwrite.c, where it tests for the string "Untitled"
+ set untitled_name "Untitled"
+ pdsend "pd filename $untitled_name-$untitled_number [enquote_path $::filenewdir]"
pdsend "#N canvas"
pdsend "#X pop 1"
incr untitled_number
}
proc ::pd_menucommands::menu_open {} {
- variable menu_open_dir
- if { ! [file isdirectory $menu_open_dir]} {set menu_open_dir $::env(HOME)}
+ if { ! [file isdirectory $::fileopendir]} {set ::fileopendir $::env(HOME)}
set files [tk_getOpenFile -defaultextension .pd \
-multiple true \
-filetypes $::filetypes \
- -initialdir $menu_open_dir]
+ -initialdir $::fileopendir]
if {$files ne ""} {
foreach filename $files {
open_file $filename
}
- set menu_open_dir [file dirname $filename]
+ set ::fileopendir [file dirname $filename]
}
}
@@ -43,54 +41,75 @@ proc ::pd_menucommands::menu_print {mytoplevel} {
-defaultextension .ps \
-filetypes { {{postscript} {.ps}} }]
if {$filename ne ""} {
- $mytoplevel.c postscript -file $filename
+ set tkcanvas [tkcanvas_name $mytoplevel]
+ $tkcanvas postscript -file $filename
}
}
-# dialog types:
-# global (only one): find, sendmessage, prefs, helpbrowser
-# per-canvas: font, canvas properties (created with a message from pd)
-# per object: gatom, iemgui, array, data structures (created with a message from pd)
+# ------------------------------------------------------------------------------
+# functions called from Edit menu
+
+proc ::pd_menucommands::menu_undo {} {
+ if {$::focused_window eq $::undo_toplevel && $::undo_action ne "no"} {
+ pdsend "$::focused_window undo"
+ }
+}
+proc ::pd_menucommands::menu_redo {} {
+ if {$::focused_window eq $::undo_toplevel && $::redo_action ne "no"} {
+ pdsend "$::focused_window redo"
+ }
+}
+
+proc ::pd_menucommands::menu_editmode {state} {
+ if {[winfo class $::focused_window] ne "PatchWindow"} {return}
+ set ::editmode_button $state
+# this shouldn't be necessary because 'pd' will reply with pdtk_canvas_editmode
+# set ::editmode($::focused_window) $state
+ pdsend "$::focused_window editmode $state"
+}
+
+proc ::pd_menucommands::menu_toggle_editmode {} {
+ menu_editmode [expr {! $::editmode_button}]
+}
# ------------------------------------------------------------------------------
-# functions called from Edit menu
+# generic procs for sending menu events
-proc menu_undo {mytoplevel} {
- # puts stderr "menu_undo $mytoplevel not implemented yet"
+# send a message to a pd canvas receiver
+proc ::pd_menucommands::menu_send {window message} {
+ set mytoplevel [winfo toplevel $window]
+ if {[winfo class $mytoplevel] eq "PatchWindow"} {
+ pdsend "$mytoplevel $message"
+ }
}
-proc menu_redo {mytoplevel} {
- # puts stderr "menu_redo $mytoplevel not implemented yet"
+# send a message to a pd canvas receiver with a float arg
+proc ::pd_menucommands::menu_send_float {window message float} {
+ set mytoplevel [winfo toplevel $window]
+ if {[winfo class $mytoplevel] eq "PatchWindow"} {
+ pdsend "$mytoplevel $message $float"
+ }
}
# ------------------------------------------------------------------------------
# open the dialog panels
proc ::pd_menucommands::menu_message_dialog {} {
- if {[winfo exists .send_message]} {
- wm deiconify .send_message
- raise .message
- } else {
- # TODO insert real message panel here
- toplevel .send_message
- wm group .send_message .
- wm title .send_message [_ "Send Message..."]
- wm resizable .send_message 0 0
- ::pd_bindings::dialog_bindings .send_message "send_message"
- frame .send_message.frame
- label .send_message.label -text [_ "Message"] -width 30 -height 15
- pack .send_message.label .send_message.frame -side top -expand yes -fill both
- }
+ ::dialog_message::open_message_dialog $::focused_window
+}
+
+proc ::pd_menucommands::menu_find_dialog {} {
+ ::dialog_find::open_find_dialog $::focused_window
}
-proc ::pd_menucommands::menu_font_dialog {mytoplevel} {
+proc ::pd_menucommands::menu_font_dialog {} {
if {[winfo exists .font]} {
raise .font
- } elseif {$mytoplevel eq ".pdwindow"} {
+ } elseif {$::focused_window eq ".pdwindow"} {
pdtk_canvas_dofont .pdwindow [lindex [.pdwindow.text cget -font] 1]
} else {
- pdsend "$mytoplevel menufont"
+ pdsend "$::focused_window menufont"
}
}
@@ -110,20 +129,27 @@ proc ::pd_menucommands::menu_startup_dialog {} {
}
}
+proc ::pd_menucommands::menu_helpbrowser {} {
+ ::helpbrowser::open_helpbrowser
+}
+
+proc ::pd_menucommands::menu_texteditor {} {
+ ::pdwindow::error "the text editor is not implemented"
+}
+
# ------------------------------------------------------------------------------
# window management functions
-proc ::pd_menucommands::menu_minimize {mytoplevel} {
- wm iconify $mytoplevel
+proc ::pd_menucommands::menu_minimize {window} {
+ wm iconify [winfo toplevel $window]
}
-proc ::pd_menucommands::menu_maximize {mytoplevel} {
- wm state $mytoplevel zoomed
+proc ::pd_menucommands::menu_maximize {window} {
+ wm state [winfo toplevel $window] zoomed
}
-proc menu_raise_pdwindow {} {
- set top_window [lindex [wm stackorder .pdwindow] end]
- if {.pdwindow eq $top_window} {
+proc ::pd_menucommands::menu_raise_pdwindow {} {
+ if {$::focused_window eq ".pdwindow" && [winfo viewable .pdwindow]} {
lower .pdwindow
} else {
wm deiconify .pdwindow
@@ -131,62 +157,89 @@ proc menu_raise_pdwindow {} {
}
}
+# used for cycling thru windows of an app
+proc ::pd_menucommands::menu_raisepreviouswindow {} {
+ lower [lindex [wm stackorder .] end] [lindex [wm stackorder .] 0]
+ focus [lindex [wm stackorder .] end]
+}
+
+# used for cycling thru windows of an app the other direction
+proc ::pd_menucommands::menu_raisenextwindow {} {
+ set mytoplevel [lindex [wm stackorder .] 0]
+ raise $mytoplevel
+ focus $mytoplevel
+}
+
+# ------------------------------------------------------------------------------
+# Pd window functions
+proc menu_clear_console {} {
+ ::pdwindow::clear_console
+}
+
# ------------------------------------------------------------------------------
# manage the saving of the directories for the new commands
# this gets the dir from the path of a window's title
-proc ::pd_menucommands::set_menu_new_dir {mytoplevel} {
- variable menu_new_dir
- variable menu_open_dir
+proc ::pd_menucommands::set_filenewdir {mytoplevel} {
# TODO add Aqua specifics once g_canvas.c has [wm attributes -titlepath]
if {$mytoplevel eq ".pdwindow"} {
- # puts "set_menu_new_dir $mytoplevel"
- set menu_new_dir $menu_open_dir
+ set ::filenewdir $::fileopendir
} else {
- regexp -- ".+ - (.+)" [wm title $mytoplevel] ignored menu_new_dir
+ regexp -- ".+ - (.+)" [wm title $mytoplevel] ignored ::filenewdir
}
}
-# ------------------------------------------------------------------------------
-# opening docs as menu items (like the Test Audio and MIDI patch and the manual)
-proc ::pd_menucommands::menu_doc_open {subdir basename} {
- set dirname "$::sys_libdir/$subdir"
-
- switch -- [string tolower [file extension $basename]] {
- ".txt" {::pd_menucommands::menu_opentext "$dirname/$basename"
- } ".c" {::pd_menucommands::menu_opentext "$dirname/$basename"
- } ".htm" {::pd_menucommands::menu_openhtml "$dirname/$basename"
- } ".html" {::pd_menucommands::menu_openhtml "$dirname/$basename"
- } default {
- pdsend "pd open [enquote_path $basename] [enquote_path $dirname]"
+# parse the textfile for the About Pd page
+proc ::pd_menucommands::menu_aboutpd {} {
+ set versionstring "Pd $::PD_MAJOR_VERSION.$::PD_MINOR_VERSION.$::PD_BUGFIX_VERSION$::PD_TEST_VERSION"
+ set filename "$::sys_libdir/doc/1.manual/1.introduction.txt"
+ if {[winfo exists .aboutpd]} {
+ wm deiconify .aboutpd
+ raise .aboutpd
+ } else {
+ toplevel .aboutpd -class TextWindow
+ wm title .aboutpd [_ "About Pd"]
+ wm group .aboutpd .
+ .aboutpd configure -menu $::dialog_menubar
+ text .aboutpd.text -relief flat -borderwidth 0 \
+ -yscrollcommand ".aboutpd.scroll set" -background white
+ scrollbar .aboutpd.scroll -command ".aboutpd.text yview"
+ pack .aboutpd.scroll -side right -fill y
+ pack .aboutpd.text -side left -fill both -expand 1
+ bind .aboutpd <$::modifier-Key-w> "wm withdraw .aboutpd"
+
+ set textfile [open $filename]
+ while {![eof $textfile]} {
+ set bigstring [read $textfile 1000]
+ regsub -all PD_BASEDIR $bigstring $::sys_guidir bigstring2
+ regsub -all PD_VERSION $bigstring2 $versionstring bigstring3
+ .aboutpd.text insert end $bigstring3
}
+ close $textfile
}
}
-# open text docs in a Pd window
-proc ::pd_menucommands::menu_opentext {filename} {
- global pd_myversion
- set mytoplevel [format ".help%d" [clock seconds]]
- toplevel $mytoplevel -class TextWindow
- text $mytoplevel.text -relief flat -borderwidth 0 \
- -yscrollcommand "$mytoplevel.scroll set" -background white
- scrollbar $mytoplevel.scroll -command "$mytoplevel.text yview"
- pack $mytoplevel.scroll -side right -fill y
- pack $mytoplevel.text -side left -fill both -expand 1
- ::pd_bindings::window_bindings $mytoplevel
-
- set textfile [open $filename]
- while {![eof $textfile]} {
- set bigstring [read $textfile 1000]
- regsub -all PD_BASEDIR $bigstring $::sys_guidir bigstring2
- regsub -all PD_VERSION $bigstring2 $pd_myversion bigstring3
- $mytoplevel.text insert end $bigstring3
+# ------------------------------------------------------------------------------
+# opening docs as menu items (like the Test Audio and MIDI patch and the manual)
+proc ::pd_menucommands::menu_doc_open {dir basename} {
+ if {[file pathtype $dir] eq "relative"} {
+ set dirname "$::sys_libdir/$dir"
+ } else {
+ set dirname $dir
+ }
+ set textextension "[string tolower [file extension $basename]]"
+ if {[lsearch -exact [lindex $::filetypes 0 1] $textextension] > -1} {
+ set fullpath [file normalize [file join $dirname $basename]]
+ set dirname [file dirname $fullpath]
+ set basename [file tail $fullpath]
+ pdsend "pd open [enquote_path $basename] [enquote_path $dirname]"
+ } else {
+ ::pd_menucommands::menu_openfile "$dirname/$basename"
}
- close $textfile
}
# open HTML docs from the menu using the OS-default HTML viewer
-proc ::pd_menucommands::menu_openhtml {filename} {
+proc ::pd_menucommands::menu_openfile {filename} {
if {$::tcl_platform(os) eq "Darwin"} {
exec sh -c [format "open '%s'" $filename]
} elseif {$::tcl_platform(platform) eq "windows"} {
diff --git a/pd/tcl/pd_menus.tcl b/pd/tcl/pd_menus.tcl
index 99b6be94..fc617dfa 100644
--- a/pd/tcl/pd_menus.tcl
+++ b/pd/tcl/pd_menus.tcl
@@ -4,33 +4,18 @@
package provide pd_menus 0.1
package require pd_menucommands
-package require Tk
-#package require tile
-## replace Tk widgets with Ttk widgets on 8.5
-#namespace import -force ttk::*
# TODO figure out Undo/Redo/Cut/Copy/Paste state changes for menus
-# TODO figure out parent window/window list for Window menu
-# TODO what is the Tcl package constructor or init()?
-# TODO $::pd_menus::menubar or .menubar globally?
# since there is one menubar that is used for all windows, the menu -commands
# use {} quotes so that $::focused_window is interpreted when the menu item
# is called, not when the command is mapped to the menu item. This is the
# opposite of the 'bind' commands in pd_bindings.tcl
-
-# ------------------------------------------------------------------------------
-# global variables
-
-# TODO this should properly be inside the pd_menus namespace, now it is global
-namespace import ::pd_menucommands::*
-
namespace eval ::pd_menus:: {
variable accelerator
variable menubar ".menubar"
- variable current_toplevel ".pdwindow"
-
+
namespace export create_menubar
namespace export configure_for_pdwindow
namespace export configure_for_canvas
@@ -52,32 +37,33 @@ proc ::pd_menus::create_menubar {} {
}
menu $menubar
set menulist "file edit put find media window help"
- if { $::windowingsystem eq "aqua" } {create_apple_menu $menubar}
- # FIXME why does the following (if uncommented) kill my menubar?
- # if { $::windowingsystem eq "win32" } {create_system_menu $menubar}
foreach mymenu $menulist {
menu $menubar.$mymenu
$menubar add cascade -label [_ [string totitle $mymenu]] \
-menu $menubar.$mymenu
- [format build_%s_menu $mymenu] $menubar.$mymenu .
- if {$::windowingsystem eq "win32"} {
- # fix menu font size on Windows with tk scaling = 1
- $menubar.$mymenu configure -font menufont
- }
+ [format build_%s_menu $mymenu] $menubar.$mymenu
}
+ if {$::windowingsystem eq "aqua"} {create_apple_menu $menubar}
+ if {$::windowingsystem eq "win32"} {create_system_menu $menubar}
+ . configure -menu $menubar
}
proc ::pd_menus::configure_for_pdwindow {} {
variable menubar
# these are meaningless for the Pd window, so disable them
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state disabled
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state disabled
- }
+ # File menu
+ $menubar.file entryconfigure [_ "Save"] -state disabled
+ $menubar.file entryconfigure [_ "Save As..."] -state disabled
+ $menubar.file entryconfigure [_ "Print..."] -state disabled
+ $menubar.file entryconfigure [_ "Close"] -state disabled
+ # Edit menu
+ $menubar.edit entryconfigure [_ "Duplicate"] -state disabled
+ $menubar.edit entryconfigure [_ "Tidy Up"] -state disabled
+ $menubar.edit entryconfigure [_ "Edit Mode"] -state disabled
+ pdtk_canvas_editmode .pdwindow 0
+ # Undo/Redo change names, they need to have the asterisk (*) after
+ $menubar.edit entryconfigure 0 -state disabled -label [_ "Undo"]
+ $menubar.edit entryconfigure 1 -state disabled -label [_ "Redo"]
# disable everything on the Put menu
for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
# catch errors that happen when trying to disable separators
@@ -87,32 +73,45 @@ proc ::pd_menus::configure_for_pdwindow {} {
proc ::pd_menus::configure_for_canvas {mytoplevel} {
variable menubar
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state normal
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state normal
- }
+ # File menu
+ $menubar.file entryconfigure [_ "Save"] -state normal
+ $menubar.file entryconfigure [_ "Save As..."] -state normal
+ $menubar.file entryconfigure [_ "Print..."] -state normal
+ $menubar.file entryconfigure [_ "Close"] -state normal
+ # Edit menu
+ $menubar.edit entryconfigure [_ "Duplicate"] -state normal
+ $menubar.edit entryconfigure [_ "Tidy Up"] -state normal
+ $menubar.edit entryconfigure [_ "Edit Mode"] -state normal
+ pdtk_canvas_editmode $mytoplevel $::editmode($mytoplevel)
+ # Put menu
for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
# catch errors that happen when trying to disable separators
- catch {$menubar.put entryconfigure $i -state normal }
+ if {[$menubar.put type $i] ne "separator"} {
+ $menubar.put entryconfigure $i -state normal
+ }
}
- # TODO set "Edit Mode" state using editmode($mytoplevel)
+ update_undo_on_menu $mytoplevel
}
proc ::pd_menus::configure_for_dialog {mytoplevel} {
variable menubar
- # these are meaningless for the dialog panels, so disable them
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state disabled
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state disabled
+ # these are meaningless for the dialog panels, so disable them except for
+ # the ones that make senes in the Find dialog panel
+ # File menu
+ if {$mytoplevel ne ".find"} {
+ $menubar.file entryconfigure [_ "Save"] -state disabled
+ $menubar.file entryconfigure [_ "Save As..."] -state disabled
+ $menubar.file entryconfigure [_ "Print..."] -state disabled
}
+ $menubar.file entryconfigure [_ "Close"] -state disabled
+ # Edit menu
+ $menubar.edit entryconfigure [_ "Duplicate"] -state disabled
+ $menubar.edit entryconfigure [_ "Tidy Up"] -state disabled
+ $menubar.edit entryconfigure [_ "Edit Mode"] -state disabled
+ pdtk_canvas_editmode $mytoplevel 0
+ # Undo/Redo change names, they need to have the asterisk (*) after
+ $menubar.edit entryconfigure 0 -state disabled -label [_ "Undo"]
+ $menubar.edit entryconfigure 1 -state disabled -label [_ "Redo"]
# disable everything on the Put menu
for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
# catch errors that happen when trying to disable separators
@@ -123,19 +122,20 @@ proc ::pd_menus::configure_for_dialog {mytoplevel} {
# ------------------------------------------------------------------------------
# menu building functions
-proc ::pd_menus::build_file_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_file_menu {mymenu} {
+ # run the platform-specific build_file_menu_* procs first, the config them
[format build_file_menu_%s $::windowingsystem] $mymenu
$mymenu entryconfigure [_ "New"] -command {menu_new}
$mymenu entryconfigure [_ "Open"] -command {menu_open}
- $mymenu entryconfigure [_ "Save"] -command {pdsend "$::focused_window menusave"}
- $mymenu entryconfigure [_ "Save As..."] -command {pdsend "$::focused_window menusaveas"}
- #$mymenu entryconfigure [_ "Revert*"] -command {menu_revert $current_toplevel}
- $mymenu entryconfigure [_ "Close"] -command {pdsend "$::focused_window menuclose 0"}
- $mymenu entryconfigure [_ "Message"] -command {menu_message_dialog}
+ $mymenu entryconfigure [_ "Save"] -command {menu_send $::focused_window menusave}
+ $mymenu entryconfigure [_ "Save As..."] -command {menu_send $::focused_window menusaveas}
+ #$mymenu entryconfigure [_ "Revert*"] -command {menu_revert $::focused_window}
+ $mymenu entryconfigure [_ "Close"] -command {menu_send_float $::focused_window menuclose 0}
+ $mymenu entryconfigure [_ "Message..."] -command {menu_message_dialog}
$mymenu entryconfigure [_ "Print..."] -command {menu_print $::focused_window}
}
-proc ::pd_menus::build_edit_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_edit_menu {mymenu} {
variable accelerator
$mymenu add command -label [_ "Undo"] -accelerator "$accelerator+Z" \
-command {menu_undo $::focused_window}
@@ -143,165 +143,186 @@ proc ::pd_menus::build_edit_menu {mymenu mytoplevel} {
-command {menu_redo $::focused_window}
$mymenu add separator
$mymenu add command -label [_ "Cut"] -accelerator "$accelerator+X" \
- -command {pdsend "$::focused_window cut"}
+ -command {menu_send $::focused_window cut}
$mymenu add command -label [_ "Copy"] -accelerator "$accelerator+C" \
- -command {pdsend "$::focused_window copy"}
+ -command {menu_send $::focused_window copy}
$mymenu add command -label [_ "Paste"] -accelerator "$accelerator+V" \
- -command {pdsend "$::focused_window paste"}
+ -command {menu_send $::focused_window paste}
$mymenu add command -label [_ "Duplicate"] -accelerator "$accelerator+D" \
- -command {pdsend "$::focused_window duplicate"}
+ -command {menu_send $::focused_window duplicate}
$mymenu add command -label [_ "Select All"] -accelerator "$accelerator+A" \
- -command {pdsend "$::focused_window selectall"}
+ -command {menu_send $::focused_window selectall}
$mymenu add separator
if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Text Editor"] \
- -command {menu_texteditor $::focused_window}
+# $mymenu add command -label [_ "Text Editor"] \
+# -command {menu_texteditor}
$mymenu add command -label [_ "Font"] -accelerator "$accelerator+T" \
- -command {menu_font_dialog $::focused_window}
+ -command {menu_font_dialog}
} else {
- $mymenu add command -label [_ "Text Editor"] -accelerator "$accelerator+T"\
- -command {menu_texteditor $::focused_window}
+# $mymenu add command -label [_ "Text Editor"] -accelerator "$accelerator+T"\
+# -command {menu_texteditor}
$mymenu add command -label [_ "Font"] \
- -command {menu_font_dialog $::focused_window}
+ -command {menu_font_dialog}
}
$mymenu add command -label [_ "Tidy Up"] \
- -command {pdsend "$::focused_window tidy"}
- $mymenu add command -label [_ "Toggle Console"] -accelerator "Shift+$accelerator+R" \
- -command {.controls.switches.console invoke}
- $mymenu add command -label [_ "Clear Console"] -accelerator "Shift+$accelerator+L" \
- -command {menu_clear_console}
+ -command {menu_send $::focused_window tidy}
+ $mymenu add command -label [_ "Clear Console"] \
+ -accelerator "Shift+$accelerator+L" -command {menu_clear_console}
$mymenu add separator
- #TODO madness! how to do set the state of the check box without invoking the menu!
+ #TODO madness! how to set the state of the check box without invoking the menu!
$mymenu add check -label [_ "Edit Mode"] -accelerator "$accelerator+E" \
- -selectcolor grey85 \
- -command {pdsend "$::focused_window editmode 0"}
- #if { ! [catch {console hide}]} {
- # TODO set up menu item to show/hide the Tcl/Tk console, if it available
- #}
-
- if {$::windowingsystem ne "aqua"} {
- $mymenu add separator
- $mymenu add command -label [_ "Preferences"] \
- -command {menu_preferences_dialog}
- }
+ -selectcolor grey85 -variable ::editmode_button \
+ -command {menu_editmode $::editmode_button}
}
-proc ::pd_menus::build_put_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_put_menu {mymenu} {
variable accelerator
+ # The trailing 0 in menu_send_float basically means leave the object box
+ # sticking to the mouse cursor. The iemguis alway do that when created
+ # from the menu, as defined in canvas_iemguis()
$mymenu add command -label [_ "Object"] -accelerator "$accelerator+1" \
- -command {pdsend "$::focused_window obj 0"}
+ -command {menu_send_float $::focused_window obj 0}
$mymenu add command -label [_ "Message"] -accelerator "$accelerator+2" \
- -command {pdsend "$::focused_window msg 0"}
+ -command {menu_send_float $::focused_window msg 0}
$mymenu add command -label [_ "Number"] -accelerator "$accelerator+3" \
- -command {pdsend "$::focused_window floatatom 0"}
+ -command {menu_send_float $::focused_window floatatom 0}
$mymenu add command -label [_ "Symbol"] -accelerator "$accelerator+4" \
- -command {pdsend "$::focused_window symbolatom 0"}
+ -command {menu_send_float $::focused_window symbolatom 0}
$mymenu add command -label [_ "Comment"] -accelerator "$accelerator+5" \
- -command {pdsend "$::focused_window text 0"}
+ -command {menu_send_float $::focused_window text 0}
$mymenu add separator
$mymenu add command -label [_ "Bang"] -accelerator "Shift+$accelerator+B" \
- -command {pdsend "$::focused_window bng 0"}
+ -command {menu_send $::focused_window bng}
$mymenu add command -label [_ "Toggle"] -accelerator "Shift+$accelerator+T" \
- -command {pdsend "$::focused_window toggle 0"}
+ -command {menu_send $::focused_window toggle}
$mymenu add command -label [_ "Number2"] -accelerator "Shift+$accelerator+N" \
- -command {pdsend "$::focused_window numbox 0"}
+ -command {menu_send $::focused_window numbox}
$mymenu add command -label [_ "Vslider"] -accelerator "Shift+$accelerator+V" \
- -command {pdsend "$::focused_window vslider 0"}
+ -command {menu_send $::focused_window vslider}
$mymenu add command -label [_ "Hslider"] -accelerator "Shift+$accelerator+H" \
- -command {pdsend "$::focused_window hslider 0"}
+ -command {menu_send $::focused_window hslider}
$mymenu add command -label [_ "Vradio"] -accelerator "Shift+$accelerator+D" \
- -command {pdsend "$::focused_window vradio 0"}
+ -command {menu_send $::focused_window vradio}
$mymenu add command -label [_ "Hradio"] -accelerator "Shift+$accelerator+I" \
- -command {pdsend "$::focused_window hradio 0"}
+ -command {menu_send $::focused_window hradio}
$mymenu add command -label [_ "VU Meter"] -accelerator "Shift+$accelerator+U"\
- -command {pdsend "$::focused_window vumeter 0"}
+ -command {menu_send $::focused_window vumeter}
$mymenu add command -label [_ "Canvas"] -accelerator "Shift+$accelerator+C" \
- -command {pdsend "$::focused_window mycnv 0"}
+ -command {menu_send $::focused_window mycnv}
$mymenu add separator
- $mymenu add command -label [_ "Graph"] -command {pdsend "$::focused_window graph"}
- $mymenu add command -label [_ "Array"] -command {pdsend "$::focused_window menuarray"}
+ $mymenu add command -label [_ "Graph"] -command {menu_send $::focused_window graph}
+ $mymenu add command -label [_ "Array"] -command {menu_send $::focused_window menuarray}
}
-proc ::pd_menus::build_find_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_find_menu {mymenu} {
variable accelerator
$mymenu add command -label [_ "Find..."] -accelerator "$accelerator+F" \
- -command {::dialog_find::menu_find_dialog $::focused_window}
+ -command {menu_find_dialog}
$mymenu add command -label [_ "Find Again"] -accelerator "$accelerator+G" \
- -command {pdsend "$::focused_window findagain"}
+ -command {menu_send $::focused_window findagain}
$mymenu add command -label [_ "Find Last Error"] \
- -command {pdsend "$::focused_window finderror"}
+ -command {pdsend {pd finderror}}
}
-proc ::pd_menus::build_media_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_media_menu {mymenu} {
variable accelerator
$mymenu add radiobutton -label [_ "DSP On"] -accelerator "$accelerator+/" \
-variable ::dsp -value 1 -command {pdsend "pd dsp 1"}
$mymenu add radiobutton -label [_ "DSP Off"] -accelerator "$accelerator+." \
-variable ::dsp -value 0 -command {pdsend "pd dsp 0"}
+
$mymenu add separator
+ $mymenu add command -label [_ "Test Audio and MIDI..."] \
+ -command {menu_doc_open doc/7.stuff/tools testtone.pd}
+ $mymenu add command -label [_ "Load Meter"] \
+ -command {menu_doc_open doc/7.stuff/tools load-meter.pd}
- set audioapi_list_length [llength $::audioapi_list]
- for {set x 0} {$x<$audioapi_list_length} {incr x} {
- # pdtk_post "audio [lindex [lindex $::audioapi_list $x] 0]"
- $mymenu add radiobutton -label [lindex [lindex $::audioapi_list $x] 0] \
+ set audio_apilist_length [llength $::audio_apilist]
+ if {$audio_apilist_length > 0} {$mymenu add separator}
+ for {set x 0} {$x<$audio_apilist_length} {incr x} {
+ $mymenu add radiobutton -label [lindex [lindex $::audio_apilist $x] 0] \
-command {menu_audio 0} -variable ::pd_whichapi \
- -value [lindex [lindex $::audioapi_list $x] 1]\
+ -value [lindex [lindex $::audio_apilist $x] 1]\
-command {pdsend "pd audio-setapi $::pd_whichapi"}
}
- if {$audioapi_list_length > 0} {$mymenu add separator}
-
- set midiapi_list_length [llength $::midiapi_list]
- for {set x 0} {$x<$midiapi_list_length} {incr x} {
- # pdtk_post "midi [lindex [lindex $::midiapi_list $x] 0]"
- $mymenu add radiobutton -label [lindex [lindex $::midiapi_list $x] 0] \
+
+ set midi_apilist_length [llength $::midi_apilist]
+ if {$midi_apilist_length > 0} {$mymenu add separator}
+ for {set x 0} {$x<$midi_apilist_length} {incr x} {
+ $mymenu add radiobutton -label [lindex [lindex $::midi_apilist $x] 0] \
-command {menu_midi 0} -variable ::pd_whichmidiapi \
- -value [lindex [lindex $::midiapi_list $x] 1]\
+ -value [lindex [lindex $::midi_apilist $x] 1]\
-command {pdsend "pd midi-setapi $::pd_whichmidiapi"}
}
- if {$midiapi_list_length > 0} {$mymenu add separator}
-
if {$::windowingsystem ne "aqua"} {
- $mymenu add command -label [_ "Audio settings..."] \
- -command {pdsend "pd audio-properties"}
- $mymenu add command -label [_ "MIDI settings..."] \
- -command {pdsend "pd midi-properties"}
$mymenu add separator
+ create_preferences_menu $mymenu.preferences
+ $mymenu add cascade -label [_ "Preferences"] -menu $mymenu.preferences
}
- $mymenu add command -label [_ "Test Audio and MIDI..."] \
- -command {menu_doc_open doc/7.stuff/tools testtone.pd}
- $mymenu add command -label [_ "Load Meter"] \
- -command {menu_doc_open doc/7.stuff/tools load-meter.pd}
}
-proc ::pd_menus::build_window_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_window_menu {mymenu} {
variable accelerator
if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Minimize"] -command {menu_minimize .} \
- -accelerator "$accelerator+M"
- $mymenu add command -label [_ "Zoom"] -command {menu_zoom .}
+ $mymenu add command -label [_ "Minimize"] -accelerator "$accelerator+M"\
+ -command {menu_minimize $::focused_window}
+ $mymenu add command -label [_ "Zoom"] \
+ -command {menu_maximize $::focused_window}
$mymenu add separator
+ $mymenu add command -label [_ "Bring All to Front"] \
+ -command {menu_bringalltofront}
+ } else {
+ $mymenu add command -label [_ "Next Window"] \
+ -command {menu_raisenextwindow} \
+ -accelerator [_ "$accelerator+Page Down"]
+ $mymenu add command -label [_ "Previous Window"] \
+ -command {menu_raisepreviouswindow} \
+ -accelerator [_ "$accelerator+Page Up"]
}
- $mymenu add command -label [_ "Parent Window"] \
- -command {pdsend "$::focused_window findparent"}
+ $mymenu add separator
$mymenu add command -label [_ "Pd window"] -command {menu_raise_pdwindow} \
-accelerator "$accelerator+R"
+ $mymenu add command -label [_ "Parent Window"] \
+ -command {menu_send $::focused_window findparent}
$mymenu add separator
- if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Bring All to Front"] \
- -command {menu_bringalltofront}
- $mymenu add separator
- }
}
-proc ::pd_menus::build_help_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_help_menu {mymenu} {
if {$::windowingsystem ne "aqua"} {
- $mymenu add command -label [_ "About Pd"] \
- -command {menu_doc_open doc/1.manual 1.introduction.txt}
+ $mymenu add command -label [_ "About Pd"] -command {menu_aboutpd}
}
$mymenu add command -label [_ "HTML Manual..."] \
-command {menu_doc_open doc/1.manual index.htm}
$mymenu add command -label [_ "Browser..."] \
- -command {placeholder menu_helpbrowser \$help_top_directory}
+ -command {menu_helpbrowser}
+ $mymenu add separator
+ $mymenu add command -label [_ "puredata.info"] \
+ -command {menu_openfile {http://puredata.info}}
+ $mymenu add command -label [_ "Report a bug"] -command {menu_openfile \
+ {http://sourceforge.net/tracker/?func=add&group_id=55736&atid=478070}}
+ $mymenu add separator
+ $mymenu add command -label [_ "Tcl prompt"] -command \
+ {::pdwindow::create_tcl_entry}
+
+}
+
+#------------------------------------------------------------------------------#
+# undo/redo menu items
+
+proc ::pd_menus::update_undo_on_menu {mytoplevel} {
+ variable menubar
+ if {$mytoplevel eq $::undo_toplevel && $::undo_action ne "no"} {
+ $menubar.edit entryconfigure 0 -state normal \
+ -label [_ "Undo $::undo_action"]
+ } else {
+ $menubar.edit entryconfigure 0 -state disabled -label [_ "Undo"]
+ }
+ if {$mytoplevel eq $::undo_toplevel && $::redo_action ne "no"} {
+ $menubar.edit entryconfigure 1 -state normal \
+ -label [_ "Redo $::redo_action"]
+ } else {
+ $menubar.edit entryconfigure 1 -state disabled -label [_ "Redo"]
+ }
}
# ------------------------------------------------------------------------------
@@ -323,14 +344,14 @@ proc ::pd_menus::clear_recentfiles_menu {} {
proc ::pd_menus::update_openrecent_menu_aqua {mymenu} {
if {! [winfo exists $mymenu]} {menu $mymenu}
$mymenu delete 0 end
- foreach filename $::recentfiles_list {
- puts "creating menu item for $filename"
- $mymenu add command -label [file tail $filename] \
- -command "open_file $filename"
- }
$mymenu add separator
$mymenu add command -label [_ "Clear Menu"] \
-command "::pd_menus::clear_recentfiles_menu"
+ # newest need to be on top, but the list in oldest first, so insert
+ foreach filename $::recentfiles_list {
+ $mymenu insert 0 command -label [file tail $filename] \
+ -command "open_file {$filename}"
+ }
}
# this expects to be run on the File menu, and to insert above the last separator
@@ -345,12 +366,98 @@ proc ::pd_menus::update_recentfiles_on_menu {mymenu} {
if {$top_separator < [expr $bottom_separator-1]} {
$mymenu delete [expr $top_separator+1] [expr $bottom_separator-1]
}
- set i 0
foreach filename $::recentfiles_list {
- $mymenu insert [expr $top_separator+$i+1] command \
- -label [file tail $filename] -command "open_file $filename"
- incr i
+ $mymenu insert [expr $top_separator+1] command \
+ -label [file tail $filename] -command "open_file {$filename}"
+ }
+}
+
+
+# ------------------------------------------------------------------------------
+# lots of crazy recursion to update the Window menu
+
+# find the first parent patch that has a mapped window
+proc ::pd_menus::find_mapped_parent {parentlist} {
+ if {[llength $parentlist] == 0} {return "none"}
+ set firstparent [lindex $parentlist 0]
+ if {[winfo exists $firstparent]} {
+ return $firstparent
+ } elseif {[llength $parentlist] > 1} {
+ return [find_mapped_parent [lrange $parentlist 1 end]]
+ } else {
+ # we must be the first menu item to be inserted
+ return "none"
+ }
+}
+
+# find the first parent patch that has a mapped window
+proc ::pd_menus::insert_into_menu {mymenu entry parent} {
+ set insertat [$mymenu index end]
+ for {set i 0} {$i <= [$mymenu index end]} {incr i} {
+ if {[$mymenu type $i] ne "command"} {continue}
+ set currentcommand [$mymenu entrycget $i -command]
+ if {$currentcommand eq "raise $entry"} {return} ;# it exists already
+ if {$currentcommand eq "raise $parent"} {
+ set insertat $i
+ }
+ }
+ incr insertat
+ set label ""
+ for {set i 0} {$i < [llength $::parentwindows($entry)]} {incr i} {
+ append label " "
}
+ append label $::windowname($entry)
+ $mymenu insert $insertat command -label $label -command "raise $entry"
+}
+
+# recurse through a list of parent windows and add to the menu
+proc ::pd_menus::add_list_to_menu {mymenu window parentlist} {
+ if {[llength $parentlist] == 0} {
+ insert_into_menu $mymenu $window {}
+ } else {
+ set entry [lindex $parentlist end]
+ if {[winfo exists $entry]} {
+ insert_into_menu $mymenu $entry \
+ [find_mapped_parent $::parentwindows($entry)]
+ }
+ }
+ if {[llength $parentlist] > 1} {
+ add_list_to_menu $mymenu $window [lrange $parentlist 0 end-1]
+ }
+}
+
+# update the list of windows on the Window menu. This expects run on the
+# Window menu, and to insert below the last separator
+proc ::pd_menus::update_window_menu {} {
+ set mymenu $::patch_menubar.window
+ # find the last separator and delete everything after that
+ for {set i 0} {$i <= [$mymenu index end]} {incr i} {
+ if {[$mymenu type $i] eq "separator"} {
+ set deleteat $i
+ }
+ }
+ $mymenu delete $deleteat end
+ $mymenu add separator
+ foreach window [array names ::parentwindows] {
+ set parentlist $::parentwindows($window)
+ add_list_to_menu $mymenu $window $parentlist
+ insert_into_menu $mymenu $window [find_mapped_parent $parentlist]
+ }
+}
+
+# ------------------------------------------------------------------------------
+# submenu for Preferences, now used on all platforms
+
+proc ::pd_menus::create_preferences_menu {mymenu} {
+ menu $mymenu
+ $mymenu add command -label [_ "Path..."] \
+ -command {pdsend "pd start-path-dialog"}
+ $mymenu add command -label [_ "Startup..."] \
+ -command {pdsend "pd start-startup-dialog"}
+ $mymenu add command -label [_ "Audio Settings..."] \
+ -command {pdsend "pd audio-properties"}
+ $mymenu add command -label [_ "MIDI Settings..."] \
+ -command {pdsend "pd midi-properties"}
}
# ------------------------------------------------------------------------------
@@ -360,16 +467,14 @@ proc ::pd_menus::update_recentfiles_on_menu {mymenu} {
proc ::pd_menus::create_apple_menu {mymenu} {
# TODO this should open a Pd patch called about.pd
menu $mymenu.apple
- $mymenu.apple add command -label [_ "About Pd"] \
- -command {menu_doc_open doc/1.manual 1.introduction.txt}
- $mymenu add cascade -label "Apple" -menu $mymenu.apple
+ $mymenu.apple add command -label [_ "About Pd"] -command {menu_aboutpd}
$mymenu.apple add separator
- # starting in 8.4.14, this is created automatically
- set patchlevel [split [info patchlevel] .]
- if {[lindex $patchlevel 1] < 5 && [lindex $patchlevel 2] < 14} {
- $mymenu.apple add command -label [_ "Preferences..."] \
- -command {menu_preferences_dialog" -accelerator "Cmd+,}
- }
+ create_preferences_menu $mymenu.apple.preferences
+ $mymenu.apple add cascade -label [_ "Preferences"] \
+ -menu $mymenu.apple.preferences
+ # this needs to be last for things to function properly
+ $mymenu add cascade -label "Apple" -menu $mymenu.apple
+
}
proc ::pd_menus::build_file_menu_aqua {mymenu} {
@@ -385,7 +490,7 @@ proc ::pd_menus::build_file_menu_aqua {mymenu} {
#$mymenu add command -label [_ "Save All"]
#$mymenu add command -label [_ "Revert to Saved"]
$mymenu add separator
- $mymenu add command -label [_ "Message"]
+ $mymenu add command -label [_ "Message..."]
$mymenu add separator
$mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
}
@@ -412,7 +517,7 @@ proc ::pd_menus::build_file_menu_x11 {mymenu} {
$mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
# $mymenu add command -label "Revert"
$mymenu add separator
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+M"
+ $mymenu add command -label [_ "Message..."] -accelerator "$accelerator+M"
$mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
$mymenu add separator
# the recent files get inserted in here by update_recentfiles_on_menu
@@ -436,10 +541,16 @@ proc ::pd_menus::build_window_menu_x11 {mymenu} {
# menu building functions for Windows/Win32
# for Windows only
-proc ::pd_menus::create_system_menu {mymenu} {
- $mymenu add cascade -menu [menu $mymenu.system]
+proc ::pd_menus::create_system_menu {mymenubar} {
+ set mymenu $mymenubar.system
+ $mymenubar add cascade -label System -menu $mymenu
+ menu $mymenu -tearoff 0
+ # placeholders
+ $mymenu add command -label [_ "Edit Mode"] -command "::pdwindow::verbose 0 systemmenu"
# TODO add Close, Minimize, etc and whatever else is on the little menu
# that is on the top left corner of the window frame
+ # http://wiki.tcl.tk/1006
+ # TODO add Edit Mode here
}
proc ::pd_menus::build_file_menu_win32 {mymenu} {
@@ -451,7 +562,9 @@ proc ::pd_menus::build_file_menu_win32 {mymenu} {
$mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
# $mymenu add command -label "Revert"
$mymenu add separator
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+M"
+ $mymenu add command -label [_ "Message..."] -accelerator "$accelerator+M"
+ create_preferences_menu $mymenu.preferences
+ $mymenu add cascade -label [_ "Preferences"] -menu $mymenu.preferences
$mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
$mymenu add separator
# the recent files get inserted in here by update_recentfiles_on_menu
diff --git a/pd/tcl/pdtk_canvas.tcl b/pd/tcl/pdtk_canvas.tcl
index 31505cec..c1a85420 100644
--- a/pd/tcl/pdtk_canvas.tcl
+++ b/pd/tcl/pdtk_canvas.tcl
@@ -4,38 +4,103 @@ package provide pdtk_canvas 0.1
package require pd_bindings
namespace eval ::pdtk_canvas:: {
+ namespace export pdtk_canvas_popup
+ namespace export pdtk_canvas_editmode
+ namespace export pdtk_canvas_getscroll
+ namespace export pdtk_canvas_setparents
+ namespace export pdtk_canvas_reflecttitle
+ namespace export pdtk_canvas_menuclose
}
+# One thing that is tricky to understand is the difference between a Tk
+# 'canvas' and a 'canvas' in terms of Pd's implementation. They are similar,
+# but not the same thing. In Pd code, a 'canvas' is basically a patch, while
+# the Tk 'canvas' is the backdrop for drawing everything that is in a patch.
+# The Tk 'canvas' is contained in a 'toplevel' window. That window has a Tk
+# class of 'PatchWindow'.
+
# TODO figure out weird frameless window when you open a graph
+
+#TODO: http://wiki.tcl.tk/11502
+# MS Windows
+#wm geometry . returns contentswidthxcontentsheight+decorationTop+decorationLeftEdge.
+#and
+#winfo rooty . returns contentsTop
+#winfo rootx . returns contentsLeftEdge
+
+
#------------------------------------------------------------------------------#
# canvas new/saveas
proc pdtk_canvas_new {mytoplevel width height geometry editable} {
- # TODO check size of window
- toplevel $mytoplevel -width $width -height $height -class CanvasWindow
+ set screenwidth [winfo screenwidth .]
+ set screenheight [winfo screenheight .]
+
+ # read back the current geometry +posx+posy into variables
+ scan $geometry {%[+]%d%[+]%d} - x - y
+ # fit the geometry onto screen
+ set x [ expr $x % $screenwidth - $::windowframex]
+ set y [ expr $y % $screenheight - $::windowframey]
+ if {$width > $screenwidth} {
+ set width $screenwidth
+ set x 0
+ }
+ if {$height > $screenheight} {
+ set height [expr $screenheight - $::menubarsize - 30] ;# 30 for window framing
+ set y $::menubarsize
+ }
+ set geometry ${width}x$height+$x+$y
+
+ # release the window grab here so that the new window will
+ # properly get the Map and FocusIn events when its created
+ ::pdwindow::busyrelease
+ # set the loaded array for this new window so things can track state
+ set ::loaded($mytoplevel) 0
+ toplevel $mytoplevel -width $width -height $height -class PatchWindow
wm group $mytoplevel .
- $mytoplevel configure -menu .menubar
+ $mytoplevel configure -menu $::patch_menubar
+
+ # we have to wait until $mytoplevel exists before we can generate
+ # a <<Loading>> event for it, that's why this is here and not in the
+ # started_loading_file proc. Perhaps this doesn't make sense tho
+ event generate $mytoplevel <<Loading>>
- # TODO slide off screen windows into view
wm geometry $mytoplevel $geometry
- if {$::windowingsystem eq "aqua"} { # no menubar, it can be small
- wm minsize $mytoplevel 50 20
- } else { # leave room for the menubar
- wm minsize $mytoplevel 310 30
- }
-
- set ::editmode($mytoplevel) $editable
+ wm minsize $mytoplevel $::canvas_minwidth $::canvas_minheight
- set mycanvas $mytoplevel.c
- canvas $mycanvas -width $width -height $height -background white \
- -highlightthickness 0
- # TODO add scrollbars here
- pack $mycanvas -side left -expand 1 -fill both
+ set tkcanvas [tkcanvas_name $mytoplevel]
+ canvas $tkcanvas -width $width -height $height \
+ -highlightthickness 0 -scrollregion [list 0 0 $width $height] \
+ -xscrollcommand "$mytoplevel.xscroll set" \
+ -yscrollcommand "$mytoplevel.yscroll set"
+ scrollbar $mytoplevel.xscroll -orient horizontal -command "$tkcanvas xview"
+ scrollbar $mytoplevel.yscroll -orient vertical -command "$tkcanvas yview"
+ pack $tkcanvas -side left -expand 1 -fill both
+
+ ::pd_bindings::patch_bindings $mytoplevel
+
+ # give focus to the canvas so it gets the events rather than the window
+ focus $tkcanvas
- ::pd_bindings::canvas_bindings $mytoplevel
+ # let the scrollbar logic determine if it should make things scrollable
+ set ::xscrollable($tkcanvas) 0
+ set ::yscrollable($tkcanvas) 0
- # give focus to the canvas so it gets the events rather than the window
+ # init patch properties arrays
+ set ::editingtext($mytoplevel) 0
+ set ::childwindows($mytoplevel) {}
+
+ # this should be at the end so that the window and canvas are all ready
+ # before this variable changes.
+ set ::editmode($mytoplevel) $editable
+}
+
+# if the patch canvas window already exists, then make it come to the front
+proc pdtk_canvas_raise {mytoplevel} {
+ wm deiconify $mytoplevel
+ raise $mytoplevel
+ set mycanvas $mytoplevel.c
focus $mycanvas
}
@@ -61,36 +126,60 @@ proc pdtk_canvas_saveas {name initialfile initialdir} {
set dirname [file dirname $filename]
set basename [file tail $filename]
pdsend "$name savetofile [enquote_path $basename] [enquote_path $dirname]"
- set ::pd_menucommands::menu_new_dir $dirname
+ set ::filenewdir $dirname
+}
+
+##### ask user Save? Discard? Cancel?, and if so, send a message on to Pd ######
+proc ::pdtk_canvas::pdtk_canvas_menuclose {mytoplevel reply_to_pd} {
+ raise $mytoplevel
+ set filename [wm title $mytoplevel]
+ set message [format {Do you want to save the changes you made in "%s"?} $filename]
+ set answer [tk_messageBox -message $message -type yesnocancel -default "yes" \
+ -parent $mytoplevel -icon question]
+ switch -- $answer {
+ yes {
+ pdsend "$mytoplevel menusave"
+ if {[regexp {Untitled-[0-9]+} $filename]} {
+ # wait until pdtk_canvas_saveas finishes and writes to
+ # this var, otherwise the close command will be sent
+ # immediately and the file won't get saved
+ vwait ::filenewdir
+ }
+ pdsend $reply_to_pd
+ }
+ no {pdsend $reply_to_pd}
+ cancel {}
+ }
}
#------------------------------------------------------------------------------#
# mouse usage
-proc pdtk_canvas_motion {mycanvas x y mods} {
- set mytoplevel [winfo toplevel $mycanvas]
- pdsend "$mytoplevel motion [$mycanvas canvasx $x] [$mycanvas canvasy $y] $mods"
+# TODO put these procs into the pdtk_canvas namespace
+proc pdtk_canvas_motion {tkcanvas x y mods} {
+ set mytoplevel [winfo toplevel $tkcanvas]
+ pdsend "$mytoplevel motion [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $mods"
}
-proc pdtk_canvas_mouse {mycanvas x y b f} {
- set mytoplevel [winfo toplevel $mycanvas]
- pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b $f"
+proc pdtk_canvas_mouse {tkcanvas x y b f} {
+ set mytoplevel [winfo toplevel $tkcanvas]
+ pdsend "$mytoplevel mouse [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b $f"
}
-proc pdtk_canvas_mouseup {mycanvas x y b} {
- set mytoplevel [winfo toplevel $mycanvas]
- pdsend "$mytoplevel mouseup [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b"
+proc pdtk_canvas_mouseup {tkcanvas x y b} {
+ set mytoplevel [winfo toplevel $tkcanvas]
+ pdsend "$mytoplevel mouseup [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b"
}
-proc pdtk_canvas_rightclick {mycanvas x y b} {
- set mytoplevel [winfo toplevel $mycanvas]
- pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b 8"
+proc pdtk_canvas_rightclick {tkcanvas x y b} {
+ set mytoplevel [winfo toplevel $tkcanvas]
+ pdsend "$mytoplevel mouse [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b 8"
}
# on X11, button 2 pastes from X11 clipboard, so simulate normal paste actions
-proc pdtk_canvas_clickpaste {mycanvas x y b} {
- pdtk_canvas_mouse $mycanvas $x $y $b 0
- pdtk_canvas_mouseup $mycanvas $x $y $b
+proc pdtk_canvas_clickpaste {tkcanvas x y b} {
+ pdtk_canvas_mouse $tkcanvas $x $y $b 0
+ pdtk_canvas_mouseup $tkcanvas $x $y $b
pdtk_pastetext
}
@@ -107,21 +196,21 @@ proc ::pdtk_canvas::create_popup {} {
# the popup menu for the canvas
menu .popup -tearoff false
.popup add command -label [_ "Properties"] \
- -command {popup_action $::focused_window 0}
+ -command {::pdtk_canvas::done_popup $::focused_window 0}
.popup add command -label [_ "Open"] \
- -command {popup_action $::focused_window 1}
+ -command {::pdtk_canvas::done_popup $::focused_window 1}
.popup add command -label [_ "Help"] \
- -command {popup_action $::focused_window 2}
+ -command {::pdtk_canvas::done_popup $::focused_window 2}
}
}
-proc popup_action {mytoplevel action} {
- pdsend "$mytoplevel done-popup $action $::popup_xpix $::popup_ypix"
+proc ::pdtk_canvas::done_popup {mytoplevel action} {
+ pdsend "$mytoplevel done-popup $action $::popup_xcanvas $::popup_ycanvas"
}
-proc pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} {
- set ::popup_xpix $xpix
- set ::popup_ypix $ypix
+proc ::pdtk_canvas::pdtk_canvas_popup {mytoplevel xcanvas ycanvas hasproperties hasopen} {
+ set ::popup_xcanvas $xcanvas
+ set ::popup_ycanvas $ycanvas
if {$hasproperties} {
.popup entryconfigure [_ "Properties"] -state normal
} else {
@@ -132,38 +221,144 @@ proc pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} {
} else {
.popup entryconfigure [_ "Open"] -state disabled
}
- set mycanvas "$mytoplevel.c"
- tk_popup .popup [expr $xpix + [winfo rootx $mycanvas]] \
- [expr $ypix + [winfo rooty $mycanvas]] 0
+ set tkcanvas [tkcanvas_name $mytoplevel]
+ set scrollregion [$tkcanvas cget -scrollregion]
+ # get the canvas location that is currently the top left corner in the window
+ set left_xview_pix [expr [lindex [$tkcanvas xview] 0] * [lindex $scrollregion 2]]
+ set top_yview_pix [expr [lindex [$tkcanvas yview] 0] * [lindex $scrollregion 3]]
+ # take the mouse clicks in canvas coords, add the root of the canvas
+ # window, and subtract the area that is obscured by scrolling
+ set xpopup [expr int($xcanvas + [winfo rootx $tkcanvas] - $left_xview_pix)]
+ set ypopup [expr int($ycanvas + [winfo rooty $tkcanvas] - $top_yview_pix)]
+ tk_popup .popup $xpopup $ypopup 0
}
#------------------------------------------------------------------------------#
+# procs for when file loading starts/finishes
+
+proc ::pdtk_canvas::started_loading_file {patchname} {
+ ::pdwindow::busygrab
+}
+
+# things to run when a patch is finished loading. This is called when
+# the OS sends the "Map" event for this window.
+proc ::pdtk_canvas::finished_loading_file {mytoplevel} {
+ # ::pdwindow::busyrelease is in pdtk_canvas_new so that the grab
+ # is released before the new toplevel window gets created.
+ # Otherwise the grab blocks the new window from getting the
+ # FocusIn event on creation.
+
+ # set editmode to make sure the menu item is in the right state
+ pdtk_canvas_editmode $mytoplevel $::editmode($mytoplevel)
+ set ::loaded($mytoplevel) 1
+ # send the virtual events now that everything is loaded
+ event generate $mytoplevel <<Loaded>>
+}
+
+#------------------------------------------------------------------------------#
# procs for canvas events
# check or uncheck the "edit" menu item
-proc pdtk_canvas_editval {mytoplevel value} {
- set ::editmode($mytoplevel) $value
-# TODO figure how to change Edit Mode/Interact Mode text and have menu
-# enabling and disabling working still in pd_menus.tcl
-# if {$value == 0} {
-# $::pd_menus::menubar.edit entryconfigure [_ "Interact Mode"] -label [_ "Edit Mode"]
-# } else {
-# $::pd_menus::menubar.edit entryconfigure [_ "Edit Mode"] -label [_ "Interact Mode"]
-# }
- #$mytoplevel.menubar.edit entryconfigure [_ "Edit Mode"] -indicatoron $value
- # TODO make this work, probably with a proc in pd_menus, or maybe the menu
- # item can track the editmode variable
-}
-
-proc pdtk_undomenu {args} {
- # TODO make this work, probably with a proc in pd_menus
- puts "pdtk_undomenu $args"
-}
-
-proc pdtk_canvas_getscroll {mycanvas} {
- # TODO make this work
- # the C code still sends a .c canvas, so get the toplevel
- set mytoplevel [winfo toplevel $mycanvas]
- # puts stderr "pdtk_canvas_getscroll $mycanvas"
+proc ::pdtk_canvas::pdtk_canvas_editmode {mytoplevel state} {
+ set ::editmode_button $state
+ set ::editmode($mytoplevel) $state
+ event generate $mytoplevel <<EditMode>>
+ # can't change the menu background color on Aqua
+ if {$::windowingsystem eq "aqua"} {return}
+ if {$state == 0} {
+ $::pd_menus::menubar.edit entryconfigure [_ "Edit Mode"] -background {}
+ } else {
+ $::pd_menus::menubar.edit entryconfigure [_ "Edit Mode"] -background green
+ }
+}
+
+# message from Pd to update the currently available undo/redo action
+proc pdtk_undomenu {mytoplevel undoaction redoaction} {
+ set ::undo_toplevel $mytoplevel
+ set ::undo_action $undoaction
+ set ::redo_action $redoaction
+ if {$mytoplevel ne "nobody"} {
+ ::pd_menus::update_undo_on_menu $mytoplevel
+ }
+}
+
+# This proc configures the scrollbars whenever anything relevant has
+# been updated. It should always receive a tkcanvas, which is then
+# used to generate the mytoplevel, needed to address the scrollbars.
+proc ::pdtk_canvas::pdtk_canvas_getscroll {tkcanvas} {
+ set mytoplevel [winfo toplevel $tkcanvas]
+ set bbox [$tkcanvas bbox all]
+ if {$bbox eq "" || [llength $bbox] != 4} {return}
+ set xupperleft [lindex $bbox 0]
+ set yupperleft [lindex $bbox 1]
+ if {$xupperleft > 0} {set xupperleft 0}
+ if {$yupperleft > 0} {set yupperleft 0}
+ set scrollregion [concat $xupperleft $yupperleft [lindex $bbox 2] [lindex $bbox 3]]
+ $tkcanvas configure -scrollregion $scrollregion
+ # X scrollbar
+ if {[lindex [$tkcanvas xview] 0] == 0.0 && [lindex [$tkcanvas xview] 1] == 1.0} {
+ set ::xscrollable($tkcanvas) 0
+ pack forget $mytoplevel.xscroll
+ } else {
+ set ::xscrollable($tkcanvas) 1
+ pack $mytoplevel.xscroll -side bottom -fill x -before $tkcanvas
+ }
+ # Y scrollbar, it gets touchy at the limit, so say > 0.995
+ if {[lindex [$tkcanvas yview] 0] == 0.0 && [lindex [$tkcanvas yview] 1] > 0.995} {
+ set ::yscrollable($tkcanvas) 0
+ pack forget $mytoplevel.yscroll
+ } else {
+ set ::yscrollable($tkcanvas) 1
+ pack $mytoplevel.yscroll -side right -fill y -before $tkcanvas
+ }
+}
+
+proc ::pdtk_canvas::scroll {tkcanvas axis amount} {
+ if {$axis eq "x" && $::xscrollable($tkcanvas) == 1} {
+ $tkcanvas xview scroll [expr {- ($amount)}] units
+ }
+ if {$axis eq "y" && $::yscrollable($tkcanvas) == 1} {
+ $tkcanvas yview scroll [expr {- ($amount)}] units
+ }
+}
+
+#------------------------------------------------------------------------------#
+# get patch window child/parent relationships
+
+# add a child window ID to the list of children, if it isn't already there
+proc ::pdtk_canvas::addchild {mytoplevel child} {
+ # if either ::childwindows($mytoplevel) does not exist, or $child does not
+ # exist inside of the ::childwindows($mytoplevel list
+ if { [lsearch -exact [array names ::childwindows $mytoplevel]] == -1 \
+ || [lsearch -exact $::childwindows($mytoplevel) $child] == -1} {
+ set ::childwindows($mytoplevel) [lappend ::childwindows($mytoplevel) $child]
+ }
+}
+
+# receive a list of all my parent windows from 'pd'
+proc ::pdtk_canvas::pdtk_canvas_setparents {mytoplevel args} {
+ set ::parentwindows($mytoplevel) $args
+ foreach parent $args {
+ addchild $parent $mytoplevel
+ }
+}
+
+# receive information for setting the info the the title bar of the window
+proc ::pdtk_canvas::pdtk_canvas_reflecttitle {mytoplevel \
+ path name arguments dirty} {
+ set ::windowname($mytoplevel) $name ;# TODO add path to this
+ if {$::windowingsystem eq "aqua"} {
+ wm attributes $mytoplevel -modified $dirty
+ if {[file exists "$path/$name"]} {
+ # for some reason -titlepath can still fail so just catch it
+ if [catch {wm attributes $mytoplevel -titlepath "$path/$name"}] {
+ wm title $mytoplevel "$path/$name"
+ }
+ }
+ wm title $mytoplevel "$name$arguments"
+ } else {
+ if {$dirty} {set dirtychar "*"} else {set dirtychar " "}
+ wm title $mytoplevel "$name$dirtychar$arguments - $path"
+ }
}
diff --git a/pd/tcl/pdtk_text.tcl b/pd/tcl/pdtk_text.tcl
index bb37ccc3..5818926c 100644
--- a/pd/tcl/pdtk_text.tcl
+++ b/pd/tcl/pdtk_text.tcl
@@ -1,20 +1,53 @@
package provide pdtk_text 0.1
-############ pdtk_text_new -- create a new text object #2###########
-proc pdtk_text_new {mycanvas canvasitem x y text font_size color} {
- $mycanvas create text $x $y -tags $canvasitem -text $text -fill $color \
+# these procs are currently all in the global namespace because all of them
+# are used by 'pd' and therefore need to be in the global namespace.
+
+# create a new text object (ie. obj, msg, comment)
+proc pdtk_text_new {tkcanvas tags x y text font_size color} {
+ $tkcanvas create text $x $y -tags $tags -text $text -fill $color \
-anchor nw -font [get_font_for_size $font_size]
- $mycanvas bind $canvasitem <Home> "$mycanvas icursor $canvasitem 0"
- $mycanvas bind $canvasitem <End> "$mycanvas icursor $canvasitem end"
+ set mytag [lindex $tags 0]
+ $tkcanvas bind $mytag <Home> "$tkcanvas icursor $mytag 0"
+ $tkcanvas bind $mytag <End> "$tkcanvas icursor $mytag end"
+ # select all
+ $tkcanvas bind $mytag <Triple-ButtonRelease-1> \
+ "pdtk_text_selectall $tkcanvas $mytag"
if {$::windowingsystem eq "aqua"} { # emacs bindings for Mac OS X
- $mycanvas bind $canvasitem <Control-a> "$mycanvas icursor $canvasitem 0"
- $mycanvas bind $canvasitem <Control-e> "$mycanvas icursor $canvasitem end"
+ $tkcanvas bind $mytag <Control-a> "$tkcanvas icursor $mytag 0"
+ $tkcanvas bind $mytag <Control-e> "$tkcanvas icursor $mytag end"
+ }
+}
+
+# change the text in an existing text box
+proc pdtk_text_set {tkcanvas tag text} {
+ $tkcanvas itemconfig $tag -text $text
+}
+
+# paste into an existing text box by literally "typing" the contents of the
+# clipboard, i.e. send the contents one character at a time via 'pd key'
+proc pdtk_pastetext {args} {
+ catch {set pdtk_pastebuffer [clipboard get]}
+ for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} {
+ set cha [string index $pdtk_pastebuffer $i]
+ scan $cha %c keynum
+ pdsend "pd key 1 $keynum 0"
}
}
-################ pdtk_text_set -- change the text ##################
-proc pdtk_text_set {mycanvas canvasitem text} {
- $mycanvas itemconfig $canvasitem -text $text
+# select all of the text in an existing text box
+proc pdtk_text_selectall {tkcanvas mytag} {
+ if {$::editmode([winfo toplevel $tkcanvas])} {
+ $tkcanvas select from $mytag 0
+ $tkcanvas select to $mytag end
+ }
}
+# de/activate a text box for editing based on $editing flag
+proc pdtk_text_editing {mytoplevel tag editing} {
+ set tkcanvas [tkcanvas_name $mytoplevel]
+ if {$editing == 0} {selection clear $tkcanvas}
+ $tkcanvas focus $tag
+ set ::editingtext($mytoplevel) $editing
+}
diff --git a/pd/tcl/pdwindow.tcl b/pd/tcl/pdwindow.tcl
index d0c0c654..bb1e1d65 100644
--- a/pd/tcl/pdwindow.tcl
+++ b/pd/tcl/pdwindow.tcl
@@ -2,52 +2,387 @@
package provide pdwindow 0.1
namespace eval ::pdwindow:: {
- variable consolefont
- variable printout_buffer ""
- variable pdwindow_search_index
+ variable logbuffer {}
+ variable tclentry {}
+ variable tclentry_history {"console show"}
+ variable history_position 0
+ variable linecolor 0 ;# is toggled to alternate text line colors
+ variable logmenuitems
+ variable maxloglevel 4
+ variable lastlevel 0
+
+ namespace export create_window
namespace export pdtk_post
+ namespace export pdtk_pd_dsp
+ namespace export pdtk_pd_dio
+}
+
+# TODO make the Pd window save its size and location between running
+
+proc ::pdwindow::set_layout {} {
+ variable maxloglevel
+ .pdwindow.text.internal tag configure log0 -foreground "#d00" -background "#ffe0e8"
+ .pdwindow.text.internal tag configure log1 -foreground "#d00"
+ # log2 messages are normal black on white
+ .pdwindow.text.internal tag configure log3 -foreground "#484848"
+
+ # 0-20(4-24) is a rough useful range of 'verbose' levels for impl debugging
+ set start 4
+ set end 25
+ for {set i $start} {$i < $end} {incr i} {
+ set B [expr int(($i - $start) * (40 / ($end - $start))) + 50]
+ .pdwindow.text.internal tag configure log${i} -foreground grey${B}
+ }
+}
+
+
+# grab focus on part of the Pd window when Pd is busy
+proc ::pdwindow::busygrab {} {
+ # set the mouse cursor to look busy and grab focus so it stays that way
+ .pdwindow.text configure -cursor watch
+ grab set .pdwindow.text
+}
+
+# release focus on part of the Pd window when Pd is finished
+proc ::pdwindow::busyrelease {} {
+ .pdwindow.text configure -cursor xterm
+ grab release .pdwindow.text
+}
+
+# ------------------------------------------------------------------------------
+# pdtk functions for 'pd' to send data to the Pd window
+
+proc ::pdwindow::buffer_message {object_id level message} {
+ variable logbuffer
+ lappend logbuffer $object_id $level $message
+}
+
+proc ::pdwindow::insert_log_line {object_id level message} {
+ if {$object_id eq ""} {
+ .pdwindow.text.internal insert end $message log$level
+ } else {
+ .pdwindow.text.internal insert end $message [list log$level obj$object_id]
+ .pdwindow.text.internal tag bind obj$object_id <$::modifier-ButtonRelease-1> \
+ "::pdwindow::select_by_id $object_id; break"
+ .pdwindow.text.internal tag bind obj$object_id <Key-Return> \
+ "::pdwindow::select_by_id $object_id; break"
+ .pdwindow.text.internal tag bind obj$object_id <Key-KP_Enter> \
+ "::pdwindow::select_by_id $object_id; break"
+ }
+}
+
+# this has 'args' to satisfy trace, but its not used
+proc ::pdwindow::filter_buffer_to_text {args} {
+ variable logbuffer
+ variable maxloglevel
+ .pdwindow.text.internal delete 0.0 end
+ set i 0
+ foreach {object_id level message} $logbuffer {
+ if { $level <= $::loglevel || $maxloglevel == $::loglevel} {
+ insert_log_line $object_id $level $message
+ }
+ # this could take a while, so update the GUI every 10000 lines
+ if { [expr $i % 10000] == 0} {update idletasks}
+ incr i
+ }
+ .pdwindow.text.internal yview end
+ ::pdwindow::verbose 10 "The Pd window filtered $i lines\n"
+}
+
+proc ::pdwindow::select_by_id {args} {
+ if [llength $args] { # Is $args empty?
+ pdsend "pd findinstance $args"
+ }
+}
+
+# logpost posts to Pd window with an object to trace back to and a
+# 'log level'. The logpost and related procs are for generating
+# messages that are useful for debugging patches. They are messages
+# that are meant for the Pd programmer to see so that they can get
+# information about the patches they are building
+proc ::pdwindow::logpost {object_id level message} {
+ variable maxloglevel
+ variable lastlevel $level
+
+ buffer_message $object_id $level $message
+ if {[llength [info commands .pdwindow.text.internal]] &&
+ ($level <= $::loglevel || $maxloglevel == $::loglevel)} {
+ # cancel any pending move of the scrollbar, and schedule it
+ # after writing a line. This way the scrollbar is only moved once
+ # when the inserting has finished, greatly speeding things up
+ after cancel .pdwindow.text.internal yview end
+ insert_log_line $object_id $level $message
+ after idle .pdwindow.text.internal yview end
+ }
+ # -stderr only sets $::stderr if 'pd-gui' is started before 'pd'
+ if {$::stderr} {puts stderr $message}
+}
+
+# shortcuts for posting to the Pd window
+proc ::pdwindow::fatal {message} {logpost {} 0 $message}
+proc ::pdwindow::error {message} {logpost {} 1 $message}
+proc ::pdwindow::post {message} {logpost {} 2 $message}
+proc ::pdwindow::debug {message} {logpost {} 3 $message}
+# for backwards compatibility
+proc ::pdwindow::bug {message} {logpost {} 3 $message}
+proc ::pdwindow::pdtk_post {message} {post $message}
+
+proc ::pdwindow::endpost {} {
+ variable linecolor
+ variable lastlevel
+ logpost {} $lastlevel "\n"
+ set linecolor [expr ! $linecolor]
+}
+
+# this verbose proc has a separate numbering scheme since its for
+# debugging implementations, and therefore falls outside of the 0-3
+# numbering on the Pd window. They should only be shown in ALL mode.
+proc ::pdwindow::verbose {level message} {
+ incr level 4
+ logpost {} $level $message
+}
+
+# clear the log and the buffer
+proc ::pdwindow::clear_console {} {
+ variable logbuffer {}
+ .pdwindow.text.internal delete 0.0 end
+}
+
+#--compute audio/DSP checkbutton-----------------------------------------------#
+
+# set the checkbox on the "Compute Audio" menuitem and checkbox
+proc ::pdwindow::pdtk_pd_dsp {value} {
+ # TODO canvas_startdsp/stopdsp should really send 1 or 0, not "ON" or "OFF"
+ if {$value eq "ON"} {
+ set ::dsp 1
+ } else {
+ set ::dsp 0
+ }
+}
+
+proc ::pdwindow::pdtk_pd_dio {red} {
+ if {$red == 1} {
+ .pdwindow.header.dio configure -foreground red
+ } else {
+ .pdwindow.header.dio configure -foreground lightgray
+ }
+
}
+#--bindings specific to the Pd window------------------------------------------#
+proc ::pdwindow::pdwindow_bindings {} {
+ # these bindings are for the whole Pd window, minus the Tcl entry
+ foreach window {.pdwindow.text .pdwindow.header} {
+ bind $window <$::modifier-Key-x> "tk_textCut .pdwindow.text"
+ bind $window <$::modifier-Key-c> "tk_textCopy .pdwindow.text"
+ bind $window <$::modifier-Key-v> "tk_textPaste .pdwindow.text"
+ }
+ # Select All doesn't seem to work unless its applied to the whole window
+ bind .pdwindow <$::modifier-Key-a> ".pdwindow.text tag add sel 1.0 end"
+ # the "; break" part stops executing another binds, like from the Text class
+
+ # these don't do anything in the Pd window, so alert the user, then break
+ # so no more bindings run
+ bind .pdwindow <$::modifier-Key-s> "bell; break"
+ bind .pdwindow <$::modifier-Shift-Key-S> "bell; break"
+ bind .pdwindow <$::modifier-Key-p> "bell; break"
-proc ::pdwindow::pdtk_post {message} {
- variable printout_buffer
- # TODO this should be switchable between Pd window and stderr
- if { ! [winfo exists .pdwindow.text]} {
- set printout_buffer "$printout_buffer\n$message"
+ # ways of hiding/closing the Pd window
+ if {$::windowingsystem eq "aqua"} {
+ # on Mac OS X, you can close the Pd window, since the menubar is there
+ bind .pdwindow <$::modifier-Key-w> "wm withdraw .pdwindow"
+ wm protocol .pdwindow WM_DELETE_WINDOW "wm withdraw .pdwindow"
} else {
- if {$printout_buffer ne ""} {
- .pdwindow.text insert end "$printout_buffer\n"
- set printout_buffer ""
+ # TODO should it possible to close the Pd window and keep Pd open?
+ bind .pdwindow <$::modifier-Key-w> "wm iconify .pdwindow"
+ wm protocol .pdwindow WM_DELETE_WINDOW "pdsend \"pd verifyquit\""
+ }
+}
+
+#--Tcl entry procs-------------------------------------------------------------#
+
+# copied from ::pd_connect::pd_readsocket, so perhaps it could be merged
+proc ::pdwindow::eval_tclentry {} {
+ variable tclentry
+ variable tclentry_history
+ variable history_position 0
+ if {$tclentry eq ""} {return} ;# no need to do anything if empty
+ if {[catch {uplevel #0 $tclentry} errorname]} {
+ global errorInfo
+ switch -regexp -- $errorname {
+ "missing close-brace" {
+ ::pdwindow::error [concat [_ "(Tcl) MISSING CLOSE-BRACE '\}': "] $errorInfo]\n
+ } "missing close-bracket" {
+ ::pdwindow::error [concat [_ "(Tcl) MISSING CLOSE-BRACKET '\]': "] $errorInfo]\n
+ } "^invalid command name" {
+ ::pdwindow::error [concat [_ "(Tcl) INVALID COMMAND NAME: "] $errorInfo]\n
+ } default {
+ ::pdwindow::error [concat [_ "(Tcl) UNHANDLED ERROR: "] $errorInfo]\n
+ }
+ }
+ }
+ lappend tclentry_history $tclentry
+ set tclentry {}
+}
+
+proc ::pdwindow::get_history {direction} {
+ variable tclentry_history
+ variable history_position
+
+ incr history_position $direction
+ if {$history_position < 0} {set history_position 0}
+ if {$history_position > [llength $tclentry_history]} {
+ set history_position [llength $tclentry_history]
+ }
+ .pdwindow.tcl.entry delete 0 end
+ .pdwindow.tcl.entry insert 0 \
+ [lindex $tclentry_history end-[expr $history_position - 1]]
+}
+
+proc ::pdwindow::validate_tcl {} {
+ variable tclentry
+ if {[info complete $tclentry]} {
+ .pdwindow.tcl.entry configure -background "white"
+ } else {
+ .pdwindow.tcl.entry configure -background "#FFF0F0"
+ }
+}
+
+#--create tcl entry-----------------------------------------------------------#
+
+proc ::pdwindow::create_tcl_entry {} {
+# Tcl entry box frame
+ label .pdwindow.tcl.label -text [_ "Tcl:"] -anchor e
+ pack .pdwindow.tcl.label -side left
+ entry .pdwindow.tcl.entry -width 200 \
+ -exportselection 1 -insertwidth 2 -insertbackground blue \
+ -textvariable ::pdwindow::tclentry -font {$::font_family 12}
+ pack .pdwindow.tcl.entry -side left -fill x
+# bindings for the Tcl entry widget
+ bind .pdwindow.tcl.entry <$::modifier-Key-a> "%W selection range 0 end; break"
+ bind .pdwindow.tcl.entry <Return> "::pdwindow::eval_tclentry"
+ bind .pdwindow.tcl.entry <Up> "::pdwindow::get_history 1"
+ bind .pdwindow.tcl.entry <Down> "::pdwindow::get_history -1"
+ bind .pdwindow.tcl.entry <KeyRelease> +"::pdwindow::validate_tcl"
+
+ bind .pdwindow.text <Key-Tab> "focus .pdwindow.tcl.entry; break"
+}
+
+proc ::pdwindow::set_findinstance_cursor {widget key state} {
+ set triggerkeys [list Control_L Control_R Meta_L Meta_R]
+ if {[lsearch -exact $triggerkeys $key] > -1} {
+ if {$state == 0} {
+ $widget configure -cursor xterm
+ } else {
+ $widget configure -cursor based_arrow_up
}
- .pdwindow.text insert end "$message\n"
- .pdwindow.text yview end
}
- puts stderr $message
}
+#--create the window-----------------------------------------------------------#
+
proc ::pdwindow::create_window {} {
- variable consolefont
+ variable logmenuitems
+ set ::loaded(.pdwindow) 0
+
+ # colorize by class before creating anything
+ option add *PdWindow*Entry.highlightBackground "grey" startupFile
+ option add *PdWindow*Frame.background "grey" startupFile
+ option add *PdWindow*Label.background "grey" startupFile
+ option add *PdWindow*Checkbutton.background "grey" startupFile
+ option add *PdWindow*Menubutton.background "grey" startupFile
+ option add *PdWindow*Text.background "white" startupFile
+ option add *PdWindow*Entry.background "white" startupFile
+
toplevel .pdwindow -class PdWindow
- wm title .pdwindow [_ "Pd window"]
- wm geometry .pdwindow =500x450+20+50
+ wm title .pdwindow [_ "Pd"]
+ set ::windowname(.pdwindow) [_ "Pd"]
+ if {$::windowingsystem eq "x11"} {
+ wm minsize .pdwindow 400 75
+ } else {
+ wm minsize .pdwindow 400 51
+ }
+ wm geometry .pdwindow =500x400+20+50
.pdwindow configure -menu .menubar
- ::pd_menus::configure_for_pdwindow
- ::pd_bindings::pdwindow_bindings .pdwindow
- frame .pdwindow.header
- pack .pdwindow.header -side top -fill x -padx 30 -ipady 10
- # label .pdwindow.header.label -text "The Pd window wants you to make it look nice!"
- # pack .pdwindow.header.label -side left -fill y -anchor w
+ frame .pdwindow.header -borderwidth 1 -relief flat -background lightgray
+ pack .pdwindow.header -side top -fill x -ipady 5
+
+ frame .pdwindow.header.pad1
+ pack .pdwindow.header.pad1 -side left -padx 12
+
checkbutton .pdwindow.header.dsp -text [_ "DSP"] -variable ::dsp \
- -command "pdsend \"pd dsp 0\""
- pack .pdwindow.header.dsp -side right -fill y -anchor e
+ -font {$::font_family 18 bold} -takefocus 1 -background lightgray \
+ -borderwidth 0 -command {pdsend "pd dsp $::dsp"}
+ pack .pdwindow.header.dsp -side right -fill y -anchor e -padx 5 -pady 0
+# DIO button
+ label .pdwindow.header.dio -text [_ "audio I/O error"] -borderwidth 0 \
+ -background lightgray -foreground lightgray \
+ -takefocus 0 \
+ -font {$::font_family 14}
+ pack .pdwindow.header.dio -side right -fill y -padx 30 -pady 0
+
+ label .pdwindow.header.loglabel -text [_ "Log:"] -anchor e \
+ -background lightgray
+ pack .pdwindow.header.loglabel -side left
+
+ set loglevels {0 1 2 3 4}
+ lappend logmenuitems "0 [_ fatal]"
+ lappend logmenuitems "1 [_ error]"
+ lappend logmenuitems "2 [_ normal]"
+ lappend logmenuitems "3 [_ debug]"
+ lappend logmenuitems "4 [_ all]"
+ set logmenu \
+ [eval tk_optionMenu .pdwindow.header.logmenu ::loglevel $loglevels]
+ .pdwindow.header.logmenu configure -background lightgray
+ foreach i $loglevels {
+ $logmenu entryconfigure $i -label [lindex $logmenuitems $i]
+ }
+ trace add variable ::loglevel write ::pdwindow::filter_buffer_to_text
+
+ # TODO figure out how to make the menu traversable with the keyboard
+ #.pdwindow.header.logmenu configure -takefocus 1
+ pack .pdwindow.header.logmenu -side left
+ frame .pdwindow.tcl -borderwidth 0
+ pack .pdwindow.tcl -side bottom -fill x
# TODO this should use the pd_font_$size created in pd-gui.tcl
text .pdwindow.text -relief raised -bd 2 -font {-size 10} \
- -yscrollcommand ".pdwindow.scroll set" -width 60
- scrollbar .pdwindow.scroll -command ".pdwindow.text yview"
+ -highlightthickness 0 -borderwidth 1 -relief flat \
+ -yscrollcommand ".pdwindow.scroll set" -width 60 \
+ -undo false -autoseparators false -maxundo 1 -takefocus 0
+ scrollbar .pdwindow.scroll -command ".pdwindow.text.internal yview"
pack .pdwindow.scroll -side right -fill y
- pack .pdwindow.text -side bottom -fill both -expand 1
+ pack .pdwindow.text -side right -fill both -expand 1
raise .pdwindow
+ focus .pdwindow.text
+ # run bindings last so that .pdwindow.tcl.entry exists
+ pdwindow_bindings
+ # set cursor to show when clicking in 'findinstance' mode
+ bind .pdwindow <KeyPress> "+::pdwindow::set_findinstance_cursor %W %K %s"
+ bind .pdwindow <KeyRelease> "+::pdwindow::set_findinstance_cursor %W %K %s"
+
+ # hack to make a good read-only text widget from http://wiki.tcl.tk/1152
+ rename ::.pdwindow.text ::.pdwindow.text.internal
+ proc ::.pdwindow.text {args} {
+ switch -exact -- [lindex $args 0] {
+ "insert" {}
+ "delete" {}
+ "default" { return [eval ::.pdwindow.text.internal $args] }
+ }
+ }
+
+ # print whatever is in the queue
+ filter_buffer_to_text
+
+ set ::loaded(.pdwindow) 1
+
+ # set some layout variables
+ ::pdwindow::set_layout
+
+ # wait until .pdwindow.tcl.entry is visible before opening files so that
+ # the loading logic can grab it and put up the busy cursor
+ tkwait visibility .pdwindow.text
+# create_tcl_entry
}
diff --git a/pd/tcl/pkgIndex.tcl b/pd/tcl/pkgIndex.tcl
index cd28c6bd..5f4921b8 100644
--- a/pd/tcl/pkgIndex.tcl
+++ b/pd/tcl/pkgIndex.tcl
@@ -14,15 +14,22 @@ package ifneeded pd_connect 0.1 [list source [file join $dir pd_connect.tcl]]
package ifneeded dialog_array 0.1 [list source [file join $dir dialog_array.tcl]]
package ifneeded dialog_audio 0.1 [list source [file join $dir dialog_audio.tcl]]
package ifneeded dialog_canvas 0.1 [list source [file join $dir dialog_canvas.tcl]]
+package ifneeded dialog_data 0.1 [list source [file join $dir dialog_data.tcl]]
package ifneeded dialog_find 0.1 [list source [file join $dir dialog_find.tcl]]
package ifneeded dialog_font 0.1 [list source [file join $dir dialog_font.tcl]]
package ifneeded dialog_gatom 0.1 [list source [file join $dir dialog_gatom.tcl]]
package ifneeded dialog_iemgui 0.1 [list source [file join $dir dialog_iemgui.tcl]]
+package ifneeded dialog_message 0.1 [list source [file join $dir dialog_message.tcl]]
package ifneeded dialog_midi 0.1 [list source [file join $dir dialog_midi.tcl]]
+package ifneeded dialog_path 0.1 [list source [file join $dir dialog_path.tcl]]
+package ifneeded dialog_startup 0.1 [list source [file join $dir dialog_startup.tcl]]
+package ifneeded helpbrowser 0.1 [list source [file join $dir helpbrowser.tcl]]
package ifneeded opt_parser 0.1 [list source [file join $dir opt_parser.tcl]]
package ifneeded pdwindow 0.1 [list source [file join $dir pdwindow.tcl]]
package ifneeded pd_menucommands 0.1 [list source [file join $dir pd_menucommands.tcl]]
package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]]
package ifneeded pdtk_canvas 0.1 [list source [file join $dir pdtk_canvas.tcl]]
package ifneeded pdtk_text 0.1 [list source [file join $dir pdtk_text.tcl]]
+package ifneeded scrollbox 0.1 [list source [file join $dir scrollbox.tcl]]
+package ifneeded scrollboxwindow 0.1 [list source [file join $dir scrollboxwindow.tcl]]
package ifneeded wheredoesthisgo 0.1 [list source [file join $dir wheredoesthisgo.tcl]]
diff --git a/pd/tcl/scrollbox.tcl b/pd/tcl/scrollbox.tcl
new file mode 100644
index 00000000..b06670a0
--- /dev/null
+++ b/pd/tcl/scrollbox.tcl
@@ -0,0 +1,191 @@
+######### scrollbox -- utility scrollbar with default bindings #######
+# scrollbox is used in the Path and Startup dialogs to edit lists of options
+
+package provide scrollbox 0.1
+
+namespace eval scrollbox {
+ # This variable keeps track of the last list element we clicked on,
+ # used to implement drag-drop reordering of list items
+ variable lastIdx 0
+}
+
+proc ::scrollbox::get_curidx { mytoplevel } {
+ set idx [$mytoplevel.listbox.box index active]
+ if {$idx < 0 || \
+ $idx == [$mytoplevel.listbox.box index end]} {
+ return [expr {[$mytoplevel.listbox.box index end] + 1}]
+ }
+ return [expr $idx]
+}
+
+proc ::scrollbox::insert_item { mytoplevel idx name } {
+ if {$name != ""} {
+ $mytoplevel.listbox.box insert $idx $name
+ set activeIdx [expr {[$mytoplevel.listbox.box index active] + 1}]
+ $mytoplevel.listbox.box see $activeIdx
+ $mytoplevel.listbox.box activate $activeIdx
+ $mytoplevel.listbox.box selection clear 0 end
+ $mytoplevel.listbox.box selection set active
+ focus $mytoplevel.listbox.box
+ }
+}
+
+proc ::scrollbox::add_item { mytoplevel add_method } {
+ set dir [$add_method]
+ insert_item $mytoplevel [expr {[get_curidx $mytoplevel] + 1}] $dir
+}
+
+proc ::scrollbox::edit_item { mytoplevel edit_method } {
+ set idx [expr {[get_curidx $mytoplevel]}]
+ set initialValue [$mytoplevel.listbox.box get $idx]
+ if {$initialValue != ""} {
+ set dir [$edit_method $initialValue]
+
+ if {$dir != ""} {
+ $mytoplevel.listbox.box delete $idx
+ insert_item $mytoplevel $idx $dir
+ }
+ $mytoplevel.listbox.box activate $idx
+ $mytoplevel.listbox.box selection clear 0 end
+ $mytoplevel.listbox.box selection set active
+ focus $mytoplevel.listbox.box
+ }
+}
+
+proc ::scrollbox::delete_item { mytoplevel } {
+ set cursel [$mytoplevel.listbox.box curselection]
+ foreach idx $cursel {
+ $mytoplevel.listbox.box delete $idx
+ }
+}
+
+# Double-clicking on the listbox should edit the current item,
+# or add a new one if there is no current
+proc ::scrollbox::dbl_click { mytoplevel edit_method add_method x y } {
+ if { $x == "" || $y == "" } {
+ return
+ }
+
+ set curBB [$mytoplevel.listbox.box bbox @$x,$y]
+
+ # listbox bbox returns an array of 4 items in the order:
+ # left, top, width, height
+ set height [lindex $curBB 3]
+ set top [lindex $curBB 1]
+ if { $height == "" || $top == "" } {
+ # If for some reason we didn't get valid bbox info,
+ # we want to default to adding a new item
+ set height 0
+ set top 0
+ set y 1
+ }
+
+ set bottom [expr {$height + $top}]
+
+ if {$y > $bottom} {
+ add_item $mytoplevel $add_method
+ } else {
+ edit_item $mytoplevel $edit_method
+ }
+}
+
+proc ::scrollbox::click { mytoplevel x y } {
+ # record the index of the current element being
+ # clicked on
+ variable ::lastIdx [$mytoplevel.listbox.box index @$x,$y]
+
+ focus $mytoplevel.listbox.box
+}
+
+# For drag-and-drop reordering, recall the last-clicked index
+# and move it to the position of the item currently under the mouse
+proc ::scrollbox::release { mytoplevel x y } {
+ variable lastIdx
+ set curIdx [$mytoplevel.listbox.box index @$x,$y]
+
+ if { $curIdx != $::lastIdx } {
+ # clear any current selection
+ $mytoplevel.listbox.box selection clear 0 end
+
+ set oldIdx $::lastIdx
+ set newIdx [expr {$curIdx+1}]
+ set selIdx $curIdx
+
+ if { $curIdx < $::lastIdx } {
+ set oldIdx [expr {$::lastIdx + 1}]
+ set newIdx $curIdx
+ set selIdx $newIdx
+ }
+
+ $mytoplevel.listbox.box insert $newIdx [$mytoplevel.listbox.box get $::lastIdx]
+ $mytoplevel.listbox.box delete $oldIdx
+ $mytoplevel.listbox.box activate $newIdx
+ $mytoplevel.listbox.box selection set $selIdx
+ }
+}
+
+# Make a scrollbox widget in a given window and set of data.
+#
+# id - the parent window for the scrollbox
+# listdata - array of data to populate the scrollbox
+# add_method - method to be called when we add a new item
+# edit_method - method to be called when we edit an existing item
+proc ::scrollbox::make { mytoplevel listdata add_method edit_method } {
+ frame $mytoplevel.listbox
+ listbox $mytoplevel.listbox.box \
+ -selectmode browse -activestyle dotbox \
+ -yscrollcommand [list "$mytoplevel.listbox.scrollbar" set]
+
+ # Create a scrollbar and keep it in sync with the current
+ # listbox view
+ pack $mytoplevel.listbox.box [scrollbar "$mytoplevel.listbox.scrollbar" \
+ -command [list $mytoplevel.listbox.box yview]] \
+ -side left -fill y -anchor w
+
+ # Populate the listbox widget
+ foreach item $listdata {
+ $mytoplevel.listbox.box insert end $item
+ }
+
+ # Standard listbox key/mouse bindings
+ event add <<Delete>> <Delete>
+ if { $::windowingsystem eq "aqua" } { event add <<Delete>> <BackSpace> }
+
+ bind $mytoplevel.listbox.box <ButtonPress> "::scrollbox::click $mytoplevel %x %y"
+ bind $mytoplevel.listbox.box <Double-1> "::scrollbox::dbl_click $mytoplevel $edit_method $add_method %x %y"
+ bind $mytoplevel.listbox.box <ButtonRelease> "::scrollbox::release $mytoplevel %x %y"
+ bind $mytoplevel.listbox.box <Return> "::scrollbox::edit_item $mytoplevel $edit_method"
+ bind $mytoplevel.listbox.box <<Delete>> "::scrollbox::delete_item $mytoplevel"
+
+ # <Configure> is called when the user modifies the window
+ # We use it to capture resize events, to make sure the
+ # currently selected item in the listbox is always visible
+ bind $mytoplevel <Configure> "$mytoplevel.listbox.box see active"
+
+ # The listbox should expand to fill its containing window
+ # the "-fill" option specifies which direction (x, y or both) to fill, while
+ # the "-expand" option (false by default) specifies whether the widget
+ # should fill
+ pack $mytoplevel.listbox.box -side left -fill both -expand 1
+ pack $mytoplevel.listbox -side top -pady 2m -padx 2m -fill both -expand 1
+
+ # All widget interactions can be performed without buttons, but
+ # we still need a "New..." button since the currently visible window
+ # might be full (even though the user can still expand it)
+ frame $mytoplevel.actions
+ pack $mytoplevel.actions -side top -padx 2m -fill x
+ button $mytoplevel.actions.add_path -text {New...} \
+ -command "::scrollbox::add_item $mytoplevel $add_method"
+ button $mytoplevel.actions.edit_path -text {Edit...} \
+ -command "::scrollbox::edit_item $mytoplevel $edit_method"
+ button $mytoplevel.actions.delete_path -text {Delete} \
+ -command "::scrollbox::delete_item $mytoplevel"
+
+ pack $mytoplevel.actions.delete_path -side right -pady 2m
+ pack $mytoplevel.actions.edit_path -side right -pady 2m
+ pack $mytoplevel.actions.add_path -side right -pady 2m
+
+ $mytoplevel.listbox.box activate end
+ $mytoplevel.listbox.box selection set end
+ focus $mytoplevel.listbox.box
+}
diff --git a/pd/tcl/scrollboxwindow.tcl b/pd/tcl/scrollboxwindow.tcl
new file mode 100644
index 00000000..d78622c6
--- /dev/null
+++ b/pd/tcl/scrollboxwindow.tcl
@@ -0,0 +1,94 @@
+
+####### scrollboxwindow -- scrollbox window with default bindings #########
+## This is the base dialog behind the Path and Startup dialogs
+## This namespace specifies everything the two dialogs have in common,
+## with arguments specifying the differences
+##
+## By default, this creates a dialog centered on the viewing area of the screen
+## with cancel, apply, and OK buttons
+## which contains a scrollbox widget populated with the given data
+
+package provide scrollboxwindow 0.1
+
+package require scrollbox
+
+namespace eval scrollboxwindow {
+}
+
+
+proc ::scrollboxwindow::get_listdata {mytoplevel} {
+ return [$mytoplevel.listbox.box get 0 end]
+}
+
+proc ::scrollboxwindow::do_apply {mytoplevel commit_method listdata} {
+ $commit_method [pdtk_encode $listdata]
+ pdsend "pd save-preferences"
+}
+
+# Cancel button action
+proc ::scrollboxwindow::cancel {mytoplevel} {
+ pdsend "$mytoplevel cancel"
+}
+
+# Apply button action
+proc ::scrollboxwindow::apply {mytoplevel commit_method } {
+ do_apply $mytoplevel $commit_method [get_listdata $mytoplevel]
+}
+
+# OK button action
+# The "commit" action can take a second or more,
+# long enough to be noticeable, so we only write
+# the changes after closing the dialog
+proc ::scrollboxwindow::ok {mytoplevel commit_method } {
+ set listdata [get_listdata $mytoplevel]
+ cancel $mytoplevel
+ do_apply $mytoplevel $commit_method $listdata
+}
+
+# "Constructor" function for building the window
+# id -- the window id to use
+# listdata -- the data used to populate the scrollbox
+# add_method -- a reference to a proc to be called when the user adds a new item
+# edit_method -- same as above, for editing and existing item
+# commit_method -- same as above, to commit during the "apply" action
+# title -- top-level title for the dialog
+# width, height -- initial width and height dimensions for the window, also minimum size
+proc ::scrollboxwindow::make {mytoplevel listdata add_method edit_method commit_method title width height } {
+ wm deiconify .pdwindow
+ raise .pdwindow
+ toplevel $mytoplevel -class DialogWindow
+ wm title $mytoplevel $title
+ wm group $mytoplevel .
+ wm transient $mytoplevel .pdwindow
+ wm protocol $mytoplevel WM_DELETE_WINDOW "::scrollboxwindow::cancel $mytoplevel"
+
+ # Enforce a minimum size for the window
+ wm minsize $mytoplevel $width $height
+
+ # Set the current dimensions of the window
+ wm geometry $mytoplevel "${width}x${height}"
+
+ # Add the scrollbox widget
+ ::scrollbox::make $mytoplevel $listdata $add_method $edit_method
+
+ # Use two frames for the buttons, since we want them both
+ # bottom and right
+ frame $mytoplevel.nb
+ pack $mytoplevel.nb -side bottom -fill x -pady 2m
+
+ frame $mytoplevel.nb.buttonframe
+ pack $mytoplevel.nb.buttonframe -side right -padx 2m
+
+ button $mytoplevel.nb.buttonframe.cancel -text [_ "Cancel"]\
+ -command "::scrollboxwindow::cancel $mytoplevel"
+ button $mytoplevel.nb.buttonframe.apply -text [_ "Apply"]\
+ -command "::scrollboxwindow::apply $mytoplevel $commit_method"
+ button $mytoplevel.nb.buttonframe.ok -text [_ "OK"]\
+ -command "::scrollboxwindow::ok $mytoplevel $commit_method"
+
+ pack $mytoplevel.nb.buttonframe.cancel -side left -expand 1 -padx 2m
+ pack $mytoplevel.nb.buttonframe.apply -side left -expand 1 -padx 2m
+ pack $mytoplevel.nb.buttonframe.ok -side left -expand 1 -padx 2m
+}
+
+
diff --git a/pd/tcl/wheredoesthisgo.tcl b/pd/tcl/wheredoesthisgo.tcl
index 3fbb9d1f..1e9e0344 100644
--- a/pd/tcl/wheredoesthisgo.tcl
+++ b/pd/tcl/wheredoesthisgo.tcl
@@ -3,49 +3,89 @@ package provide wheredoesthisgo 0.1
# a place to temporarily store things until they find a home or go away
-set help_top_directory ""
-
-
-proc post_tclinfo {} {
- pdtk_post "Tcl library: [file normalize [info library]]"
- pdtk_post "executable: [file normalize [info nameofexecutable]]"
- pdtk_post "tclversion: [info tclversion]"
- pdtk_post "patchlevel: [info patchlevel]"
- pdtk_post "sharedlibextension: [info sharedlibextension]"
-}
-
-
-proc placeholder {args} {
- # PLACEHOLDER
- ::pdwindow::pdtk_post "PLACEHOLDER $args"
-}
-
-
proc open_file {filename} {
- set directory [file dirname $filename]
+ set directory [file normalize [file dirname $filename]]
set basename [file tail $filename]
if {[regexp -nocase -- "\.(pd|pat|mxt)$" $filename]} {
+ ::pdtk_canvas::started_loading_file [format "%s/%s" $basename $filename]
pdsend "pd open [enquote_path $basename] [enquote_path $directory]"
# remove duplicates first, then the duplicate added after to the top
set index [lsearch -exact $::recentfiles_list $filename]
set ::recentfiles_list [lreplace $::recentfiles_list $index $index]
- set ::recentfiles_list \
- "$filename [lrange $::recentfiles_list 0 $::total_recentfiles]"
+ lappend ::recentfiles_list $filename
+ set ::recentfiles_list [lrange $::recentfiles_list 0 $::total_recentfiles]
::pd_menus::update_recentfiles_menu
+ } {
+ ::pdwindow::post [format [_ "Ignoring '%s': doesn't look like a Pd-file"] $filename]
}
}
+
+# ------------------------------------------------------------------------------
+# procs for panels (openpanel, savepanel)
-proc lookup_windowname {mytoplevel} {
- foreach window $::menu_windowlist {
- if {[lindex $window 1] eq $mytoplevel} {
- return [lindex $window 0]
+proc pdtk_openpanel {target localdir} {
+ if {! [file isdirectory $localdir]} {
+ if { ! [file isdirectory $::fileopendir]} {
+ set ::fileopendir $::env(HOME)
+ }
+ set localdir $::fileopendir
+ }
+ set filename [tk_getOpenFile -initialdir $localdir]
+ if {$filename ne ""} {
+ set ::fileopendir [file dirname $filename]
+ pdsend "$target callback [enquote_path $filename]"
+ }
+}
+
+proc pdtk_savepanel {target localdir} {
+ if {! [file isdirectory $localdir]} {
+ if { ! [file isdirectory $::filenewdir]} {
+ set ::filenewdir $::env(HOME)
}
+ set localdir $::filenewdir
+ }
+ set filename [tk_getSaveFile -initialdir $localdir]
+ if {$filename ne ""} {
+ pdsend "$target callback [enquote_path $filename]"
}
}
-
+
+# ------------------------------------------------------------------------------
+# window info (name, path, parents, children, etc.)
+
+proc lookup_windowname {mytoplevel} {
+ set window [array get ::windowname $mytoplevel]
+ if { $window ne ""} {
+ return [lindex $window 1]
+ } else {
+ return ERROR
+ }
+}
+
+proc tkcanvas_name {mytoplevel} {
+ return "$mytoplevel.c"
+}
+
# ------------------------------------------------------------------------------
# quoting functions
+# enquote a string for find, path, and startup dialog panels, to be decoded by
+# sys_decodedialog()
+proc pdtk_encodedialog {x} {
+ concat +[string map {" " "+_" "$" "+d" ";" "+s" "," "+c" "+" "++"} $x]
+}
+
+# encode a list with pdtk_encodedialog
+proc pdtk_encode { listdata } {
+ set outlist {}
+ foreach this_path $listdata {
+ if {0==[string match "" $this_path]} {
+ lappend outlist [pdtk_encodedialog $this_path]
+ }
+ }
+ return $outlist
+}
+
# TODO enquote a filename to send it to pd, " isn't handled properly tho...
proc enquote_path {message} {
string map {"," "\\," ";" "\\;" " " "\\ "} $message
@@ -59,39 +99,14 @@ proc unspace_text {x} {
concat $y
}
-
# ------------------------------------------------------------------------------
-# lost pdtk functions...
-
-# set the checkbox on the "Compute Audio" menuitem and checkbox
-proc pdtk_pd_dsp {value} {
- # TODO canvas_startdsp/stopdsp should really send 1 or 0, not "ON" or "OFF"
- if {$value eq "ON"} {
- set ::dsp 1
- } else {
- set ::dsp 0
- }
-}
-
-proc pdtk_pd_dio {red} {
- # puts stderr [concat pdtk_pd_dio $red]
-}
-
+# watchdog functions
proc pdtk_watchdog {} {
pdsend "pd watchdog"
after 2000 {pdtk_watchdog}
}
-
proc pdtk_ping {} {
pdsend "pd ping"
}
-
-# ------------------------------------------------------------------------------
-# kludges to avoid changing C code
-
-proc .mbar.find {command number} {
- # this should be changed in g_canvas.c, around line 800
- .menubar.find $command $number
-}