imported version 0.37-0

svn path=/trunk/; revision=1016

1 files changed, 583 insertions, 54 deletions

diff --git a/pd/src/u_main.tk b/pd/src/u_main.tk
index b879843a..ef10c80b 100644
--- a/pd/src/u_main.tk
+++ b/pd/src/u_main.tk
@@ -1,4 +1,4 @@
-set pd_nt 0
+set pd_nt 1
 # (The above is 0 for unix, 1 for microsoft, and 2 for Mac OSX.  The first
 # line is automatically munged by the relevant makefiles.)
 
@@ -36,19 +36,30 @@ if {$pd_nt == 2} {
     set pd_tearoff 0
 }
 
+# hack so you can easily test-run this script in linux... define pd_guidir
+# (which is normally defined at startup in pd under linux...)
+
+if {$pd_nt == 0} {
+    if {! [info exists pd_guidir]} {
+    	global pd_guidir
+    	puts stderr {setting pd_guidir to '.'}
+	set pd_guidir .
+    }
+}
+
 # it's unfortunate but we seem to have to turn off global bindings
 # for Text objects to get control-s and control-t to do what we want for
 # "text" dialogs below.  Also we have to get rid of tab's changing the focus.
 
 bind all <Key-Tab> ""
-bind all <Shift-Key-Tab> ""
+bind all <<PrevWindow>> ""
 bind Text <Control-t> {}
 bind Text <Control-s> {}
 # puts stderr [bind all]
 
 ################## set up main window #########################
 menu .mbar
-canvas .dummy -height 2p -width 9c
+canvas .dummy -height 2p -width 6c
 
 frame .controls
 pack .controls .dummy -side top -fill x
@@ -60,11 +71,11 @@ menu .mbar.windows -postcommand [concat pdtk_fixwindowmenu] -tearoff $pd_tearoff
 menu .mbar.audio -tearoff $pd_tearoff
 if {$pd_nt != 2} {
     .mbar add cascade -label "Windows" -menu .mbar.windows
-    .mbar add cascade -label "Audio" -menu .mbar.audio
+    .mbar add cascade -label "Media" -menu .mbar.audio
 } else {
 # Perhaps this is silly, but Mac HIG want "Window  Help" as the last menus
-    .mbar add cascade -label "Audio" -menu .mbar.audio
-    .mbar add cascade -label "Window" -menu .mbar.windows
+    .mbar add cascade -label "Media" -menu .mbar.audio
+    .mbar add cascade -label "Windows" -menu .mbar.windows
 }
 menu .mbar.help -tearoff $pd_tearoff
 .mbar add cascade -label "Help" -menu .mbar.help
@@ -272,7 +283,8 @@ set help_directory $pd_guidir/doc
 
 proc menu_documentation {} {
     global help_directory
- 
+    global pd_nt
+
     set filename [tk_getOpenFile -defaultextension .pd \
     -filetypes { {{documentation} {.pd .txt .htm}} } \
     -initialdir $help_directory]
@@ -282,7 +294,6 @@ proc menu_documentation {} {
     	    menu_opentext $filename
     	} elseif {[string first .htm $filename] >= 0} {
 	    if {$pd_nt == 0} {
-#I wish I could get this to run in the background; the "&" doesn't do it:
 	    	exec sh -c \
 		    [format "mozilla file:%s || netscape file:%s &\n" \
 		    	 $filename $filename]
@@ -291,9 +302,8 @@ proc menu_documentation {} {
                 exec sh -c \
 		    [format "open %s" $filename]
 	    } else {
-	    tk_messageBox -message \
-	    	{sorry -- can't open htm files yet; open this manually} \
-		 -type ok 
+     	    	exec rundll32 url.dll,FileProtocolHandler \
+		    [format "file:%s" $filename] &
     	    }
 	} else {
 	    set help_directory [string range $filename 0 \
@@ -319,6 +329,38 @@ proc menu_doc_open {subdir basename} {
     }
 }
 
+############# routine to add audio and help menus ###############
+
+proc menu_addstd {mbar} {
+    global pd_apilist
+#          the "Audio" menu
+    $mbar.audio add command -label {audio ON} -accelerator [accel_munge "Ctrl+/"] \
+	-command {menu_audio 1} 
+    $mbar.audio add command -label {audio OFF} -accelerator [accel_munge "Ctrl+."] \
+	-command {menu_audio 0} 
+    for {set x 0} {$x<[llength $pd_apilist]} {incr x} {
+    	$mbar.audio add radiobutton -label [lindex [lindex $pd_apilist $x] 0] \
+	    -command {menu_audio 0} -variable pd_whichapi \
+	    	-value [lindex [lindex $pd_apilist $x] 1]\
+		-command {pd [concat pd audio-setapi $pd_whichapi \;]}
+    }
+    $mbar.audio add command -label {Audio settings...} \
+	-command {pd pd audio-properties \;}
+
+    $mbar.audio add command -label {MIDI settings...} \
+	-command {pd pd midi-properties \;}
+    $mbar.audio add command -label {Test Audio and MIDI} \
+	-command {menu_doc_open doc/7.stuff/tools testtone.pd} 
+    $mbar.audio add command -label {Load Meter} \
+	-command {menu_doc_open doc/7.stuff/tools load-meter.pd} 
+
+#          the "Help" menu
+    $mbar.help add command -label {About Pd} \
+	-command {menu_doc_open doc/1.manual 1.introduction.txt} 
+    $mbar.help add command -label {Pure Documentation...} \
+	-command {menu_documentation} 
+}
+
 #################### the "File" menu for the Pd window ##############
 
 .mbar.file add command -label New -command {menu_new} \
@@ -328,6 +370,8 @@ proc menu_doc_open {subdir basename} {
 .mbar.file add  separator
 .mbar.file add command -label Message -command {menu_send} \
     -accelerator [accel_munge "Ctrl+m"]
+.mbar.file add command -label Path... \
+    -command {pd pd start-path-dialog \;}
 .mbar.file add  separator
 .mbar.file add command -label Quit -command {menu_quit} \
     -accelerator [accel_munge "Ctrl+q"]
@@ -335,22 +379,6 @@ proc menu_doc_open {subdir basename} {
 #################### the "Find" menu for the Pd window ##############
 .mbar.find add command -label {last error?} -command {menu_finderror} 
 
-#################### the "Audio" menu for the Pd window ##############
-.mbar.audio add command -label On -accelerator [accel_munge "Ctrl+/"] \
-    -command {menu_audio 1} 
-.mbar.audio add command -label Off -accelerator [accel_munge "Ctrl+."] \
-    -command {menu_audio 0} 
-
-#################### the "Help" menu for the Pd window ##############
-.mbar.help add command -label {About Pd} \
-    -command {menu_doc_open doc/1.manual 1.introduction.txt} 
-.mbar.help add command -label {Test Audio and MIDI} \
-    -command {menu_doc_open doc/7.stuff/tools testtone.pd} 
-.mbar.help add command -label {Load Meter} \
-    -command {menu_doc_open doc/7.stuff/tools load-meter.pd} 
-.mbar.help add command -label {Pure Documentation...} \
-    -command {menu_documentation} 
-
 ###########  functions for menu functions on document windows ########
 
 proc menu_save {name} {
@@ -660,6 +688,9 @@ proc pdtk_canvas_new {name width height geometry editable} {
     $name.m.file add command -label Message -command {menu_send} \
 	-accelerator [accel_munge "Ctrl+m"]
 
+    $name.m.file add command -label Path... \
+    	-command {pd pd start-path-dialog \;} 
+
     $name.m.file add  separator
     $name.m.file add command -label Close \
     	-command [concat menu_close $name] \
@@ -812,8 +843,6 @@ proc pdtk_canvas_new {name width height geometry editable} {
     $name.m.put add command -label Array \
     	-command [concat menu_array $name] 
 
-
-
 # the find menu
     menu $name.m.find -tearoff $pd_tearoff
     $name.m add cascade -label Find -menu $name.m.find
@@ -839,30 +868,19 @@ proc pdtk_canvas_new {name width height geometry editable} {
 # the audio menu
     menu $name.m.audio -tearoff $pd_tearoff
 
-    $name.m.audio add command -label On -accelerator [accel_munge "Ctrl+/"] \
-	-command {menu_audio 1} 
-    $name.m.audio add command -label Off -accelerator [accel_munge "Ctrl+."] \
-	-command {menu_audio 0} 
-
     if {$pd_nt != 2} {
         $name.m add cascade -label Windows -menu $name.m.windows
-        $name.m add cascade -label Audio -menu $name.m.audio
+        $name.m add cascade -label Media -menu $name.m.audio
     } else {
-        $name.m add cascade -label Audio -menu $name.m.audio
+        $name.m add cascade -label Media -menu $name.m.audio
         $name.m add cascade -label Window -menu $name.m.windows
     }
 
 # the help menu
     menu $name.m.help -tearoff $pd_tearoff
     $name.m add cascade -label Help -menu $name.m.help
-    $name.m.help add command -label {Getting Started} \
-	-command {menu_doc_open doc/1.manual 1.introduction.txt} 
-    $name.m.help add command -label {Test Audio and MIDI} \
-	-command {menu_doc_open doc/7.stuff/tools testtone.pd} 
-    $name.m.help add command -label {Load Meter} \
-	-command {menu_doc_open doc/7.stuff/tools load-meter.pd} 
-    $name.m.help add command -label {Pure Documentation} \
-	-command {menu_documentation} 
+
+    menu_addstd $name.m
 
 # the popup menu
     menu $name.popup -tearoff false
@@ -911,8 +929,8 @@ proc pdtk_canvas_new {name width height geometry editable} {
     bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %K %A}
     bind $name.c <Motion> {pdtk_canvas_motion %W %x %y 0}
     bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4}
-    bind $name.c <Map> {pdtk_canvas_map %W %s}
-#    bind $name.c <Unmap> {puts stderr map}
+    bind $name.c <Map> {pdtk_canvas_map %W}
+    bind $name.c <Unmap> {pdtk_canvas_unmap %W}
     focus $name.c
 #    puts stderr "all done"
 #   after 1 [concat raise $name]
@@ -1036,6 +1054,10 @@ proc pdtk_canvas_key {name key iso shift} {
 	    set keynum 8
 	}
     }
+    if {$key == "KP_Delete"} {
+	set key 127
+	set keynum 127
+    }
     if {$iso != ""} {
     	scan $iso %c keynum 
     	pd [canvastosym $name] key 1 $keynum $shift\;
@@ -1115,12 +1137,14 @@ proc pdtk_canvas_motion {name x y mods} {
 # "map" event tells us when the canvas becomes visible (arg is "0") or
 # invisible (arg is "").  Invisibility means the Window Manager has minimized
 # us.  We don't get a final "unmap" event when we destroy the window.
-proc pdtk_canvas_map {name arg} {
-    if {$arg == "0"} {
-    	pd [canvastosym $name] map 1 \;
-    } else {
-    	pd [canvastosym $name] map 0 \;
-    }
+proc pdtk_canvas_map {name} {
+#   puts stderr [concat map $name]
+    pd [canvastosym $name] map 1 \;
+}
+
+proc pdtk_canvas_unmap {name} {
+#   puts stderr [concat unmap $name]
+    pd [canvastosym $name] map 0 \;
 }
 
 set saveas_dir nowhere
@@ -2267,6 +2291,14 @@ proc pdtk_iemgui_dialog {id mainheader \
     label $id.space5 -text ""
     pack $id.space5 -side top
 
+    if {[info tclversion] < 8.4} {
+    	bind $id <Key-Tab> {tkTabToWindow [tk_focusNext %W]}
+    	bind $id <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]}
+    } else {
+    	bind $id <Key-Tab> {tk::TabToWindow [tk_focusNext %W]}
+    	bind $id <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}
+    }
+    
     bind $id.dim.w_ent <KeyPress-Return> [concat iemgui_ok $id]
     bind $id.dim.h_ent <KeyPress-Return> [concat iemgui_ok $id]
     bind $id.rng.min_ent <KeyPress-Return> [concat iemgui_ok $id]
@@ -2583,9 +2615,10 @@ proc pdtk_pd_ctrlkey {name key shift} {
 # asked pd to open something.  Also, get character width and height for
 # font sizes 8, 10, 12, 14, 16, and 24.
 
-proc pdtk_pd_startup {version} {
-    global pd_myversion
+proc pdtk_pd_startup {version apilist} {
+    global pd_myversion pd_apilist
     set pd_myversion $version
+    set pd_apilist $apilist
 
     set width1 [font measure  -*-courier-bold--normal--8-* x]
     set height1 [lindex [font metrics -*-courier-bold--normal--8-*] 5]
@@ -2617,6 +2650,11 @@ proc pdtk_pd_startup {version} {
     	24 $width6 $height6 \
     	36 $width7 $height7 \
     	\;];
+
+    # add the audio and help menus to the Pd window.  We delayed this
+    # so that we'd know the value of "apilist".
+    menu_addstd .mbar 
+
 }
 
 ##################### DSP ON/OFF, METERS, DIO ERROR ###################
@@ -2759,3 +2797,494 @@ if {$pd_nt == 1} {
     polleofloop
 }
 
+####################### audio dialog ##################3
+
+proc audio_apply {id} {
+    global audio_indev1 audio_indev2 audio_indev3 audio_indev4 
+    global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4
+    global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4 
+    global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4
+    global audio_sr audio_advance
+
+    pd [concat pd audio-dialog \
+    	$audio_indev1 \
+    	$audio_indev2 \
+    	$audio_indev3 \
+    	$audio_indev4 \
+    	$audio_inchan1 \
+    	$audio_inchan2 \
+    	$audio_inchan3 \
+    	$audio_inchan4 \
+    	$audio_outdev1 \
+    	$audio_outdev2 \
+    	$audio_outdev3 \
+    	$audio_outdev4 \
+    	$audio_outchan1 \
+    	$audio_outchan2 \
+    	$audio_outchan3 \
+    	$audio_outchan4 \
+	$audio_sr \
+	$audio_advance \
+	\;]
+}
+
+proc audio_cancel {id} {
+    pd [concat $id cancel \;]
+}
+
+proc audio_ok {id} {
+    audio_apply $id
+    audio_cancel $id
+}
+
+# callback from popup menu
+proc audio_popup_action {buttonname varname devlist index} {
+    global audio_indevlist audio_outdevlist $varname
+    $buttonname configure -text [lindex $devlist $index]
+#    puts stderr [concat popup_action $buttonname $varname $index]
+    set $varname $index
+}
+
+# create a popup menu
+proc audio_popup {name buttonname varname devlist} {
+    if [winfo exists $name.popup] {destroy $name.popup}
+    menu $name.popup -tearoff false
+#    puts stderr [concat $devlist ]
+    for {set x 0} {$x<[llength $devlist]} {incr x} {
+	$name.popup add command -label [lindex $devlist $x] \
+	    -command [list audio_popup_action \
+	    	$buttonname $varname $devlist $x] 
+    }
+    tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0
+}
+
+# start a dialog window to select audio devices and settings.  "multi"
+# is 0 if only one device is allowed; 1 if one apiece may be specified for
+# input and output; and 2 if we can select multiple devices.  "longform"
+# (which only makes sense if "multi" is 2) asks us to make controls for
+# opening several devices; if not, we get an extra button to turn longform
+# on and restart the dialog.
+
+proc pdtk_audio_dialog {id indevlist indev1 indev2 indev3 indev4 \
+    	inchan1 inchan2 inchan3 inchan4 \
+    	outdevlist outdev1 outdev2 outdev3 outdev4 \
+	outchan1 outchan2 outchan3 outchan4 sr advance multi longform} {
+    global audio_indev1 audio_indev2 audio_indev3 audio_indev4 
+    global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4
+    global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4
+    global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4
+    global audio_sr audio_advance
+    global audio_indevlist audio_outdevlist
+
+    set audio_indev1 $indev1
+    set audio_indev2 $indev2
+    set audio_indev3 $indev3
+    set audio_indev4 $indev4
+    set audio_inchan1 $inchan1
+    set audio_inchan2 $inchan2
+    set audio_inchan3 $inchan3
+    set audio_inchan4 $inchan4
+    set audio_outdev1 $outdev1
+    set audio_outdev2 $outdev2
+    set audio_outdev3 $outdev3
+    set audio_outdev4 $outdev4
+    set audio_outchan1 $outchan1
+    set audio_outchan2 $outchan2
+    set audio_outchan3 $outchan3
+    set audio_outchan4 $outchan4
+    set audio_sr $sr
+    set audio_advance $advance
+    set audio_indevlist $indevlist
+    set audio_outdevlist $outdevlist
+
+    toplevel $id
+    wm title $id {audio}
+    wm protocol $id WM_DELETE_WINDOW [concat audio_cancel $id]
+
+    frame $id.buttonframe
+    pack $id.buttonframe -side bottom -fill x -pady 2m
+    button $id.buttonframe.cancel -text {Cancel}\
+    	-command "audio_cancel $id"
+    button $id.buttonframe.apply -text {Apply}\
+    	-command "audio_apply $id"
+    button $id.buttonframe.ok -text {OK}\
+    	-command "audio_ok $id"
+    pack $id.buttonframe.cancel -side left -expand 1
+    pack $id.buttonframe.apply -side left -expand 1
+    pack $id.buttonframe.ok -side left -expand 1
+    
+    	# sample rate and advance
+    frame $id.srf
+    pack $id.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
+    
+    	# input device 1
+    frame $id.in1f
+    pack $id.in1f -side top
+
+    label $id.in1f.l1 -text "input device 1:"
+    button $id.in1f.x1 -text [lindex $indevlist $audio_indev1] \
+    	-command [list audio_popup $id $id.in1f.x1 audio_indev1 $indevlist]
+    label $id.in1f.l2 -text "channels:"
+    entry $id.in1f.x2 -textvariable audio_inchan1 -width 3
+    pack $id.in1f.l1 $id.in1f.x1 $id.in1f.l2 $id.in1f.x2 -side left
+
+    	# input device 2
+    if {$longform && $multi > 1 && [llength $indevlist] > 1} {
+	frame $id.in2f
+	pack $id.in2f -side top
+
+	label $id.in2f.l1 -text "input device 2:"
+	button $id.in2f.x1 -text [lindex $indevlist $audio_indev2] \
+    	    -command [list audio_popup $id $id.in2f.x1 audio_indev2 $indevlist]
+	label $id.in2f.l2 -text "channels:"
+	entry $id.in2f.x2 -textvariable audio_inchan2 -width 3
+	pack $id.in2f.l1 $id.in2f.x1 $id.in2f.l2 $id.in2f.x2 -side left
+    }
+
+    	# input device 3
+    if {$longform && $multi > 1 && [llength $indevlist] > 2} {
+	frame $id.in3f
+	pack $id.in3f -side top
+
+	label $id.in3f.l1 -text "input device 3:"
+	button $id.in3f.x1 -text [lindex $indevlist $audio_indev3] \
+    	    -command [list audio_popup $id $id.in3f.x1 audio_indev3 $indevlist]
+	label $id.in3f.l2 -text "channels:"
+	entry $id.in3f.x2 -textvariable audio_inchan3 -width 3
+	pack $id.in3f.l1 $id.in3f.x1 $id.in3f.l2 $id.in3f.x2 -side left
+    }
+
+    	# input device 4
+    if {$longform && $multi > 1 && [llength $indevlist] > 3} {
+	frame $id.in4f
+	pack $id.in4f -side top
+
+	label $id.in4f.l1 -text "input device 4:"
+	button $id.in4f.x1 -text [lindex $indevlist $audio_indev4] \
+    	    -command [list audio_popup $id $id.in4f.x1 audio_indev4 $indevlist]
+	label $id.in4f.l2 -text "channels:"
+	entry $id.in4f.x2 -textvariable audio_inchan4 -width 3
+	pack $id.in4f.l1 $id.in4f.x1 $id.in4f.l2 $id.in4f.x2 -side left
+    }
+
+    	# output device 1
+    frame $id.out1f
+    pack $id.out1f -side top
+
+    if {$multi == 0} {
+    	label $id.out1f.l1 \
+	    -text "(output device same as input device) ..............      "
+    } else {
+    	label $id.out1f.l1 -text "output device 1:"
+    	button $id.out1f.x1 -text [lindex $outdevlist $audio_outdev1] \
+    	    -command \
+	    [list audio_popup $id $id.out1f.x1 audio_outdev1 $outdevlist]
+    }
+    label $id.out1f.l2 -text "channels:"
+    entry $id.out1f.x2 -textvariable audio_outchan1 -width 3
+    if {$multi == 0} {
+    	pack $id.out1f.l1 $id.out1f.l2 $id.out1f.x2 -side left
+    } else {
+    	pack $id.out1f.l1 $id.out1f.x1 $id.out1f.l2 $id.out1f.x2 -side left
+    }
+
+    	# output device 2
+    if {$longform && $multi > 1 && [llength $indevlist] > 1} {
+	frame $id.out2f
+	pack $id.out2f -side top
+    	label $id.out2f.l1 -text "output device 2:"
+    	button $id.out2f.x1 -text [lindex $outdevlist $audio_outdev2] \
+    	    -command \
+	    [list audio_popup $id $id.out2f.x1 audio_outdev2 $outdevlist]
+	label $id.out2f.l2 -text "channels:"
+	entry $id.out2f.x2 -textvariable audio_outchan2 -width 3
+    	pack $id.out2f.l1 $id.out2f.x1 $id.out2f.l2 $id.out2f.x2 -side left
+    }
+
+    	# output device 3
+    if {$longform && $multi > 1 && [llength $indevlist] > 2} {
+	frame $id.out3f
+	pack $id.out3f -side top
+    	label $id.out3f.l1 -text "output device 3:"
+    	button $id.out3f.x1 -text [lindex $outdevlist $audio_outdev3] \
+    	    -command \
+	    [list audio_popup $id $id.out3f.x1 audio_outdev3 $outdevlist]
+	label $id.out3f.l2 -text "channels:"
+	entry $id.out3f.x2 -textvariable audio_outchan3 -width 3
+    	pack $id.out3f.l1 $id.out3f.x1 $id.out3f.l2 $id.out3f.x2 -side left
+    }
+
+    	# output device 4
+    if {$longform && $multi > 1 && [llength $indevlist] > 3} {
+	frame $id.out4f
+	pack $id.out4f -side top
+    	label $id.out4f.l1 -text "output device 4:"
+    	button $id.out4f.x1 -text [lindex $outdevlist $audio_outdev4] \
+    	    -command \
+	    [list audio_popup $id $id.out4f.x1 audio_outdev4 $outdevlist]
+	label $id.out4f.l2 -text "channels:"
+	entry $id.out4f.x2 -textvariable audio_outchan4 -width 3
+    	pack $id.out4f.l1 $id.out4f.x1 $id.out4f.l2 $id.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} \
+    	    -command  {pd pd audio-properties 1 \;}
+    	pack $id.longbutton.b
+    }
+    bind $id.srf.x1 <KeyPress-Return> [concat audio_ok $id]
+    bind $id.srf.x2 <KeyPress-Return> [concat audio_ok $id]
+    bind $id.in1f.x2 <KeyPress-Return> [concat audio_ok $id]
+    $id.srf.x1 select from 0
+    $id.srf.x1 select adjust end
+    focus $id.srf.x1
+}
+
+####################### midi dialog ##################3
+
+proc midi_apply {id} {
+    global midi_indev1 midi_indev2 midi_indev3 midi_indev4 
+    global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4 
+
+    pd [concat pd midi-dialog \
+    	$midi_indev1 \
+    	$midi_indev2 \
+    	$midi_indev3 \
+    	$midi_indev4 \
+    	$midi_outdev1 \
+    	$midi_outdev2 \
+    	$midi_outdev3 \
+    	$midi_outdev4 \
+	\;]
+}
+
+proc midi_cancel {id} {
+    pd [concat $id cancel \;]
+}
+
+proc midi_ok {id} {
+    midi_apply $id
+    midi_cancel $id
+}
+
+# callback from popup menu
+proc midi_popup_action {buttonname varname devlist index} {
+    global midi_indevlist midi_outdevlist $varname
+    $buttonname configure -text [lindex $devlist $index]
+#    puts stderr [concat popup_action $buttonname $varname $index]
+    set $varname $index
+}
+
+# create a popup menu
+proc midi_popup {name buttonname varname devlist} {
+    if [winfo exists $name.popup] {destroy $name.popup}
+    menu $name.popup -tearoff false
+#    puts stderr [concat $devlist ]
+    for {set x 0} {$x<[llength $devlist]} {incr x} {
+	$name.popup add command -label [lindex $devlist $x] \
+	    -command [list midi_popup_action \
+	    	$buttonname $varname $devlist $x] 
+    }
+    tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0
+}
+
+# start a dialog window to select midi devices.  "longform" asks us to make
+# controls for opening several devices; if not, we get an extra button to
+# turn longform on and restart the dialog.
+
+proc pdtk_midi_dialog {id indevlist indev1 indev2 indev3 indev4 \
+    	outdevlist outdev1 outdev2 outdev3 outdev4 longform} {
+    global midi_indev1 midi_indev2 midi_indev3 midi_indev4 
+    global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
+    global midi_indevlist midi_outdevlist
+
+    set midi_indev1 $indev1
+    set midi_indev2 $indev2
+    set midi_indev3 $indev3
+    set midi_indev4 $indev4
+    set midi_outdev1 $outdev1
+    set midi_outdev2 $outdev2
+    set midi_outdev3 $outdev3
+    set midi_outdev4 $outdev4
+    set midi_indevlist $indevlist
+    set midi_outdevlist $outdevlist
+
+    toplevel $id
+    wm title $id {midi}
+    wm protocol $id WM_DELETE_WINDOW [concat midi_cancel $id]
+
+    frame $id.buttonframe
+    pack $id.buttonframe -side bottom -fill x -pady 2m
+    button $id.buttonframe.cancel -text {Cancel}\
+    	-command "midi_cancel $id"
+    button $id.buttonframe.apply -text {Apply}\
+    	-command "midi_apply $id"
+    button $id.buttonframe.ok -text {OK}\
+    	-command "midi_ok $id"
+    pack $id.buttonframe.cancel -side left -expand 1
+    pack $id.buttonframe.apply -side left -expand 1
+    pack $id.buttonframe.ok -side left -expand 1
+    
+    	# input device 1
+    frame $id.in1f
+    pack $id.in1f -side top
+
+    label $id.in1f.l1 -text "input device 1:"
+    button $id.in1f.x1 -text [lindex $indevlist $midi_indev1] \
+    	-command [list midi_popup $id $id.in1f.x1 midi_indev1 $indevlist]
+    pack $id.in1f.l1 $id.in1f.x1 -side left
+
+    	# input device 2
+    if {$longform && [llength $indevlist] > 2} {
+	frame $id.in2f
+	pack $id.in2f -side top
+
+	label $id.in2f.l1 -text "input device 2:"
+	button $id.in2f.x1 -text [lindex $indevlist $midi_indev2] \
+    	    -command [list midi_popup $id $id.in2f.x1 midi_indev2 $indevlist]
+	pack $id.in2f.l1 $id.in2f.x1 -side left
+    }
+
+    	# input device 3
+    if {$longform && [llength $indevlist] > 3} {
+	frame $id.in3f
+	pack $id.in3f -side top
+
+	label $id.in3f.l1 -text "input device 3:"
+	button $id.in3f.x1 -text [lindex $indevlist $midi_indev3] \
+    	    -command [list midi_popup $id $id.in3f.x1 midi_indev3 $indevlist]
+	pack $id.in3f.l1 $id.in3f.x1 -side left
+    }
+
+    	# input device 4
+    if {$longform && [llength $indevlist] > 4} {
+	frame $id.in4f
+	pack $id.in4f -side top
+
+	label $id.in4f.l1 -text "input device 4:"
+	button $id.in4f.x1 -text [lindex $indevlist $midi_indev4] \
+    	    -command [list midi_popup $id $id.in4f.x1 midi_indev4 $indevlist]
+	pack $id.in4f.l1 $id.in4f.x1 -side left
+    }
+
+    	# output device 1
+
+    frame $id.out1f
+    pack $id.out1f -side top
+    label $id.out1f.l1 -text "output device 1:"
+    button $id.out1f.x1 -text [lindex $outdevlist $midi_outdev1] \
+    	-command [list midi_popup $id $id.out1f.x1 midi_outdev1 $outdevlist]
+    pack $id.out1f.l1 $id.out1f.x1 -side left
+
+    	# output device 2
+    if {$longform && [llength $indevlist] > 2} {
+	frame $id.out2f
+	pack $id.out2f -side top
+    	label $id.out2f.l1 -text "output device 2:"
+    	button $id.out2f.x1 -text [lindex $outdevlist $midi_outdev2] \
+    	    -command \
+	    [list midi_popup $id $id.out2f.x1 midi_outdev2 $outdevlist]
+    	pack $id.out2f.l1 $id.out2f.x1 -side left
+    }
+
+    	# output device 3
+    if {$longform && [llength $indevlist] > 3} {
+	frame $id.out3f
+	pack $id.out3f -side top
+    	label $id.out3f.l1 -text "output device 3:"
+    	button $id.out3f.x1 -text [lindex $outdevlist $midi_outdev3] \
+    	    -command \
+	    [list midi_popup $id $id.out3f.x1 midi_outdev3 $outdevlist]
+    	pack $id.out3f.l1 $id.out3f.x1 -side left
+    }
+
+    	# output device 4
+    if {$longform && [llength $indevlist] > 4} {
+	frame $id.out4f
+	pack $id.out4f -side top
+    	label $id.out4f.l1 -text "output device 4:"
+    	button $id.out4f.x1 -text [lindex $outdevlist $midi_outdev4] \
+    	    -command \
+	    [list midi_popup $id $id.out4f.x1 midi_outdev4 $outdevlist]
+    	pack $id.out4f.l1 $id.out4f.x1 -side left
+    }
+
+    	# if not the "long form" make a button to
+	# restart with longform set. 
+    
+    if {$longform == 0} {
+	frame $id.longbutton
+	pack $id.longbutton -side top
+    	button $id.longbutton.b -text {use multiple devices} \
+    	    -command  {pd pd midi-properties 1 \;}
+    	pack $id.longbutton.b
+    }
+}
+
+############ pdtk_path_dialog -- dialog window for search path #########
+
+proc path_apply {id} {
+    global pd_path0 pd_path1 pd_path2 pd_path3 pd_path4 
+    global pd_path5 pd_path6 pd_path7 pd_path8 pd_path9 
+
+    pd [concat pd path-dialog \
+    	$pd_path0 $pd_path1 $pd_path2 $pd_path3 $pd_path4 \
+    	$pd_path5 $pd_path6 $pd_path7 $pd_path8 $pd_path9 \
+	\;]
+}
+
+proc path_cancel {id} {
+    pd [concat $id cancel \;]
+}
+
+proc path_ok {id} {
+    path_apply $id
+    path_cancel $id
+}
+set pd_path0 sdfgh
+
+proc pdtk_path_dialog {id} {
+    global pd_path0 pd_path1 pd_path2 pd_path3 pd_path4 
+    global pd_path5 pd_path6 pd_path7 pd_path8 pd_path9 
+
+    toplevel $id
+    wm title $id {PD search path for patches and other files}
+    wm protocol $id WM_DELETE_WINDOW [concat path_cancel $id]
+
+    frame $id.buttonframe
+    pack $id.buttonframe -side bottom -fill x -pady 2m
+    button $id.buttonframe.cancel -text {Cancel}\
+    	-command "path_cancel $id"
+    button $id.buttonframe.apply -text {Apply}\
+    	-command "path_apply $id"
+    button $id.buttonframe.ok -text {OK}\
+    	-command "path_ok $id"
+    pack $id.buttonframe.cancel -side left -expand 1
+    pack $id.buttonframe.apply -side left -expand 1
+    pack $id.buttonframe.ok -side left -expand 1
+    
+    for {set x 0} {$x < 10} {incr x} {
+    	# input device 1
+	entry $id.f$x -textvariable pd_path$x -width 80
+    	bind $id.f$x <KeyPress-Return> [concat path_ok $id]
+	pack $id.f$x -side top
+    }
+
+    focus $id.f0
+}
+
+proc pd_set {var value} {
+	global $var
+	set $var $value
+}